-not a Macintosh disk-DPi`KJDBH@%18.NP"N,L 8!"@$|Gn"`I N.@A,H<( F<B<H111.Bx<kNNF`, 8! "NH@"|J(g g`LNu"_ |a||a0@||9݁g|w|a||NH瀀 |(_@"g2<@gBA?N`Fa`||aPLNu  fBR$N"NBH@&|݁ |B$<0HN~NL@dBgg>N&|)`RNuBBBA*2h/ BBB N _"_$_"H&|݁ |B$<0NNd 0<`L$|J HA H  2I<FFI<<FFfHHFFfHHH?B@L"_2N _0H 2<@I6@o Az:<2`6@oJA~:<26" @n2BDBB(`EB@nAJEkz`z2<HAIL0.NL0.N  / p? O@ 0  0  XO _,_2_!.NBBB/ BBBN08 @ gNu@ f"_E!NH\O/ ?`@&x|N _!@"|xEz En"`CE"|xN"Ҹ< A  33"|@E E4n"`C&E"|@.N _LHNFLN*8&E@<<'CJJKK f`  f `><$CS*<FF4>BRIBC Gff&<CBSC`D GnKG45BQf` f `Ns |0< BXHQ!4 _$_"_!XOHH/8/ $ f0<? QN ! N.x $_$ g ! N.x !C !!LLyp!N\OFN  l0P߀ Aǀ`  6lo6@ 0_an*>]> j 56, l602  ۰Poo A` &ll6p@ 0?۷a?^ ꭕ 5o6, l602 8!ED91kE"0369? CoNGNOS BOOT FAILED TRY A NEWER MACHINE AND BOOT PROM _"_NN/A lNNu _.NHL$ orD?|?@?e\SFk!!QSWk:CL<HL|hH>L|4H>L|H>SWjTO>SGk\!Q`TSFk QSWk8L|H|L|H|4L|H|hL|H|LSGkQLx _O NNVH8=| f=|G* G, &N(N n"n$n 0.  S@ZeJ S@BBDBG S@gg.BC CJDg720faL`fa:` 320f8<S@`JDg  fa$` fa`  U@o$SBjt`(N&N><`JGg (Ev#$#$QNukJDg`g 3$f(N`BnLN^ _NUNPACK H>8$O&j.(j4,*8:*,BB6*2SCCn`8CL0@D@04"F K0HEY@2< Vb,g`aJaBVgbHE6SCCo`p`HE4RBCo8B@ j(0 j$L| _pN am znNu _"_$_$0H2< @`Q`BQBNNV;n *N^.NuEVINIT NVH,. ^J]g n0`4B?N. f n0`/.//. /.N6(n)FLN^ _NEAD_BLONV/ (n Jno./.?././ /.Nj nJPg`RSn`(_N^ _NEAD_SEQHNT"|E.|r |BBByBygRBf~NuLHPPNqNqpS_n.0<QLHPPNqNqpS_n|~By&JM*Np|azJGfb|a|,Mpa`JGfH|a<<AaJGf0Avtp BQvr BQH@02N\LhL"4NtB@6Kd a"JDf`02IP g a JDf`Nub SBg pxNuBDNu><Nu4< vB@bp2IPSCfSBfNuppB@(4<dBC(4< CBC(C"H4<BACSBf(CAg><NuJoNV?-,N.H|)?NN^ _TONRAP NV.HgVS@g`J.f& -`мS//<N/<NB+_`-m` . ѭ` -`o<Np`B . \J.f/-\/<N4/<N+_\-m\ -\l<N,N^ _PONGETSPACNV .мS//<N/<N-_ .=@ N^.NuINDSPARNVH.. Bg/N0Hހ m0.@I/./<N 8//<Np @n ?.Bg?<BgNLN^ _ NETMMU NVH+| d+|l+|(+||+|+|t+|(|;TV(|;T|(|.;Tz&| n!SLN^.NuETVARS NVH/Nt;| .䐼/+@ .м/м+@+|`*<(< E"D +@\&|?-|0-VS?NHnHmJNJngp+@JBBg/-BgNz+_ -Э+@XBB<0<H/BgNPN+_P+mPBG` m @I G~V GTVgd Gl|p@ @8`$ Gf|p@BT`| p@BT H< @"@=A?.??<BgNRG Gox mI|p@BT mIP|p@/-P/<N* 8LN^NuOOTINITNVH(nB BgNBgNHH,BgN0HѬ f,/, N"BgNBgNHH,BgN0HѬ f,/, NBgNrBgNjHH,BgN0HѬ f:Jf< N/, NBgN2BgN*HH,BgNb0HѬ g<NLBN,BN+_ n/BN|  _r Ё0p//-`N/-/-`N&m`:=E E0o<N0<H+@l+| -lЭd n2HҀ -Ё"-Ҁ(Bg Э/N0Hѭ -Є+@B</-BgN+_+mh -dЭh+@p -lЭp, n0HІ+@ -Э+@ -Э+@?<f/-/-?<Nb-m/ /./-N n LN^ _ NUILD_SYNVH(nBGBF. gB `P-n n0. PoB."` n0. A-H&n/+/<N  n0>+<+/, NBgN<BgN4HH-@BgNj0H(٬ JVJ_gB."`4JGW WJGV WgJFf n `H n n/B."n/BgN2  _ BNB-_JGf n Q/ n P/Nr` Q@H/ n P/NZ|B. n=h-nA-H n-P/./.p/N JGgR-mBg n/( n r Ё/ n P/ nP/ | ? Q@?N9_Jlg< N, nQ f|"LN^ _NOADSEG NVHBBg/-tBgN+_x -x"-Ҁ+At(|`p}//<Nn -Пx((|p}//<NN -Пx(?<}/-x/-t?<N&|BSLN^.NuLLOC_SCNVHAC 0BgHnNz_m+m-gBBg/-BgNP+_`+m-gBBg/<BgN, м,BgBgBHnBgHnHnBg/.N g<NACD 0BgHnN  g B-n`.BgBgBHnBgHnHnBg/.Nx g<Nf .@+@ -Э+@` B -@+@ -м@+@?</-/-?<N@ <逐.JfB` .ЇP-@JfB` .ЇP-@-g -Ї/ -Ї//./.N`/-/-BBN(|p((|t(LN^.NuOAD_DEB SYSTEM.DEBUG2 SYSTEM.DEBUGNVH nCJp"S@n2&n (nBBgHnN dgZB /, N NBgN BgN HH(BgN0H* f&.B</BgN&B /, N //NlLN^ _ NOAD_UNPNVBgBgBHn</. /.Bg/.N g<NN^ _ NOAD_LLDNVH(n 0-N|>Jg,, .* Ю(H//<N( Д-@`,.(.H//<N-_?//?<N. .P/NdLN^ _NNSTALL_NVH(n=n ~`/, N BgN p_BgN fHH(BgN 0H-@Jg .Ѭ `<N~ .fBN (BN ( GfAB0pB5pB`ACZ 0z`BgN _ .ARE EoHn?<?<HnNAC 0HnHzNg(AB0pp @AB @AB`2HnHzNPgAB0pB5pB`App| 5pgnBg?/.Hn @AHp @AHp</.NX g<NF?. @A/0 @A"0Ҽ/?<NHRGinoLLN^ _ NOADCODEkrni NVBBg/-BgN+_?<e/-/-?<NN^.NuAKESUPSNVH(m . R A T&@-kLN^ _ NINDMAINNVBg/-NF0HѭB</-BgNx+_?<g/-/-?<N\Bg/-|N 0Hѭ|B</-|BgN>+_?<{/-/-|?<N"N^.NuLLOC_OPNV A0C ArC 0AC 0/NLHnHm/NFBgHn0N g< NHnHn/NBgHnrN g<N^/NZBg/.Hn$/N;_N/./.Hm/N-UgNj/.$?-N/N@/N2 n /B/.$0-NH//NR  _ /NBNj+_N^ _PONOADSYS $ SYSTEM.UNPACK SYSTEM.OS SYSTEM.LLDN :NV,_NUvN ,+|v mv PVD@UNHmHmNHm?- -|Э//-NzNZN N]N NuN^NuOADER NVHAv(HA^&HHn?-.0-0H".Ҁ// / NrJng<NLN^.NuEAD_PAGNV0.HBH"-DҀ-A0.HBH@J@=@/.NvAv0.HЈ-@ N^ _TONIND_SENNVBH nCJp"S@n2 n BBgA/A/Nz-m2Av(H&L U.=m6B|`A^-HHAv(BE`:HnN?-.0-0H".ҀH҅///.HNhؼJnNg<NRE Eom6l^Bn So4 X/ U/0S@?A/?<$Hn/. N n gRn G0.D@@20HҌ-A n-P`/ /?A/?<$Hn/. NRFinBo$ n g< G0.D@@20HҌ-A/.HnP?<NN n/B?.vN4  _ LN^ _ ND_SEARCNVH n-h .S/0-:H/N ;@Z-n p+@V;m:\BF` AvIBBlRF Fo=mHnNBgHn?->N>H/p6/NNZBp6/A/NACp S@n0HnN^J.gHHnHnN .Wgz n/B?.N  _ `SFRGm>fBGBNJFfELN^ _PONOOKUP_ENVH.<A"G";n .;m.,?.?-.N;n0BN&Av(HJg<NH;l~:+lD;lB;l>;l@;l<;T8;l26+l.2 2f<N m8lB?,N&_+SH+kL+kPLN^.NuNITMEDINV m8lBg/.HnN2_`/.HnHnNn .gB/.N-_N^.NuPENINPUNVH(.BGBF Go<NR Av:0JEf<N8 EHl@ AvH"Ұ n n Jf<NHH " n ``RGE`LN^ _ NIND_POSNV-mV/.0-:H/N+_VJV]2-ZHV]g<N0-:H/-V/N2 .;@\ -Vg/-VHnHnN/.N"N^.NuILLBUF NV0-\m:f -VR2-:H//NNT0-\AvpRm\N^NuETBYTE NVHBgNHH<BgNH>JGl H м> G=@LN^NuETWORD NVHBgN0H//<ND,BgN0H.Jl޼ Ї-@LN^NuETLONG NVH,. 0-:m\>HǼl>JGo0-\AvA//.H/NH߮Hǜm\0-:HnJV]2-ZHV]g<N -VR/HnHnNn-nA^(H/0-:H/N*l-EJoZHn?-.0-0H".Ҁ/?././ NjJng<N~0-:H/./N(ٮ .Ѯ .ѭV`:Jo -VR2-:H//NNhJfLN^ _PONOVEMULTNVH(n0,k @nH0;N *6BN\BgHlN_`n/,N`dBgN_`XBgN9_`LBN)_`@/,/,N:`2&l.,/ ?-.0-0H", Ҁ/?,/ /NP`<NhLN^.NuRIVER_C//0/2/ AH@B@2/Ё/@" /WXNuNV// /"/N:/A" N^/WXNuNV// /"/N/@" N^/WXNuH>*jD,jD$HBJBf6B@H@g4HB04"B@H@`$&BBxԂрҁmRQJjDjDL|NuNuNuJoNu$_0 _"_J @o4$ Tg,2ABAgSBgS@2@ISA QS@kQN$_0 _"_J`!QN$_02 _`QNHBB oJ0/2/gk gRBSAn` R gSBRAk?B/oL\NuHBB oJ0/2/gk fRBSAn` R fSBRAk?B/oL\NuHr`HBA oJ"oJB@f`fQ AA/oL\NuH"o J oJv`:H"o J oJBC`&H o J"oJv`H o J"oJBCB@BA@m4`4`fQ@n C`cC"/oL\NuH0/ oC"4JBAR`$aJBBB`QQ oC"0/H#//IL._NuH oJB@BA"o JBBBlBA`$HR` fQ`RS@`?A"/oL\NuH o0/2/SA"o JBBA@m`Q/o L NuB`$_02 _ @o0 Ao*BBAm"6@SCBoSA`@"H`RCoN$_0"_ _J/ S@m*BABB@m6B$I”@`!Q`QNuKb> TK Sources 11̆^-#1#1-T8̆VmK :a$ kT Lk\:)$ "#." #"##%& ! . M 0  gl$F.1 .1m$libpl/CLASLIB.TEXTN!N!00$libpl/UCLASCAL.TEXTF\l$libtk/UABC.TEXTٝ\$libtk/UABC2.TEXTZLll$libtk/UABC3.TEXT {L1$LIBTK/UABC4.TEXT };L$LIBTK/UOBJECT.TEXT \.TEXT$libtk/UTEXT2.TEXTd!Ygn$libtk/UTEXT3.TEXTd"xxn$LIBTK/UTEXT4.TEXTd#yy$n$LIBTK/UUNIVTEXT.OBJNKoKo.8$LIBTK/UUNIVTEXT.TEXTnq44$LIBTK/UUNIVTEXT2.TEXTdffn$LIBTK/XFER.OBJNKi:KiC.8$libtk/XFER.TEXTd%Ҝ((n$LIBUT/UTEXTASM.TEXTd&fF,fF3n$libut/UUNIVTEXT.TEXTd'44n$LIBUT/UUNIVTEXT2.TEXTd( !En$psyscall.objdnwPtwPvn$save/libtk/UABC.TEXTdٜn$save/libtk/UDIALOG.TEXTdn$save/libtk/UDRAW.TEXTdjjXXn$save/LIBTK/UOBJECT.TEXTdyځn$save/libtk/UTEXT.TEXTd n$save/LIBTK/UUNIVTEXT.TEXTd$nq44n$split.OBJd؝n$split.TEXTdǝn$split.TEXTdǝnn@@@@@@NNlibtk/UABC.TEXTC.TEXT`N^ _PONНKbBٝ\\U8NV n  Mlibpl/CLASLIB.TEXTB.TEXTN^ _PONНKbCN!\N!UNV n  libpl/UCLASCAL.TEXTL.TEXT^ _PONНKbDF\x\lV NV n X Xlibtk/UABC2.TEXT2.TEXTEXT^ _PONНKbEZ\LZNV n  glibtk/UABC3.TEXT3.TEXTEXT^ _PONНKbF{\L1UNV n  LIBTK/UABC4.TEXT4.TEXTEXT^ _PONНKbG};\LUpNV n x e"{$R-} WITH mapHandle^^.table[i] DO {$IFC fRngABC}{$R+}{$ENDC} { OK to do this because once >we call doProc, we don't refer to this record any more } ,IF theCommand = cmdNumber THEN 0BEGIN 0fFound := TRUE; 0IF menuBar.isLoaded[menuIndex] = iffLoaded THEN 4doProc(wmgrMenus[menuIndex], itemIndex); 0END ,ELSE ,IF theCommand > cmdNumber THEN 0lowIDX := i+1 ,ELSE 0highIDX := i-1; (END; END; ${$S sCommand} FUNCTION CmdFromWmgr(menuId, itemIndex: INTEGER): TCmdNumber; $VAR wmgrCmd: TWmgrCmd; (cmdNumber: TCmdNumber; (i: INTEGER; (mapHandle: TMapHandle; BEGIN {does not need to be very fast} ({$IFC fMaxTrace}BP(1);{$ENDC} ({$IFC fMaxTrace}EP;{$ENDC} $IF itemIndex < 0 THEN (CmdFromWmgr := -itemIndex {this is how we will implement graphical menus} $ELSE (BEGIN (mapHandle := TMapHandle(menuBar.mapping); (FOR i := 1 TO menuBar.numCommands DO ,BEGIN ,{$R-} ,wmgrCmd := mapHandle^^.table[i]; ,{$IFC fRngABC}{$R+}{$ENDC} ,IF wmgrCmd.itemIndex = itemIndex THEN 0IF menuBar.isLoaded[wmgrCmd.menuIndex] THEN 4IF wmgrMenus[wmgrCmd.menuIndex].menuId = menuId THEN 8BEGIN 8CmdFromWmgr := wmgrCmd.cmdNumber; 8EXIT(CmdFromWmgr); 8END; -END; (CmdFromWmgr := 0; (END; END; ${$S sRes} FUNCTION FindMenu(menuID: INTEGER): INTEGER; ${ given a menuID (the number in the phrase file) return the menuIndex into (our array of menuInfo records } VAR menuIndex: INTEGER; BEGIN ({$IFC fMaxTrace}BP(1);{$ENDC} ({$IFC fMaxTrace}EP;{$ENDC} $FOR menuIndex := 1 TO menuBar.numMenus DO (IF wmgrMenus[menuIndex].menuID = menuID THEN ,BEGIN ,FindMenu := menuIndex; ,EXIT(FindMenu); ,END; $FindMenu := 0; END; METHODS OF TMenuBar; ${$S SgABCini} $FUNCTION {TMenuBar.}CREATE{(object: TObject; heap: THeap; itsScanner: TFileScanner): TMenuBar}; (VAR menu: MenuInfo; ,numMenus: INTEGER; ,i: INTEGER; ,numBytes: INTEGER; ,mapping: TArray; ,numCommands: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TMenuBar(object); (menu.drawProc := @drawTxtMenu; (menu.chooseProc := @chooseTxtItem; (numMenus := itsScanner.ReadNumber(2); (SELF.numMenus := numMenus; (FOR i := 1 TO numMenus DO ,BEGIN ,menu.menuId := itsScanner.ReadNumber(2); ,itsScanner.XferSequential(xRead, @menu.enableFlags, 4); ,numBytes := itsScanner.ReadNumber(2); ,menu.menuData := POINTER(ORD(HAllocate(POINTER(ORD(heap)), numBytes))); ,itsScanner.XferSequential(xRead, @menu.menuData^^, numBytes); ,CalcMenuSize(menu); ,wmgrMenus[i] := menu; ,SELF.isLoaded[i] := FALSE; ,END; (mapping := POINTER(ORD(itsScanner.ReadArray(heap, SIZEOF(TWmgrCmd)))); (SELF.mapping := mapping; (numCommands := mapping.Size; (SELF.numCommands := numCommands; (InitErrorAbort(itsScanner.error); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TMenuBar.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (Field('isLoaded: ARRAY [1..31] OF BOOLEAN'); (* MaxMenus = 31 *) (Field('mapping: TArray'); (Field('numMenus: INTEGER'); (Field('numCommands: INTEGER'); $END; ${$S SgABCres} ${$ENDC} ${$S sRes} $PROCEDURE {TMenuBar.}BuildCmdName{(destCmd, templateCmd: TCmdNumber; param: TPString)}; $VAR templ: S255; (xStart: INTEGER; (xEnd: INTEGER; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (IF SELF.GetCmdName(templateCmd, @templ) THEN ,BEGIN ,xStart := POS('^', templ); ,IF xStart > 0 THEN 0BEGIN 0DELETE(templ, xStart, 1); 0xEnd := POS('^', templ); 0IF xEnd > 0 THEN 4DELETE(templ, xEnd,1) 0ELSE 4xEnd := LENGTH(templ) + 1; 0IF param <> NIL THEN 4BEGIN 4DELETE(templ, xStart, xEnd-xStart); 4INSERT(param^, templ, xStart); 4END; 0END; ,SELF.PutCmdName(destCmd, @templ); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TMenuBar.}Check{(cmdNumber: TCmdNumber; checked: BOOLEAN)}; &Label 1; (PROCEDURE DoCheck(VAR menu: MenuInfo; itemIndex: INTEGER); (BEGIN ,CheckItem(menu, itemIndex, checked); ,Goto 1; (END; $BEGIN ({$IFC fTrace}BP(2);{$ENDC} (InAllMenusDo(TRUE, cmdNumber, DoCheck); $1: {$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $FUNCTION {TMenuBar.}CmdKey{(ch: CHAR): TCmdNumber}; (VAR menuId, itemIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (MenuKey(ch, menuId, itemIndex); (if menuId <> 0 THEN ,HiLiteMenu(menuId); (CmdKey := CmdFromWmgr(menuId, itemIndex); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TMenuBar.}Delete{(menuID: INTEGER)}; (VAR menuIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (DeleteMenu(menuId); (menuIndex := FindMenu(menuID); (IF menuIndex > 0 THEN ,SELF.isLoaded[menuIndex] := FALSE; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $FUNCTION {TMenuBar.}DownAt{(mousePt: Point): TCmdNumber}; (VAR menuId, itemIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (process.ChangeCursor(arrowCursor); (MenuSelect(mousePt, menuId, itemIndex); (if menuId <> 0 THEN ,HiLiteMenu(menuId); (DownAt := CmdFromWmgr(menuId, itemIndex); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $PROCEDURE {TMenuBar.}Draw; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (DrawMenuBar; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TMenuBar.}Enable{(cmdNumber: TCmdNumber; canBeChosen: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(2);{$ENDC} (IF canBeChosen THEN ,InAllMenusDo(TRUE, cmdNumber, EnableItem) (ELSE ,InAllMenusDo(TRUE, cmdNumber, DisableItem); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TMenuBar.}EndCmd; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (HiLiteMenu(0); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TMenuBar.}GetCmdName{(cmdNumber: TCmdNumber; pName: TPString): BOOLEAN}; &Label 1; (PROCEDURE DoGet(VAR menu: MenuInfo; itemIndex: INTEGER); ,VAR kludge: Str255; (BEGIN ,IF pName <> NIL THEN 0BEGIN 0GetItem(menu, itemIndex, @kludge); 0XferLeft(@kludge, POINTER(ORD(pName)), LENGTH(kludge)+1); 0END; ,Goto 1; (END; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (GetCmdName := TRUE; (InAllMenusDo(TRUE, cmdNumber, DoGet); (InAllMenusDo(FALSE, cmdNumber, DoGet); (GetCmdName := FALSE; (IF pName <> NIL THEN ,pName^ := ''; $1: {$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TMenuBar.}HighlightMenu(withCmd: TCmdNumber); (LABEL 1; (PROCEDURE DoHighlight(VAR menu: MenuInfo; itemIndex: INTEGER); (BEGIN ,HiLiteMenu(menu.menuID); ,Goto 1; (END; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (InAllMenusDo(TRUE, withCmd, DoHighlight); 1: {$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $PROCEDURE {TMenuBar.}Insert{(menuID, beforeId: INTEGER)}; (VAR menuIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (menuIndex := FindMenu(menuID); (IF menuIndex > 0 THEN ,BEGIN ,InsertMenu(wmgrMenus[menuIndex], beforeId); ,SELF.isLoaded[menuIndex] := TRUE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $FUNCTION {TMenuBar.}MenuWithID(menuID: INTEGER): Ptr; (VAR menuIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (menuIndex := FindMenu(menuID); (IF menuIndex > 0 THEN ,MenuWithId := @wmgrMenus[menuIndex] (ELSE ,MenuWithID := NIL; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TMenuBar.}PutCmdName{(cmdNumber: TCmdNumber; pName: TPString)}; (Label 1; (VAR kludge: Str255; (PROCEDURE DoPut(VAR menu: MenuInfo; itemIndex: INTEGER); (BEGIN ,SetItem(menu, itemIndex, @kludge); ,Goto 1; (END; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (XferLeft(POINTER(ORD(pName)), @kludge, LENGTH(pName^)+1); (InAllMenusDo(TRUE, cmdNumber, DoPut); (InAllMenusDo(FALSE, cmdNumber, DoPut); $1: {$IFC fTrace}EP;{$ENDC} $END; (********** {$S SgABCini} $PROCEDURE {TMenuBar.}SetupGrMenu(menuID: INTEGER; width, height: INTEGER; HnewChooseProc, newDrawProc: Ptr); ({if either proc is NIL, don't change the current value; )if either width or height is <= 0, don't change the current value; )when the menu is first read in, it is setup to behave like a standard text menu} (VAR menuIndex: INTEGER $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (menuIndex := FindMenu(menuID); (IF menuIndex > 0 THEN ,WITH wmgrMenus[menuIndex] DO 0BEGIN 0IF width > 0 THEN 4menuWidth := width; 0IF height > 0 THEN 4menuHeight := height; 0IF newChooseProc <> NIL THEN 4chooseProc := newChooseProc; 0IF newDrawProc <> NIL THEN 4drawProc := newDrawProc; 0END; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} **********) ${$S sRes} $PROCEDURE {TMenuBar.}Unload; (VAR i: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (ClearMenuBar; (FOR i := 1 TO SELF.numMenus DO ,SELF.isLoaded[i] := FALSE; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCini} END; {$S SgABCres} {$IFC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for the Pepsi version} METHODS OF TFont; ${$S SgABCini} $FUNCTION {TFont.}CREATE{(object: TObject; heap: THeap; itsFamily: INTEGER): TFont}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TFont(object); (SELF.family := itsFamily; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TFont.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (Field('family: INTEGER'); $END; ${$S SgABCres} ${$ENDC} {$S SgABCini} END; {$S SgABCres} {$ENDC} LIBTK/UOBJECT.TEXTT.TEXT ̑\P \ȝ\NV n J $)!9  7n +Hv^e\the application and the Clipboard} $myProcessID: LONGINT; {The OS ID of this process} $myTool: LONGINT; {The tool number of this tool} $normalPen: PenState; {pen state resulting from PenNormal} $okString: STRING[20]; {The word "OK" for use in buttons} $phraseFile: TFileScanner; {The Main Phras{UNIT UABC} {Copyright 1983, 1984, Apple Computer, Inc.} 4{ *** METHODS NEED TO BE GROUPED INTO RIGHT CATEGORIES *** } 4{ *** ADD reserve IN ALMOST EVERY CLASS ***} { UABC2.TEXT TProcess-TDocDirectory-TDocManager-TClipboard-TCommand-TCutCopyCommand-TPasteCommand} { UABC3.TEXT TImage-TView-TPaginatedView-TPageView-TPrintManager-THeading-TSelection} { UABC4.TEXT TWindow-TDialogBox-TMenuBar-TFont} { UABC5.TEXT TPanel-TBand-TPane-TMarginPad-TBodyPad-TScroller-TScrollBar} UNIT UABC; {$SETC IsIntrinsic := TRUE } {$IFC IsIntrinsic} INTRINSIC; {$ENDC} INTERFACE USES ${$U UnitStd } UnitStd, {Client should not USE UnitStd} ${$U UnitHz } UnitHz, {Client should not USE UnitHz and MUST NOT USE Storage} ${$U libtk/UObject } UObject, {Client must USE UObject} ${$U -#BOOT-SysCall} SysCall, {Client may USE SysCall} {$IFC LibraryVersion > 20} ${$U LIBTK/Passwd} Passwd, {$ENDC} {$IFC LibraryVersion <= 20} ${$U FontMgr } FontMgr, {Client should USE UFont instead of FontMgr before QuickDraw} {$ENDC} ${$U QuickDraw } QuickDraw, {Client must USE QuickDraw (unless we provide a type-stub for it)} {$IFC LibraryVersion > 20} ${$U FontMgr } FontMgr, {Client should USE UFont instead of FontMgr after QuickDraw} {$ENDC} ${$U libtk/UDraw } UDraw, {Client must USE UDraw} D{Client need not USE anything below this line} ${$U PMDecl } PMDecl, {$IFC libraryVersion <= 20} { P E P S I } ${$U PrStd } PrStd, {$ENDC} ${$U WM.Events } Events, ${$U WM.Folders } Folders, ${$U WM.Menus } Menus, ${$U AlertMgr } AlertMgr, {$IFC LibraryVersion <= 20} ${$U PrProcs } PrProcs, {$ENDC} ${$U WMLstd } WMLstd, ${$U WMLCrs } WMLCrs, ${$U WMLSb } WMLSb, ${$U WMLGrow } WMLGrow, ${$U Scrap } Scrap, {$IFC libraryVersion <= 20} ${$U PrMgrUtil } PrMgrUtil, ${$U PrMgr } PrMgr, {$ELSEC} { S P R I N G } ${$U PrStdInfo} PrStdInfo, ${$U PrPublic} PrPublic, {$ENDC} ${$U FilerComm } FilerComm; {$SETC fDbgABC := fDbgOK}{FALSE} {$SETC fRngABC := fDbgOK}{FALSE} {$SETC fSymABC := fSymOK}{FALSE} {$SETC fDebugMethods := fDbgABC} {if VAR also true, trace entries and/or exits} CONST $maxMenus = 31; {unfortunate, but menus must be in non-relocatable storage, & this is easiest} $maxFonts = 11; $maxSegments = 6; $maxSegSize = $20000; {128K} $abortChunkSize = 32768; {32k} $iconNameSeparator = '<';{character separating parts of an icon name} $stdHHysteresis = 9; {amount the mouse must move from anchor before drag starts, unless} $stdVHysteresis = 6; { TSelection.GetHysteresis is overridden} $noCursor = -2; { used when you do not set the cursor} $hiddenCursor = -1; {icrsHidden Hides the cursor entirely} $arrowCursor = 1; {icrsInactive Standard arrow cursor} $crossCursor = 9; {icrsLCCross LisaCalc cross} $textCursor = 10; {icrsXIBeam Standard text I-Beam} $checkCursor = 12; {icrsCheck Checkmark} $smCrossCursor = 13; {icrsGECross LisaDraw cross (smaller than crossCursor)} $fingerCursor = 14; {icrsLFinger LisaDraw left-pointing finger} $firstUserCursor = 100; { this is the smallest user-defined cursor } $nothingKind = 0; $noCmdNumber = 0; $docLdsn = 3; {ldsn for the first document data segment} $docDsBytes = 5120; {default heap size for a document data segment} $docExcess = 2048; {the virtual data segment may be this much larger than needed for the heap} $printLdsn = 2; {ldsn to hand to LisaPrint} $ascArwDown = $1F; $ascArwLeft = $1C; $ascArwRight = $1D; $ascArwUp = $1E; $ascBackspace = $08; $ascClear = $1B; $ascEnter = $03; $ascReturn = $0D; $ascTab = $09; {alert phrase codes must be between 9 and 899} $phWordDelimiters= 9; $phTrouble = 10; {The tool is having trouble} $phUnknown = 11; {Phrase(error) is undefined for this error} $phNoText = 21; $phNoSel = 22; $phNoInsPt = 23; $phRevert = 24; $phRevBlank = 25; $phUnkCmd = 26; $phSelCant = 27; $phUnchanged = 28; $phSaving = 29; $phTerminated = 30; $phEditClip = 31; $phNoClip = 32; $phUnkClip = 33; $phDialogUp = 34; $phCantUndo = 35; $phNoCommand = 36; $phOlderVersion = 37; $phNewerVersion = 38; $phConverting = 39; $phAborting = 40; $phPage = 41; {+SW+} $phTitle = 42; {+SW+} $phCantSave = 43; $phCantRevert = 44; $phCountry = 45; "{command, selection, and phrase indices used by Dialog Building Block} $uCreateLayoutBox = 701; {Command numbers} $uMoveLayoutBoxes = 702; $uCmdLaunchHeading = 703; $uCmdInstallMargins = 704; $layPickKind = 119; {Selection kinds} $layEditLegendKind = 133; $frameKind = 161; $phTooManyChars = 101; {Phrases} $phOddEven = 102; $phOddOnly = 103; $phEvenOnly = 104; $phOddOrEven = 105; $phMinPage = 106; $phMaxPage = 107; $phPageAlignment = 108; $phAlignment = 109; $phTopLeft = 110; $phTopCenter = 111; $phTopRight = 112; $phBotLeft = 113; $phBotCenter = 114; $phBotRight = 115; $phLaunchHeading = 116; $phPageMargins = 117; $phUnits = 118; $phInches = 119; $phCentimeters = 120; $phLeft = 121; $phLeftCluster = 122; $phTop = 123; $phTopCluster = 124; $phRight = 125; $phRightCluster = 126; $phBottom = 127; $phBotCluster = 128; $phInstallMargins = 129; $phInchTitle= 130; $phCmTitle = 131; $phNewHeading = 132; {+SW+} $phOK = 142; {client should NOT lightly change the phrases for these, since they are used for} $phCancel = 143; {determining text and locations of OK/Cancel buttons for built-in ToolKit dialogs} $stdBoxWidth = 17; {dimensions for default checkboxes} $stdBoxHeight = 11; $stdBoxSpacing = 20; $stdCurvH = 18; {for Buttons} $stdCurvV = 14; $stdBtnHeight = 22; $noIDNumber = -2; $noId = ''; $IDLength = 9; {the significant length of id strings} $stdTitleHeight = 10; {for layout boxes} $stdSlimTitleHeight = 6; $stdLeftRightBorder = 3; $stdBottomBorder = 2; "{errcodes of other libraries} $erAborted = 4033; {user typed Apple-.; Desktop Manager} $erDuplicateName = 890; {OS & Desktop Manager} $erInvalidName = 971; {OS & Desktop Manager} $erNameNotFound = 972; {OS & Desktop Manager} "{ToolKit errCodes must be between 4201 and 4499} $erPassword = 4201; $erVersion = 4202; $erBadData = 4203; $erCantRead = 4304; $erCantWrite = 4305; $erDirtyDoc = 4306; $erNoMoreDocs = 4307; $erNoMemory = 4308; $erNoDiskSpace = 4309; $erWrongPassword = 4310; $erMaxToolKit = 4499; "{command codes must be between 101 and 999} $uSetAllAside = 101; $uSetAside = 102; $uPutAway = 103; $uPrFmt = 104; $uPrintAsIs = 111; $uPrint = 105; $uPrMonitor = 106; $uSaveVersion = 107; $uRevertVersion = 108; $utSetAside = 109; {Set Aside ^Document^} $uSetClipAside = 110; ${Typing Buzzword} $uTyping = 150; ${The toolkit uses the following only as arguments to selection.CantDoCmd} $uBackspace = 151; $uEnter = 152; $uForwardSpace = 153; $uReturn = 154; $uTab = 155; ${The toolkit uses the following only as arguments to process.RememberCommand} $uSomeCommand = 156; $uScrolling = 157; $uSplitting = 158; $uResizeWindow = 159; $uResizePanel = 160; $UMousePress = 161; $uThumbing = 162; $uMoveWindow = 163; $uKeyDown = 164; {could be made the same as uTyping} $uCopy = 201; $uCut = 202; $uPaste = 203; $uSelAll = 204; $uUndoLast = 205; $utUndoLast = 206; {Undo ^Last Change^} $utRedoLast = 207; {Redo ^Last Change^} $uClear = 208; {$IFC LibraryVersion <= 20} $uFnt0 = 300; $uFnt1 = 301; $uFnt2 = 302; $uFnt3 = 303; $uFnt4 = 304; $uFnt5 = 305; $uFnt6 = 306; $uFnt7 = 307; $uFnt8 = 308; $uFnt9 = 309; $uFnt10 = 310; $uFnt11 = 311; {$ENDC} $uModern = 320 + famModern - famMin; {should result in 320} $uClassic = 320 + famClassic - famMin; $u20Pitch = 330 + size20Pitch - sizeMin; {should result in 330} $u15Pitch = 330 + size15Pitch - sizeMin; $u12Pitch = 330 + size12Pitch - sizeMin; $u10Pitch = 330 + size10Pitch - sizeMin; $u12Point = 330 + size12Point - sizeMin; $u14Point = 330 + size14Point - sizeMin; $u18Point = 330 + size18Point - sizeMin; $u24Point = 330 + size24Point - sizeMin; $uPlain = 351; $uBold = 352; $uItalic = 353; $uUnderline = 354; $uShadow = 355; $uOutline = 356; $uSuperscript = 357; $uSubscript = 358; $uPrvwMargins = 401; $uPrvwBreaks = 402; $uPrvwOff = 403; $uDesignPages = 405; $uShowFullSize = 406; $uReduce70Pct = 407; $uReduceToFit = 408; $uSetHorzBreak = 411; $uSetVertBreak = 412; $uClearBreaks = 413; $uRiseVertically = 421; $uRiseHorizontally = 422; $uAddColumnStrip = 431; $uAddRowStrip = 432; $uReportEvents = 501; $uCountHeap = 506; $uCheckIndices = 509; $uDumpGlobals = 510; $uDumpPrelude = 511; $uExperimenting = 512; $uReptGarbage = 513; $uFreeGarbage = 514; $uMainScramble = 515; $uDocScramble = 516; $uEditDialog = 521; $uStopEditDialog = 522; "{ the standard WantMenu will return FALSE for any menus with menuID >= mBuzzword; $buzzword menus should be assigned IDs >= 100; $debug menus should be assigned IDs 90-99 } ${$IFC fDbgABC} $mBuzzword = 100; ${$ELSEC} $mBuzzword = 90; ${$ENDC} $mnuClipFilePrint = 1000; {special menuID for Clipboard File/Print} $firstPrivateEvent = 100; {first event type that you can use in TProcess.SendEvent} ${$IFC NOT fDbgABC} $fExperimenting = FALSE; { not experimenting if debug code if off } ${$ENDC} TYPE $TPrinterMetrics = RECORD (paperRect: Rect; {the physical rectangle} (printRect: Rect; {the printable rectangle} (res: Point; {resolution, spots/inch} (reserve: ARRAY[0..7] OF BYTE; (END; $TPreviewMode = (mPrvwMargins, mPrvwBreaks, mPrvwOff); $TDiResponse = (diAccept, diDismissDialogBox, diGiveToMainWindow, diRefuse); $TEnumAbilities = (aBar, aScroll, aSplit); $TAbilities = SET OF TEnumAbilities; {for TPanel.Divide/CREATE argument} $TUnitsFromEdge = (pixelsFromEdge, percentFromEdge); {for TPanel.Divide argument} $TAlertArg = 1..5; $TAlertCounter = 7..9; $TAlignment = (aLeft, aRight, aCenter, aJustify); $TPageAlignment = (aTopLeft, aTopCenter, aTopRight, aBottomLeft, aBottomCenter, aBottomRight); $TClickState = RECORD 3where: Point; 3when: LONGINT; 3clickCount: INTEGER; 3fShift, fOption, fApple: BOOLEAN; 3END; $TCmdNumber = INTEGER; {the unique identifier of a command in a menu (or elsewhere)} $TCmdPhase = (doPhase, undoPhase, redoPhase);{doPhase first time, then undoPhase & redoPhase alternately} $TCursorNumber = INTEGER; $TEnumIcons = (iSkewer, iScrollBack, iFlipBack, iGrayA, iThumb, iGrayB, iFlipFwd, iScrollFwd); {TIcon} $TMousePhase = (mPress, mMove, mRelease); $TRevelation = (revealNone, revealSome, revealAll); $TPrReserve = ARRAY [0..127] OF Byte; {lengthened} $TPrelude = (RECORD ,password: {2} INTEGER; ,version: {2} INTEGER; {*** Should also do ABC version protection***} ,country: {2} INTEGER; ,language: {2} INTEGER; ,preludeSize: {2} INTEGER; {SIZEOF(TPrelude), which precedes the heap} ,unused: {6} ARRAY [0..5] OF Byte; +{The above fields should occupy 16 bytes to meet the Lisa standard} ,printPref: {128} TPrReserve; ,docSize: {4} LONGINT; {sum of the sizes of the consecutive data segments} ,numSegments: {2} INTEGER; {no. of segments; all but the last are maxSegSize bytes} ,docDirectory: {4} TDocDirectory; {whence one finds the class table and the window} +{Other fields may be added later} ,END; $TPPrelude = ^TPrelude; $TSBoxID = LONGINT; {THSb alias} $TWindowID = LONGINT; {WindowPtr alias} $TWmgrCmd = (RECORD ,cmdNumber: INTEGER; {the command number} ,menuIndex: Byte; {the ordinal number of the menu in its menu bar (or file)} ,itemIndex: Byte; {the ordinal number of the item in its menu} (END; $TProcess = SUBCLASS OF TObject {only one instance exists (process)} &{Variables} &{Creation/Destruction} (FUNCTION {TProcess.}CREATE(object: TObject; heap: THeap): TProcess; &{Debugging} ({$IFC fDebugMethods} (PROCEDURE {TProcess.}DontDebug; {Turn off all debug flags when last document is closed} ({$ENDC} ({$IFC fDbgABC} (PROCEDURE {TProcess.}DumpGlobals; {Print most global variables on alternate screen} ({$ENDC} &{Cursor Tracking} (PROCEDURE {TProcess.}ChangeCursor(cursorNumber: TCursorNumber); 4{ applications call ChangeCursor if they want to change the cursor shape } (PROCEDURE {TProcess.}DoCursorChange(cursorNumber: TCursorNumber); 4{ applications implement DoCursorChange to test cursorNumber for one of their 8cursor shapes; if found, it calls QuickDraw's SetCursor routine, otherwise 8it calls the generic TProcess.DoCursorChange } (PROCEDURE {TProcess.}TrackCursor; &{Error Reporting} (PROCEDURE {TProcess.}ArgAlert(whichArg: TAlertArg; argText: S255); {whichArg = 1 to 5} (FUNCTION {TProcess.}Ask(phraseNumber: INTEGER): INTEGER; (PROCEDURE {TProcess.}BeginWait(phraseNumber: INTEGER); (FUNCTION {TProcess.}Caution(phraseNumber: INTEGER): BOOLEAN; (PROCEDURE {TProcess.}CountAlert(whichCtr: TAlertCounter; counter: INTEGER); (PROCEDURE {TProcess.}DrawAlert(phraseNumber: INTEGER; marginLRect: LRect); (PROCEDURE {TProcess.}EndWait; (PROCEDURE {TProcess.}GetAlert(phraseNumber: INTEGER; VAR theText: S255); (PROCEDURE {TProcess.}Note(phraseNumber: INTEGER); (PROCEDURE {TProcess.}RememberCommand(cmdNumber: TCmdNumber); { for ^C and ^K in alerts } (FUNCTION {TProcess.}Phrase(error: INTEGER): INTEGER; (PROCEDURE {TProcess.}Stop(phraseNumber: INTEGER); &{Initiate/Terminate} (PROCEDURE {TProcess.}Commence(phraseVersion: INTEGER); {process init after the process object exists} (PROCEDURE {TProcess.}Complete(allIsWell: BOOLEAN); &{Abort Handling} (FUNCTION {TProcess.}AbortRequest: BOOLEAN; (PROCEDURE {TProcess.}AbortXferSequential(whichWay: xReadWrite; pFirst: Ptr; QnumBytes, chunkSize: LONGINT; fs: TFileScanner); &{Main Loop} (PROCEDURE {TProcess.}ObeyEvents(FUNCTION StopCondition: BOOLEAN); 4{This will return IF: (1) amDying is TRUE (application terminated) 8or (2) StopCondition returns TRUE (StopCondition is checked 8only when no events are available, before starting to idle.)} (PROCEDURE {TProcess.}ObeyFilerEvent; (PROCEDURE {TProcess.}ObeyTheEvent; (PROCEDURE {TProcess.}Run; &{Private Events (Inter-process communication)} (PROCEDURE {TProcess.}HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGINT; Hwhen: LONGINT; otherData: LONGINT); DEFAULT; (PROCEDURE {TProcess.}SendEvent(typeOfEvent: INTEGER; targetProcess: LONGINT; otherData: LONGINT); &{Memory Management} (PROCEDURE {TProcess.}BindCurrentDocument; &{Open/Close Window/Document} (FUNCTION {TProcess.}NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN) J: TDocManager; DEFAULT; &{External Document Support} (PROCEDURE {TProcess.}CopyExternalDoc(VAR error: INTEGER;  20} ,password: TPassword; {The password for this document} {$ENDC} ,saveExists: BOOLEAN; {whether Save file is known to exist and seem readable} ,shouldSuspend: BOOLEAN; {should we create suspend files?} ,shouldToolSave: BOOLEAN; {should we create save files if opened as a tool?} ,END; (dataSegment: ,RECORD ,refnum: ARRAY [1..maxSegments] OF INTEGER; {refnums of its data segments} ,preludePtr: TPPrelude; {a pointer to the prelude of the data segment} ,changes: LONGINT; {How many changes since the last checkpoint} ,END; (docHeap: THeap; {the heap starts after the prelude} (window: TWindow; {the document's window (it is in the data segment)} (pendingNote: INTEGER; {If <> 0, NOTE alert that was requested while inactive} (openedAsTool: BOOLEAN; &{Creation/Destruction} (FUNCTION {TDocManager.}CREATE(object: TObject; heap: THeap; itsPathPrefix: TFilePath): TDocManager; &{Debugging} ({$IFC fDbgABC} (PROCEDURE {TDocManager.}DumpPrelude; {Print most of prelude on alternate screen} ({$ENDC} &{Attributes} (FUNCTION {TDocManager.}WindowWithId(wmgrID: TWindowID): TWindow; &{Process Termination} (PROCEDURE {TDocManager.}Complete(allIsWell: BOOLEAN); &{Open/Close Window} (FUNCTION {TDocManager.}NewWindow(heap: THeap; wmgrID: TWindowID): TWindow; DEFAULT; &{Files} (PROCEDURE {TDocManager.}Close(afterSuspend: BOOLEAN); *{ CloseFiles is for the application to override if it has any of its own files that must be ,closed } (PROCEDURE {TDocManager.}CloseFiles; (PROCEDURE {TDocManager.}Open(VAR error: INTEGER; wmgrID: TWindowID; VAR OpenedSuspended:Boolean); (PROCEDURE {TDocManager.}OpenBlank(VAR error: INTEGER; wmgrID: TWindowID); (PROCEDURE {TDocManager.}OpenSaved(VAR error: INTEGER; wmgrID: TWindowID); (PROCEDURE {TDocManager.}OpenSuspended(VAR error: INTEGER; wmgrID: TWindowID); (PROCEDURE {TDocManager.}RevertVersion(VAR error: INTEGER; wmgrID: TWindowID); (PROCEDURE {TDocManager.}SaveVersion(VAR error: INTEGER; volumePrefix: TFilePath; LandContinue: BOOLEAN); (PROCEDURE {TDocManager.}Suspend(VAR error: INTEGER); &{Data Segment} (PROCEDURE {TDocManager.}Assimilate(VAR error: INTEGER); (PROCEDURE {TDocManager.}Bind; DEFAULT; (PROCEDURE {TDocManager.}ConserveMemory(maxExcess: LONGINT; fGC: BOOLEAN); D{if fGC is TRUE also do a garbage collect -- on debugging versions, Hwe just report garbage, on non-debugging versions we free it Halso.} (PROCEDURE {TDocManager.}Deactivate; (FUNCTION {TDocManager.}DfltHeapSize: LONGINT; (PROCEDURE {TDocManager.}ExpandMemory(bytesNeeded: LONGINT); (PROCEDURE {TDocManager.}KillSegments(first, last: INTEGER); (PROCEDURE {TDocManager.}MakeSegments(VAR error: INTEGER; oldSegments: INTEGER; newDocSize: LONGINT); (PROCEDURE {TDocManager.}ResumeAfterOpen(VAR error: INTEGER; wmgrID: TWindowID); (PROCEDURE {TDocManager.}SetSegSize(VAR error: INTEGER; minSize, maxExcess: LONGINT); (PROCEDURE {TDocManager.}Unbind; DEFAULT; (END; $TClipboard = SUBCLASS OF TDocManager &{Variables} (hasView: BOOLEAN; {FALSE if no tool-kit-specific representation available} (hasPicture: BOOLEAN; {FALSE if no universal picture available} (hasUniversalText: BOOLEAN; {FALSE if no universal text available} (hasIcon: BOOLEAN; {TRUE if there is an icon reference available} %{****NOTE: The only way into or out of Universal Text is via the Universal Text Building Block****} (cuttingTool: LONGINT; {The tool number of the tool that loaded the Clipboard, or 0} (cuttingProcessID: LONGINT; {The OS process ID of the tool that loaded the Clipboard, or 0} (clipCopy: TFileScanner; {IF <> NIL a scanner on the file containing a copy of the Pclipboard before conversion.} &{Creation/Destruction} (FUNCTION {TClipboard.}CREATE(object: TObject; heap: THeap): TClipboard; &{Editing} (PROCEDURE {TClipboard.}AboutToCut; {whether or not data will actually be put in the data seg} (PROCEDURE {TClipboard.}BeginCut; (PROCEDURE {TClipboard.}EndCut; &{Undo} (PROCEDURE {TClipboard.}CommitCut; (FUNCTION {TClipboard.}UndoCut: BOOLEAN; {return TRUE if succeeds} &{Identification} (PROCEDURE {TClipboard.}Inspect; (PROCEDURE {TClipboard.}Publicize; &{Data Segment} '{PROCEDURE TClipboard. Bind;} '{PROCEDURE TClipboard. Unbind;} (END; $TCommand = SUBCLASS OF TObject &{Variables} (cmdNumber: TCmdNumber; {the command number of the menu item that describes the command; Husually the same one the user chose, but not necessarily} (image: TImage; {If non-NIL, affects filtering by image.EachVirtualPart} (undoable: BOOLEAN; {TRUE iff this command is undoable} (doing: BOOLEAN; {TRUE if Performing or just did doPhase or redoPhase} (revelation: TRevelation; {revealNone/Some/All of selection before performing command} (unHiliteBefore: ARRAY [TCmdPhase] OF BOOLEAN; {TRUE -> Toolkit unhilites all selections before Wperform} (hiliteAfter: ARRAY [TCmdPhase] OF BOOLEAN; {TRUE -> Toolkit hilites all selections after perform} &{Creation/Destruction} (FUNCTION {TCommand.}CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; =itsImage: TImage; isUndoable: BOOLEAN; itsRevelation: TRevelation): TCommand; &{Filtering} (PROCEDURE {TCommand.}EachVirtualPart(PROCEDURE DoToObject(filteredObj: TObject)); (PROCEDURE {TCommand.}FilterAndDo(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject)); &{Command Execution} (PROCEDURE {TCommand.}Commit; DEFAULT; {commit a command} (PROCEDURE {TCommand.}Perform(cmdPhase: TCmdPhase); DEFAULT; {do, undo, or redo a command} (END; $TCutCopyCommand = SUBCLASS OF TCommand &{Variables} (isCut: BOOLEAN; {TRUE iff this was a cut; FALSE iff a copy} &{Creation/Destruction} (FUNCTION {TCutCopyCommand.}CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; HitsImage: TImage; isCutCmd: BOOLEAN): TCutCopyCommand; &{Command Execution} '{PROCEDURE TCutCopyCommand. Commit;} (PROCEDURE {TCutCopyCommand.}DoCutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN; NcmdPhase: TCmdPhase); DEFAULT; 8{the clipboard is already set up; you only have to load data into it in doPhase} '{PROCEDURE TCutCopyCommand. Perform(cmdPhase: TCmdPhase);} (END; $TPasteCommand = SUBCLASS OF TCommand &{Creation/Destruction} (FUNCTION {TPasteCommand.}CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; IitsImage: TImage): TPasteCommand; &{Command Execution} (PROCEDURE {TPasteCommand.}DoPaste(clipSelection: TSelection; pic: PicHandle; JcmdPhase: TCmdPhase); DEFAULT; 8{the clipboard is already set up, except in undoPhase sel & pic are NIL} '{PROCEDURE TPasteCommand. Perform(cmdPhase: TCmdPhase);} (END; $TImage = SUBCLASS OF TObject &{Variables} (extentLRect: LRect; {the bounding box for updates; also for default hit-testing} (view: TView; (allowMouseOutside: BOOLEAN; {If TRUE, TImage.MouseTrack will NOT force the mouse point Pto lie within the extentLRect; TImage.CREATE sets this FALSE} #{methods} (FUNCTION {TImage.}CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsView: TView): TImage; (FUNCTION {TImage.}CursorAt(mouseLPt: lPoint): TCursorNumber; DEFAULT; (PROCEDURE {TImage.}Draw; DEFAULT; (PROCEDURE {TImage.}EachActualPart(PROCEDURE DoToObject(filteredObj: TObject)); DEFAULT; (PROCEDURE {TImage.}EachVirtualPart(PROCEDURE DoToObject(filteredObj: TObject)); DEFAULT; (PROCEDURE {TImage.}FilterAndDo(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject)); (PROCEDURE {TImage.}HaveView(view: TView); DEFAULT; (FUNCTION {TImage.}Hit(mouseLPt: lPoint): BOOLEAN; DEFAULT; (PROCEDURE {TImage.}Invalidate; {does NOT do it on all pads} (FUNCTION {TImage.}LaunchLayoutBox(view: TView): TImage; DEFAULT; (PROCEDURE {TImage.}OffSetBy(deltaLPt: LPoint); DEFAULT; (PROCEDURE {TImage.}OffSetTo(newTopLeft: LPoint); (PROCEDURE {TImage.}MouseMove(mouseLPt: lPoint); DEFAULT; (PROCEDURE {TImage.}MousePress(mouseLPt: lPoint); DEFAULT; (PROCEDURE {TImage.}MouseRelease; DEFAULT; (PROCEDURE {TImage.}MouseTrack(mPhase: TMousePhase; mouseLPt: LPoint); DEFAULT; (PROCEDURE {TImage.}ReactToPrinterChange; DEFAULT; (PROCEDURE {TImage.}RecalcExtent; DEFAULT; (PROCEDURE {TImage.}Resize(newExtent: LRect); DEFAULT; (FUNCTION {TImage.}SeesSameAs(image: TImage): BOOLEAN; DEFAULT; {$} (END; $TView = SUBCLASS OF TImage &{Variables} (panel: TPanel; {The panel in which it is viewed} (clickLPt: LPoint; {The last place the user clicked the mouse button} (printManager: TPrintManager; {NIL if view not printable} (res: Point; {resolution, spots/inch} (screenPad: TPad; {like noPad, but scales from view coords to screen coords if view Hresolution and screen resolution differ H*** CAUTION -- Only for mapping coordinates-- DO NOT try to HFocus this pad or do Invals, etx ***} (fitPagesPerfectly: BOOLEAN; {whether view size should fluctuate automatically so that one always Iends up with an even number of pages} (isPrintable: BOOLEAN; {Whether this view can be printed} (isMainView: BOOLEAN; {FALSE if an auxiliary view, such as page view or paginated view} (stdScroll: LPoint; (scrollPastEnd: Point; {Amount we should scroll past the end of the view} &{Creation/Destruction} (FUNCTION {TView.}CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsExtent: LRect; ,itsPrintManager: TPrintManager; itsDfltMargins: LRect; itsFitPagesPerfectly:BOOLEAN; ,itsRes: Point; isMainView: BOOLEAN): TView; '{PROCEDURE TView. Free;} &{Attributes} (PROCEDURE {TView.}BeInPanel(panel: TPanel); (PROCEDURE {TView.}GetStdScroll(VAR deltaLStd: LPoint); (FUNCTION {TView.}MaxPageToPrint: LONGINT; &{Pagination} (PROCEDURE {TView.}AddStripOfPages(vhs: VHSelect); DEFAULT; (FUNCTION {TView.}ForceBreakAt(vhs: VHSelect; precedingLocation: LONGINT; ,proposedLocation: LONGINT): LONGINT; (PROCEDURE {TView.}RedoBreaks; DEFAULT; (PROCEDURE {TView.}RemapManualBreaks( -FUNCTION NewBreakLocation(vhs: VHSelect; oldBreak: LONGINT): LONGINT); &{Cross-Panel Drag} (FUNCTION {TView.}DoReceive(selection: TSelection; lPtInView: LPoint): BOOLEAN; &{Direct Display Permission -- per panel} (FUNCTION {TView.}OKToDrawIn(lRectInView: LRect): BOOLEAN; {Default is FALSE; app can override} &{Cursor tracking - per pane} ({FUNCTION TView. CursorAt(mouseLPt: LPoint): TCursorNumber;} &{Resizing} '{PROCEDURE TView. Resize(newExtent: LRect);} (PROCEDURE {TView.}SetMinViewSize(VAR minLRect: LRect); &{Clipboard Setup} (PROCEDURE {TView.}CreateUniversalText; &{Variables embedded in text} (PROCEDURE {TView.}SetFunctionValue(keyword: S255; VAR itsValue: S255); &{Selecting} (FUNCTION {TView.}NoSelection: TSelection; (END; $TPaginatedView = SUBCLASS OF TView &{Variables} (unpaginatedView: TView; {the unpaginated view from whence this derives} (pageSize: ARRAY[VHSelect] OF LONGINT; {width/height of a page's representation on the screen, Rin the same metrics as the regular view -- could still Rdiffer from actual screen space a/c screen horiz/vertical Rresolution} (workingInMargins: BOOLEAN; &{Creation/Destruction} (FUNCTION {TPaginatedView.}CREATE(object: TObject; heap: THeap; JitsUnpaginatedView: TView): TPaginatedView; '{PROCEDURE TPaginatedView. AddStripOfPages(vhs: VHSelect);} (PROCEDURE {TPaginatedView.}AdornPageOnScreen; '{FUNCTION TPaginatedView. CursorAt(mouseLPt: LPoint): TCursorNumber;} (PROCEDURE {TPaginatedView.}DepagifyLPoint(pagLPt: LPoint; VAR unPagLPt: LPoint); (PROCEDURE {TPaginatedView.}DoOnPages(focusOnInterior: BOOLEAN; PROCEDURE DoOnAPage); '{PROCEDURE TPaginatedView. Draw;} '{PROCEDURE TPaginatedView. MouseTrack(mPhase: TPhase; mouseLPt: LPoint);} (PROCEDURE {TPaginatedView.}PagifyLPoint(unPagLPt: LPoint; VAR pagLPt: LPoint); '{PROCEDURE TPaginatedView. ReactToPrinterChange;} '{PROCEDURE TPaginatedView. RedoBreaks;} &END; $TPageView = SUBCLASS OF TView (FUNCTION {TPageView.}CREATE(object: TObject; heap: THeap; EitsPrintManager: TPrintManager): TPageView; '{PROCEDURE TPageView. Draw;} (END; $THeading = SUBCLASS OF TImage {a header/footer image} (printManager: TPrintManager; (pageAlignment: TPageAlignment; (offsetFromAlignment: LPoint; (oddOnly: BOOLEAN; {to restrict printing only to odd-numbered pages} (evenOnly: BOOLEAN; { ditto even } (minPage: LONGINT; {minimum page number to want this heading} (maxPage: LONGINT; {maximum page number to want it} &{Creation/Destruction} (FUNCTION {THeading.}CREATE(object: TObject; heap: THeap; itsPrintManager: TPrintManager; DitsExtentLRect: LRect; itsPageAlignment: TPageAlignment; DitsOffsetFromAlignment: LPoint): THeading; &{Attributes} (PROCEDURE {THeading.}ChangePageAlignment(newPageAlignment: TPageAlignment); &{Selective Use} (FUNCTION {THeading.}ShouldDraw(pageNumber: LONGINT): BOOLEAN; (FUNCTION {THeading.}ShouldFrame: BOOLEAN; DEFAULT; &{Display} (PROCEDURE {THeading.}AdjustForPage(pageNumber: LONGINT; editing: BOOLEAN); DEFAULT; (PROCEDURE {THeading.}LocateOnPage(editing: BOOLEAN); '{PROCEDURE THeading. Draw;} (END; $TPrintManager = SUBCLASS OF TObject (view: TView; (pageView: TView; (breaks: ARRAY[VHSelect] OF TArray; {of LONGINT} D{pagebreak representation: absolute value gives location; negative Dsignifies manual break; nonnegative signifies automatic pagebreak} (pageMargins: LRect; {in view resolution; top and left are > 0 , bot & right < 0} (headings: TList; {OF THeading} (canEditPages: BOOLEAN; (layoutDialogBox: TDialogBox; (frameBody: BOOLEAN; (paperLRect: LRect; (printableLRect: LRect; (contentLRect: LRect; {the inner rectangle into which chunks of view are stuffed} (printerMetrics: TPrinterMetrics; {physical properties of the printer} (pageRiseDirection: VHSelect; -{if 'h', it means that page numbers rise from left to right fastest; .if 'v', it means that page numbers rise from top to bottom fastest; .default value is 'h'} (FUNCTION {TPrintManager.}CREATE(object: TObject; heap: THeap): TPrintManager; (PROCEDURE {TPrintManager.}Init(itsMainView: TView; itsDfltMargins: LRect); '{PROCEDURE TPrintmanager. Free;} (PROCEDURE {TPrintManager.}AddStripOfPages(vhs: VHSelect); (PROCEDURE {TPrintManager.}ChangeMargins(margins: LRect); (PROCEDURE {TPrintManager.}ClearPageBreaks(automatic: BOOLEAN); (PROCEDURE {TPrintManager.}DrawBreaks(manualOnly: BOOLEAN); (PROCEDURE {TPrintManager.}DrawOneBreak(pageBreak: LONGINT; vhs: vhSelect); (PROCEDURE {TPrintManager.}DrawPage; (PROCEDURE {TPrintManager.}EnterPageEditing; (PROCEDURE {TPrintManager.}GetPageLimits(pageNumber: LONGINT; VAR viewLRect: LRect); (FUNCTION {TPrintManager.}NewPaginatedView(object: TObject): TPaginatedView; (FUNCTION {TPrintManager.}NewPageView(object: TObject): TView; (FUNCTION {TPrintManager.}PageWith(VAR lPtInView: LPoint; VAR strip: Point): LONGINT; (PROCEDURE {TPrintManager.}Print(printPref: TPrReserve); (PROCEDURE {TPrintManager.}ReactToPrinterChange; (PROCEDURE {TPrintManager.}RedoBreaks; (PROCEDURE {TPrintManager.}SetBreak(vhs: VHSelect; where: LONGINT; isAutomatic: BOOLEAN); (PROCEDURE {TPrintManager.}SetDfltHeadings; DEFAULT; (PROCEDURE {TPrintManager.}SkipPage(pageNumber: LONGINT); $END; {TPrintManager definition} $TSelection = SUBCLASS OF TObject &{Variables} (window: TWindow; {the window in which it was made} (panel: TPanel; {the panel in which it was made} (view: TView; {the view or subview of panel in which it was made} (kind: INTEGER; {0 means no selection, rest of codes are defined by view} (anchorLPt: LPoint; {the place the mouse went down (view-relative)} (currLPt: LPoint; {the place the mouse was last tracked} (boundLRect: LRect; {bounding box of the selection} {+++LSR+++} (coSelection: TSelection; {if non-NIL, a selection to forward unimplemented methods to} (canCrossPanels: BOOLEAN; {:=TRUE in MousePress/FALSE in MouseRelease for cross-panel drag} &{Creation/Destruction} (FUNCTION {TSelection.}CREATE(object: TObject; heap: THeap; itsView: TView; itsKind: INTEGER; CitsAnchorLPt: LPoint): TSelection; '{FUNCTION TSelection. Clone(heap: THeap): TObject;} {clones coSelection} (FUNCTION {TSelection.}FreedAndReplacedBy(selection: TSelection): TSelection; &{Attributes} (PROCEDURE {TSelection.}GetHysteresis(VAR hysterPt: Point); DEFAULT; {rtns a delta from orig panel pt} (PROCEDURE {TSelection.}HaveView(view: TView); &{Files} (PROCEDURE {TSelection.}MarkChanged; DEFAULT; {Increment change counters} &{Command Dispatch} (FUNCTION {TSelection.}CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; DEFAULT; (PROCEDURE {TSelection.}CantDoCmd(cmdNumber: TCmdNumber); DEFAULT; (PROCEDURE {TSelection.}CantDoIt; DEFAULT; (PROCEDURE {TSelection.}DoKey(ascii: CHAR; keycap: Byte; shiftKey, appleKey, optionKey: BOOLEAN); (FUNCTION {TSelection.}NewCommand(cmdNumber: TCmdNumber): TCommand; DEFAULT; (PROCEDURE {TSelection.}PerformCommand(command: TCommand; cmdPhase: TCmdPhase); DEFAULT; &{Idle} (PROCEDURE {TSelection.}IdleBegin(centiSeconds: LONGINT); DEFAULT; (PROCEDURE {TSelection.}IdleContinue(centiSeconds: LONGINT); DEFAULT; (PROCEDURE {TSelection.}IdleEnd(centiSeconds: LONGINT); DEFAULT; &{Editing -- to be overridden by applications} (PROCEDURE {TSelection.}KeyBack(fWord: BOOLEAN); DEFAULT; (PROCEDURE {TSelection.}KeyChar(ch: CHAR); DEFAULT; (PROCEDURE {TSelection.}KeyClear; DEFAULT; (PROCEDURE {TSelection.}KeyEnter(dh, dv: INTEGER); DEFAULT; (PROCEDURE {TSelection.}KeyForward(fWord: BOOLEAN); DEFAULT; (PROCEDURE {TSelection.}KeyPause; DEFAULT; {Pause in typing} (PROCEDURE {TSelection.}KeyReturn; DEFAULT; (PROCEDURE {TSelection.}KeyTab(fBackward: BOOLEAN); DEFAULT; (PROCEDURE {TSelection.}SelectParagraphs; &{Drawing -- per pane} (PROCEDURE {TSelection.}Highlight(highTransit: THighTransit); DEFAULT; &{Selecting} (PROCEDURE {TSelection.}DeSelect; DEFAULT; (PROCEDURE {TSelection.}DrawGhost; DEFAULT; (PROCEDURE {TSelection.}MousePress(mouseLPt: LPoint); DEFAULT; (PROCEDURE {TSelection.}MouseMove(mouseLPt: LPoint); DEFAULT; (PROCEDURE {TSelection.}MouseRelease; DEFAULT; (PROCEDURE {TSelection.}MoveBackToAnchor; DEFAULT; {called when cross-panel drag has been refused} &{Undo Maintenance} (PROCEDURE {TSelection.}Restore; DEFAULT; (PROCEDURE {TSelection.}Save; DEFAULT; &{Scroll into view} (PROCEDURE {TSelection.}Reveal(asMuchAsPossible: BOOLEAN); DEFAULT; (END; $TWindow = SUBCLASS OF TArea &{Variables} (panels: TList {OF TPanel}; {The panels in the window (at least one)} (panelTree: TArea; {no panels: NIL, one panel: that; else a TBranchArea} (dialogBox: TDialogBox; {NIL if SELF IS a dialog box window} (selectPanel: TPanel; {The panel with the active selection} (undoSelPanel: TPanel; {The selectPanel during the last command} (clickPanel: TPanel; {The panel in which the user last clicked in a pane} (undoClickPanel: TPanel; {The clickPanel during the last command} (selectWindow: TWindow; {The window with the active selection -- either WSELF or its Dialogbox } (undoSelWindow: TWindow; {the selectWindow during the last command} (wmgrID: TWindowID; {ORD(Pointer to the Window Manager's GrafPort)} (isResizable: BOOLEAN; {Is there a Resize Box} (believeWmgr: BOOLEAN; {TRUE iff the Toolkit should believe the window Xmanager's idea of the size of the window; Xthis will be FALSE (for example) if we create Xthe window object before the window is put on Xthe screen.} (maxInnerSize: Point; {The window size the user explicitly set with grow Xicon} (changes: LONGINT; {How many changes since the last save} (lastCmd: TCommand; {last undoable command object} (printerMetrics: TPrinterMetrics; {Properties of the printer currently formatted for} (pgSzOK: BOOLEAN; {Whether to allow user-defined page-sizes in Fmt For XPrinter dialog} (pgRgOK: BOOLEAN; {Whether page-range dialog should be enabled in PRINT... Ydialog -- normally TRUE} (panelToPrint: TPanel; {NB: IF >1 printable panel in window, choice should be Umade by providing separate menu items} (objectToFree: TObject; {used to stash a reference to an object which should be Xfreed at end of event loop} &{Creation/Destruction} (FUNCTION {TWindow.}CREATE(object: TObject; heap: THeap; itsWmgrID: TWindowID; itsResizability B: BOOLEAN): TWindow; '{PROCEDURE TWindow. Free;} &{$IFC fDbgABC} &{Debugging} (PROCEDURE {TWindow.}ToggleFlag(VAR flag: BOOLEAN); DEFAULT; {Toggle a debug flag in a menu} '{$ENDC} &{Attributes} '{PROCEDURE TWindow. GetMinExtent(VAR minExtent: Point; windowIsResizingIt: BOOLEAN);} (PROCEDURE {TWindow.}GetTitle(VAR title: S255); {Get the window title} (FUNCTION {TWindow.}IsActive: BOOLEAN; (FUNCTION {TWindow.}IsVisible: BOOLEAN; (PROCEDURE {TWindow.}SetWmgrId(itsWmgrId: TWindowID); {Also sets port fields of panes} &{Buttoning} (PROCEDURE {TWindow.}DownEventAt(mousePt: Point); DEFAULT; '{FUNCTION TWindow. DownAt(mousePt: Point): BOOLEAN;} &{Dialog Box affairs} (PROCEDURE {TWindow.}PutUpDialogBox(dialogBox: TDialogBox); DEFAULT; (PROCEDURE {TWindow.}TakeDownDialogBox; DEFAULT; &{Display} '{PROCEDURE TWindow. Focus;} '{PROCEDURE TWindow. Frame;} (PROCEDURE {TWindow.}Highlight(highTransit: THighTransit); DEFAULT; '{PROCEDURE TWindow. Refresh(rActions: TActions; highTransit: THighTransit);} (PROCEDURE {TWindow.}Update(doHilite: BOOLEAN); DEFAULT; &{Resizing} (PROCEDURE {TWindow.}DownInSizeBox(mousePt: Point); DEFAULT; (PROCEDURE {TWindow.}Resize(moving: BOOLEAN); DEFAULT; {Reset size from portRect size (w. adjustments)} (PROCEDURE {TWindow.}ResizeTo(newSize: Point); DEFAULT; {callable from application} &{Command Dispatch and Menus} (FUNCTION {TWindow.}CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; DEFAULT; (FUNCTION {TWindow.}CanDoStdCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; DEFAULT; (PROCEDURE {TWindow.}CommitLast; DEFAULT; (PROCEDURE {TWindow.}DoCommand(cmdNumber: TCmdNumber); DEFAULT; (PROCEDURE {TWindow.}LoadMenuBar; DEFAULT; (PROCEDURE {TWindow.}MenuEventAt(mousePt: Point); DEFAULT; (FUNCTION {TWindow.}NewCommand(cmdNumber: TCmdNumber): TCommand; DEFAULT; (FUNCTION {TWindow.}NewStdCommand(cmdNumber: TCmdNumber): TCommand; (PROCEDURE {TWindow.}PerformCommand(newCommand: TCommand); (PROCEDURE {TWindow.}PerformLast(cmdPhase: TCmdPhase); (PROCEDURE {TWindow.}SaveCommand(command: TCommand); {NOTE: do not use the arg after calling this; ]use window.lastCmd instead} (PROCEDURE {TWindow.}SetupMenus; (PROCEDURE {TWindow.}UndoLast; (FUNCTION {TWindow.}WantMenu(menuID: INTEGER; inClipboard: BOOLEAN): BOOLEAN; &{Miscellaneous} (PROCEDURE {TWindow.}AbortEvent; {only QuickPort should override this} &{Selection Maintenance during commands} (PROCEDURE {TWindow.}RestoreSelection; (PROCEDURE {TWindow.}RevealSelection(asMuchAsPossible, doHilite: BOOLEAN); (PROCEDURE {TWindow.}SaveSelection; &{Desktop} ,{The following 2 methods assume that we are focused on the window before they are called} (PROCEDURE {TWindow.}Activate; (PROCEDURE {TWindow.}Deactivate; (PROCEDURE {TWindow.}BlankStationery; DEFAULT; (PROCEDURE {TWindow.}StashPicture(highTransit: THighTransit); {$IFC LibraryVersion > 20} &{Desktop Manager Communication} (PROCEDURE {TWindow.}NameToPrefix(VAR error, offset: INTEGER; VAR name, prefix: TFilePath); (PROCEDURE {TWindow.}PrefixToName(VAR error, offset: INTEGER; VAR prefix, name: TFilePath); /(*Convert between OS prefix (ie., '-volname-{DxxxTyyy}' and an icon pathname (ie., 4'itsScroller: TScroller; itsDir: VHSelect): TBand; '{PROCEDURE TBand. Free;} &{Attributes} (FUNCTION {TBand.}ViewLCd: LONGINT; &{Scrolling} (PROCEDURE {TBand.}OffsetPanes(deltaLPt: LPoint); (PROCEDURE {TBand.}ScrollBy(deltaLCd: LONGINT); 8{A TBand can only scroll in one direction; this also moves the thumb} (PROCEDURE {TBand.}ScrollStep(icon: TEnumIcons; deltaLStd: LONGINT); (PROCEDURE {TBand.}ScrollTo(viewLCd: LONGINT); (FUNCTION {TBand.}ThumbPos: INTEGER; (PROCEDURE {TBand.}ThumbTo(newThumbPos: INTEGER); &{Resizing} '{PROCEDURE TBand. ResizeOutside(newOuterRect: Rect);} (PROCEDURE {TBand.}ResizePanes(newViewLCd: LONGINT); (END; $TSideBand = SUBCLASS OF TBand &{Fields} (topOrLeft: BOOLEAN; ({NOTE: SELF.scroller is NIL} (FUNCTION {TSideBand.}CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsInnerRect: Rect; ;itsDir: VHSelect; itsTopOrLeft: BOOLEAN; ;itsViewLCd: LONGINT): TSideBand; &{Attributes} (FUNCTION {TSideBand.}CoBand: TBand; ,{returns the band adjacent to SELF} (END; $TPanel = SUBCLASS OF TArea &{Variables} {panes are listed row-wise in the panes list} (window: TWindow; (panes: TList {OF TPane}; (currentView: TView; {The view seen through SELF: normal or paginated} (view: TView; {The unpaginated view seen through SELF } (paginatedView: TPaginatedView; {NIL if not previewing margins} (selection: TSelection; {the current selection} (undoSelection: TSelection; {the selection to be restored for an undo/redo} (bands: ARRAY[VHSelect] OF TList; {redundant... bands[v].at(1) = top row of panes} (scrollBars: ARRAY[VHSelect] OF TScrollBar; {scrollBars[(v,h)]--the (vert,horiz) scroll bars} (abilities: ARRAY[VHSelect] OF TAbilities; {[aBar, aScroll, aSplit, aResize]} (minInnerDiagonal: Point; (resizeBranch: TBranchArea; {the branch that my botRight resizes, or NIL} (zoomed: BOOLEAN; (zoomFactor: TScaler; (previewMode: TPreviewMode; (lastClick: RECORD {describes the pane the user last clicked} minHeight, minWidth: INTEGER; itsVAbilities, itsHAbilities: TAbilities): TPanel; '{PROCEDURE TPanel. Free;} (PROCEDURE {TPanel.}HaveView(view: TView); (FUNCTION {TPanel.}NewView(object: TObject; itsExtent: LRect; itsPrintManager: TPrintManager; CitsDfltMargins: LRect; itsFitPerfectlyOnPages: BOOLEAN): TView; (FUNCTION {TPanel.}NewStatusView(object: TObject; itsExtent: LRect): TView; &{Attributes} (PROCEDURE {TPanel.}ComputeContentRect; (PROCEDURE {TPanel.}DecideAboutBars(newOuterRect: Rect); {Decide if to have scroll bars & resize icon} '{PROCEDURE TPanel. GetMinExtent(VAR minExtent: Point; windowIsResizingIt: BOOLEAN);} '{PROCEDURE TPanel. GetBorder(VAR border: Rect);} (FUNCTION {TPanel.}FindBranchThatIsResized: TBranchArea; (FUNCTION {TPanel.}PaneShowing(anLRect: LRect): TPane; {Returns first pane showing an part dof anLRect, else NIL} (PROCEDURE {TPanel.}SetInnerRect(newInnerRect: Rect); OVERRIDE; (PROCEDURE {TPanel.}SetOuterRect(newOuterRect: Rect); OVERRIDE; &{Paneling the window} (FUNCTION {TPanel.}Divide(vhs: VHSelect; >fromEdgeOfPanel: INTEGER; units: TUnitsFromEdge; >whoCanResizeIt: TResizability; >minSize: INTEGER; itsVAbilities, itsHAbilities: TAbilities): TPanel; (PROCEDURE {TPanel.}Insert(panel: TPanel; vhs: VHSelect; >fromEdgeOfPanel: INTEGER; units: TUnitsFromEdge; >whoCanResizeIt: TResizability); {Resizes both to share my space} (PROCEDURE {TPanel.}Remove; {Does not Free SELF; Expands sibling to fill my space} (PROCEDURE {TPanel.}Replace(panel: TPanel); {Does not Free SELF; Resizes panel to fit my old space} &{Buttoning} '{FUNCTION TPanel. DownAt(mousePt: Point): BOOLEAN;} (PROCEDURE {TPanel.}DownInSizeBox(mousePt: Point); (PROCEDURE {TPanel.}HitScroller(vhs: VHSelect; mousePt: Point; scroller: TScroller; icon: TEnumIcons); &{Selecting} (PROCEDURE {TPanel.}BeginSelection; (PROCEDURE {TPanel.}BeSelectPanel(inSelectWindow: BOOLEAN); (* FUNCTION {TPanel.}NoSelection: TSelection; *) &{Cursor tracking} (FUNCTION {TPanel.}CursorAt(mousePt: Point): TCursorNumber; &{Display} '{PROCEDURE TPanel. Frame;} (PROCEDURE {TPanel.}Highlight(selection: TSelection; highTransit: THighTransit); <{ this highlights the selection on all pads } (PROCEDURE {TPanel.}Invalidate; <{ this invalidates the whole panel } (PROCEDURE {TPanel.}InvalLRect(lRectInView: LRect); <{ this invalidates the given LRect on all pads } (FUNCTION {TPanel.}OKToDrawIn(lRectInView: LRect): BOOLEAN; <{ If this returns FALSE, commands must InvalLRect or XOR, not Draw or Erase } (PROCEDURE {TPanel.}OnAllPadsDo(PROCEDURE DoOnThePad); '{PROCEDURE TPanel. Refresh(rActions: TActions; highTransit: THighTransit);} (PROCEDURE {TPanel.}Rescroll; (PROCEDURE {TPanel.}SetZoomFactor(zoomNumerator, zoomDenominator: Point); &{Page-Previewing} (PROCEDURE {TPanel.}Preview(newMode: TPreviewMode); &{Printing} (PROCEDURE {TPanel.}PrintView(printPref: TPrReserve); &{Scrolling} (PROCEDURE {TPanel.}AutoScroll(mousePt: Point); (PROCEDURE {TPanel.}DoScrolling(inArea: TArea; itsPane: TPane; @hOk, vOk: BOOLEAN; VAR deltaLPt: LPoint); 4{inArea must be a TBand or a TPane; if a TPane then inArea=itsPane; 5if a TBand then itsPane is any one of the band's panes} (FUNCTION {TPanel.}PaneToScroll(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER): TPane; 4{Returns the pane to scroll for showing the minimum desired part ofLRect; 8if that part is already showing, it returns NIL; 4NOTE: anLRect is NOT changed} (PROCEDURE {TPanel.}RevealLRect(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER); 4{Show at least the desired part of the LRect in the pane returned by PaneToShow; 4NOTE: anLRect is NOT changed} &{Splitting} (PROCEDURE {TPanel.}CleanUpPanes(deleteList: TList); (PROCEDURE {TPanel.}MakeBand(vhs: VHSelect; scroller, prevScroller: TScroller); (PROCEDURE {TPanel.}MoveSplitBefore(scroller: TScroller; newSkwrCd: INTEGER); (FUNCTION {TPanel.}NewBand(heap: THeap; myInnerRect: Rect; Cscroller: TScroller; vhs: VHSelect): TBand; (FUNCTION {TPanel.}NewPane(heap: THeap; innerRect: Rect; viewedLRect: LRect): TPane; (PROCEDURE {TPanel.}RemakePanes; (PROCEDURE {TPanel.}RememberSplit(vhs: VHSelect; atCd: INTEGER); (PROCEDURE {TPanel.}RepaneOrthogonalBands(vhs: VHSelect); (PROCEDURE {TPanel.}RestoreSplits; ${Side Bands} (PROCEDURE {TPanel.}ShowSideBand(vhs: VHSelect; topOrLeft: BOOLEAN; size: INTEGER; viewLCd: LONGINT); (PROCEDURE {TPanel.}SideBandRect(vhs: VHSelect; topOrLeft: BOOLEAN; VAR bandRect: Rect); 0{returns the innerRect of the side band, given SELF.contentRect} &{Resizing} (PROCEDURE {TPanel.}ResizeBand(vhs: VHSelect; band: TBand; newViewLCd: LONGINT; HfInvalidate: BOOLEAN); '{PROCEDURE TPanel. ResizeInside(newInnerRect: Rect);} '{PROCEDURE TPanel. ResizeOutside(newOuterRect: Rect);} (END; $TPane = SUBCLASS OF TPad &{Variables} (currentView: TView; {The view that is currently} (panel: TPanel; {The containing panel} &{Creation/Destruction} (FUNCTION {TPane.}CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsInnerRect: Rect; AitsViewedLRect: LRect): TPane; (PROCEDURE {TPane.}HaveView(view: TView); &{Attributes} (PROCEDURE {TPane.}GetScrollLimits(VAR viewedLRect, scrollableLRect: LRect); '{PROCEDURE TPane. SetZoomFactor(zoomNumerator, zoomDenominator: Point);} &{Selecting} (PROCEDURE {TPane.}MouseTrack(mPhase: TMousePhase; mousePt: Point); <{assumes mousePt is in the pane's innerRect} &{Cursor tracking} (FUNCTION {TPane.}CursorAt(mousePt: Point): TCursorNumber; &{Display} '{PROCEDURE TPane. Refresh(rActions: TActions; highTransit: THighTransit);} &{Resizing} (PROCEDURE {TPane.}Resize(newInnerRect: Rect; vhs: VHSelect); &{Scrolling} (PROCEDURE {TPane.}ScrollBy(VAR deltaLPt: LPoint); 8{NOTE: deltaLPt is NOT changed; also moves the thumb(s)} (PROCEDURE {TPane.}ScrollToReveal(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER); 8{NOTE: anLRect is NOT changed} (END; $TMarginPad = SUBCLASS OF TPad &{Variables} (view: TView; {The view seen on the BODY of this page} (pageNumber: LONGINT; (bodyPad: TBodyPad; &{Creation/Destruction} (FUNCTION {TMarginPad.}CREATE(object: TObject; heap: THeap): TMarginPad; (PROCEDURE {TMarginPad.}Rework(itsView: TView; itsOrigin: Point; itsRes: Point; 7itsPageNumber: LONGINT; itsZoomFactor: TScaler; itsPort: GrafPtr); (PROCEDURE {TMarginPad.}SetForPage(itsPageNumber: LONGINT; itsOrigin: Point); &{Display} '{PROCEDURE TMarginPad. Focus;} &{Process termination and Debugging Assistance} '{PROCEDURE TMarginPad. Crash;} '{FUNCTION TMarginPad. BindHeap(activeVsClip, doBind: BOOLEAN): THeap;} (END; $TBodyPad = SUBCLASS OF TPad &{Variables} (marginPad: TMarginPad; {the page shell whose body I am} (nonNullBody: Rect; {the portion of the pad in the range of the mapped view; *BodyPad.innerRect = nonNullBody unless manual pagebreak or end-of-view forces *a shortage of view to map into entire inner rect} {someday make this comment comprehensible} &{Creation/Destruction} (FUNCTION {TBodyPad.}CREATE(object: TObject; heap: THeap; itsMarginPad: TMarginPad): TBodyPad; (PROCEDURE {TBodyPad.}Recompute; (PROCEDURE {TBodyPad.}SetForPage(itsPageNumber: LONGINT); &{Display} '{PROCEDURE TBodyPad. Focus;} &END; $TScroller = SUBCLASS OF TObject &{Variables} (scrollBar: TScrollBar; {the scroll bar of which it is part} (band: TBand; {the object that can respond to scroll events} (sBoxID: TSBoxID; {the scroll-bar-library representation} &{Creation/Destruction} (FUNCTION {TScroller.}CREATE(object: TObject; heap: THeap; itsScrollBar: TScrollBar; itsId: TSBoxID) D: TScroller; '{PROCEDURE TScroller. Free;} &{Attributes} (PROCEDURE {TScroller.}GetSize(VAR boxRect: Rect); (FUNCTION {TScroller.}ScrollDir: VHSelect; (PROCEDURE {TScroller.}SetSize(ownerRect: Rect); (FUNCTION {TScroller.}ThumbRange: INTEGER; &{Buttoning} (PROCEDURE {TScroller.}TrackSkewer(mousePt: Point; VAR newSkwrCd: INTEGER; JVAR scroller, prevScroller: TScroller); (PROCEDURE {TScroller.}TrackThumb(mousePt: Point; VAR oldThumbPos, newThumbPos: INTEGER); &{Display} (PROCEDURE {TScroller.}FillIcon(icon: TEnumIcons; fBlack: BOOLEAN); (PROCEDURE {TScroller.}MoveThumb(newThumbPos: INTEGER); &{Splitting} (PROCEDURE {TScroller.}ResplitAt(newSkwrCd: INTEGER; prevScroller: TScroller); (PROCEDURE {TScroller.}SplitAt(newSkwrCd: INTEGER; VAR nextScroller: TScroller); (END; $TScrollBar = SUBCLASS OF TObject &{Variables} (firstBox: TScroller; {the rest are found via the SB Library} (isVisible: BOOLEAN; {TRUE iff this scroll bar should be drawn} &{Creation/Destruction} (FUNCTION {TScrollBar.}CREATE(object: TObject; heap: THeap; vhs: VHSelect; outerRect: Rect; CitsVisibility: BOOLEAN): TScrollBar; (PROCEDURE {TScrollBar.}ChangeVisibility(needsBothBars: BOOLEAN; PbandOuterRect: Rect; itsAbilities: TAbilities); &{Buttoning} (FUNCTION {TScrollBar.}DownAt(mousePt: Point; VAR scroller: TScroller; VAR icon: TEnumIcons): BOOLEAN; &{Display} (PROCEDURE {TScrollBar.}Draw; (PROCEDURE {TScrollBar.}Erase; (END; $TMenuBar = SUBCLASS OF TObject {only one instance exists (menuBar)} &{Variables} (isLoaded: ARRAY [1..maxMenus] OF BOOLEAN; {TRUE iff the i'th menu has been inserted} (mapping: TArray {OF TWmgrCmd}; {maps command number to menu & item indices} (numMenus: INTEGER; {how many menus} (numCommands: INTEGER; {how many commands in all menus together} &{Creation/Destruction} (FUNCTION {TMenuBar.}CREATE(object: TObject; heap: THeap; itsScanner: TFileScanner): TMenuBar; &{Attributes} (PROCEDURE {TMenuBar.}Check(cmdNumber: TCmdNumber; checked: BOOLEAN); (PROCEDURE {TMenuBar.}Enable(cmdNumber: TCmdNumber; canBeChosen: BOOLEAN); (PROCEDURE {TMenuBar.}BuildCmdName(destCmd, templateCmd: TCmdNumber; param: TPString); 4{if param is NIL, use the default} (FUNCTION {TMenuBar.}GetCmdName(cmdNumber: TCmdNumber; pName: TPString): BOOLEAN; 4{returns TRUE iff cmdNumber is found (pName will be empty); 8pName can be NIL, which will save the overhead of returning the 8menu item, for case where you just want to see if it exists} (PROCEDURE {TMenuBar.}PutCmdName(cmdNumber: TCmdNumber; pName: TPString); &{Buttoning} (FUNCTION {TMenuBar.}CmdKey(ch: CHAR): TCmdNumber; (FUNCTION {TMenuBar.}DownAt(mousePt: Point): TCmdNumber; &{Display} (PROCEDURE {TMenuBar.}Draw; (PROCEDURE {TMenuBar.}EndCmd; (PROCEDURE {TMenuBar.}HighlightMenu(withCmd: TCmdNumber); 0{call this when the user presses the CLEAR key for example, to highlight 4the appropriate menu title; you should then call window.DoCommand with 4an apropriate command number.} &{Loading} (PROCEDURE {TMenuBar.}Delete(menuID: INTEGER); (PROCEDURE {TMenuBar.}Insert(menuID, beforeId: INTEGER); (PROCEDURE {TMenuBar.}Unload; &{For Future Use} (FUNCTION {TMenuBar.}MenuWithID(menuID: INTEGER): Ptr; (END; {$IFC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for Pepsi version} $TFont = SUBCLASS OF TObject &{Variables} (family: INTEGER; {Font Manager TFam} &{Creation/Destruction} (FUNCTION {TFont.}CREATE(object: TObject; heap: THeap; itsFamily: INTEGER): TFont; (END; {$ENDC} ${ GLOBAL VARIABLES -- EFFECTIVELY, FIELDS OF CLASS TProcess } VAR $activeWindowID: TWindowID; {The wmgrID field of the active document, or 0} $allowAbort: BOOLEAN; {Iff TRUE, allow aborts} $autoBreakPen: PenState; {pen to use to draw automatic page breaks} $blinkOffCentiSecs: LONGINT; {Centiseconds to hide the insertion point} $blinkOnCentiSecs: LONGINT; {Centiseconds to display the insertion point} $boundClipboard: TClipboard; {The clipboard whose data segment is bound, or NIL} $boundDocument: TDocManager; {The document whose data segment is bound, or NIL} $cancelString: STRING[20]; {The word "Cancel" for use in buttons} $clickState: TClickState; {Shifts and repeats of the last mouse click} $clipboard: TClipboard; {The Clipboard document manager} $clipPrintPref: TPrReserve; {the print-preference for the clipboard} $closedBySuspend: BOOLEAN; {Iff TRUE, closedDocument was just suspended} $closedDocument: TDocManager; {If not NIL, this document was just put away} $cornerNumberStyle: TTypeStyle; {TypeStyle used for page-numbers in page-preview} $countryCode: INTEGER; {The country code as read from phrase file} $currentDocument: TDocManager; {The active document OR if running in background, the Xdocument to use; otherwise NIL} $currentWindow: TWindow; {currentDocument.window, OR NIL} $cursorShape: TCursorNumber; {The cursor shape as recorded by TProcess.ChangeCursor} $deferUpdate: BOOLEAN; {set TRUE by app to defer updating while typing} $dfltNewHeading: STRING[20]; {+SW+} {Default value for newly-created headings} $docList: TList {OF TDocManager}; {The documents that are open} $eventTime: LONGINT; {The time of the most recent WM event} $eventType: INTEGER; {The type number of the most recent WM event} {$IFC fDbgABC} $fExperimenting: BOOLEAN; {IF TRUE, enable zoom experimentation etc.} $fCountHeap: BOOLEAN; {Iff TRUE and IFC fCheckHeap, count objects once per cmd} {$ENDC} {$IFC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for the Pepsi version} $fonts: ARRAY [0..maxFonts] OF TFont; {$ENDC} $genClipPic: BOOLEAN; {Iff TRUE, we are generating the Clipboard picture} $highLevel: ARRAY [BOOLEAN] OF THighTransit; {TRUE=>hOffToOn, FALSE=>hOffToDim} $highToggle: ARRAY [BOOLEAN] OF THighTransit; {TRUE=>hOffToOn, FALSE=>hOnToOff} $idleTime: LONGINT; {The time we finished processing the last user input} $inBackground: BOOLEAN; {Iff TRUE, currently running in background} $limboPen: PenState; {pen to use to fill limbo area in paginated view} $manualBreakPen: PenState; {pen to use to draw manual page breaks} $marginPattern: LPattern; {pattern to use to fill margins in paginated view} $menuBar: TMenuBar; {The menus of the application and the Clipboard} $myProcessID: LONGINT; {The OS ID of this process} $myTool: LONGINT; {The tool number of this tool} $normalPen: PenState; {pen state resulting from PenNormal} $okString: STRING[20]; {The word "OK" for use in buttons} $phraseFile: TFileScanner; {The Main Phrase File TFileScanner} $process: TProcess; {The process object of this process} $screenRightEdge: INTEGER; {720 for Lisa 1.0 screen} $scrollRgn: RgnHandle; {what needs to be refreshed because of scroll} $stdMargins: LRect; {standard page-margins, in screen pixels} $suspendSuffix: ARRAY [1..maxSegments] OF STRING[3]; $theBodyPad: TBodyPad; {current BodyPad being written to} $theMarginPad: TMarginPad; {current MarginPad being written to} $toolName: STRING[67]; {The name of the tool} $toolPrefix: TFilePath; (*The prefix '{Tnn}' of the OS path name of the tool*) $toolVolume: TFilePath; {The volume '-name-' on which the tool resides} $varPage: STRING[20]; {+SW+} {The string 'PAGE', for use in heading variables} $varTitle: STRING[20]; {+SW+} {The string 'TITLE' for use in heading variables} $wordDelimiters: STRING[67]; {The delimiters of a Lisa "word" in this language} PROCEDURE GetPrefixPart(wholeName: S255; VAR filePart: TFilePath); (*'{prefix}'*) FUNCTION ToolOfFile(wholeName: S255): LONGINT; FUNCTION ToolOfProcess(processId: LONGINT): LONGINT; { Used to insert comments into the Universal Graph of Clipboard, so LisaDraw can understand it; $These procedures only insert comment when we are generating the Universal Graph } @{ beginning of a series of text drawing ops that should be grouped } PROCEDURE PicTextBegin(alignment: TAlignment); PROCEDURE PicTextEnd; { end of series } PROCEDURE PicGrpBegin; { beginning of a series of grouped objects } PROCEDURE PicGrpEnd; { end of series } PROCEDURE InitProcess; FUNCTION GetTime: LONGINT; ${This function returns the same "time" as is used in events (see global variable eventTime), ,and in the idle loop} IMPLEMENTATION {$I LIBTK/UABC2.TEXT} {TProcess-TDocDirectory-TDocManager-TClipboard-TCommand-TCutCopyCommand- ;TPasteCommand} {$I LIBTK/UABC3.TEXT} {TImage-TView-TPaginatedView-TPageView-TPrintManager-THeading-TSelection} {$I LIBTK/UABC4.TEXT} {TWindow-TDialogBox-TMenuBar-TFont} {$I LIBTK/UABC5.TEXT} {TPanel-TBand-TPane-TMarginPad-TBodyPad-TScroller-TScrollBar} (********** {$I UABC2.TEXT} {TProcess-TDocDirectory-TDocManager-TClipboard-TCommand-TCutCopyCommand-TPasteCommand} {$I UABC3.TEXT} {TImage-TView-TPaginatedView-TPageView-TPrintManager-THeading-TSelection} {$I UABC4.TEXT} {TWindow-TDialogBox-TMenuBar-TFont} {$I UABC5.TEXT} {TPanel-TBand-TPane-TMarginPad-TBodyPad-TScroller-TScrollBar} **********) END. 3. "6F^56D!$ǐ^""N!; UNIT CLASLIB; {Copyright 1984, Apple Computer, Inc.} ; {changed 02/06/84 1530 %_Method must swap in caller} ; {changed 01/20/84 1530 IUJSR decoded corrected} ; {changed 01/18/84 0732 Fixed BEQ bug in %_CallMethod & renamed it %_MethodCall} ; {changed 01/09/84 2105 Separated from XFER so we can include it in PASLIB ; SgPASres: %_CallMethod, %_Super, %GoLisaBug; ; SgPASini: %_JmpTo, %_ExitCaller, %_ExitPoppingTo, %_GetA5, ; %_NextMethod; %_InsStack ; Added an argument to %_ExitPoppingTo} ;============================================================================================= DEBUGF .EQU 1 ; 1 to include $D+ info, 0 to exclude it ;============================================================================================= (.MACRO HEAD *.IF DEBUGF ,LINK A6,#0 ; These two instructions form a slow no-op ,MOVE.L (SP)+,A6 *.ENDC (.ENDM (.MACRO TAIL *.IF DEBUGF ,UNLK A6 ,RTS ,.ASCII %1 *.ENDC (.ENDM ;============================================================================================= (.SEG 'SgPASres' ;============================================================================================= (.PROC %_GoLisabug (HEAD ; PROCEDURE %_GoLisabug; (TRAP #0 (RTS (TAIL '%_GOLISA' ;============================================================================================= (.FUNC %_GetA5 (HEAD ; ; FUNCTION %_GetA5: LONGINT; { returns register A5 } ; ; USES A0 ; (MOVE.L (SP)+,A0 ; GET RETURN ADDRESS (MOVE.L A5,(SP) ; STORE A5 INTO RETURN SLOT (JMP (A0) ; EASY, HUH? (TAIL '%_GETA5 ' ;============================================================================================= (.PROC %_MethodCall (HEAD ; PROCEDURE %_MethodCall; ; 157 cycles or about 32 microseconds for a regular call ; uses A0,A1,D0,D1,D2 (MOVE.L (SP)+,A1 ;08 A1 := Return Address (TST.B (A1) ;08 Swap in caller (MOVE #0,D0; ;04 D0 := Level Number (0-origin) (MOVE.B (A1)+,D0 ;08 (LSL.W #2,D0 ;10 Change to a byte offset (MOVE #0,D1; ;04 D1 := Method Number (1-origin) (MOVE.B (A1)+,D1 ;08 (LSL.W #2,D1 ;10 Change to a byte offset (MOVE.L A1,-(SP) ;13 Return Address := A1 (which has been incremented by 2) (MOVE.L 4(SP),A0 ;16 A0 := SELF .IF DEBUGF (MOVE.L A0,D2 ;04 MOVEA didn't set condition codes (BEQ SELFNIL ;08 Error if NIL (next line fails anyway, but we could give a better msg} .ENDC (MOVE.L (A0),A0 ;12 A0 := master pointer of SELF (MOVE.L (A0),A0 ;12 A0 := slice table pointer of SELF's class (MOVE.L $00(A0,D0.W),A0 ;18 A0 := method table pointer for the desired level (MOVE.L -4(A0,D1.W),A0 ;18 A0 := method address (JMP (A0) ;08 Jump to method SELFNIL DIVS #0,D0 ; **Temporary** Error report (TAIL '%_METHOD' ;============================================================================================= (.PROC %_SUPER (HEAD ; PROCEDURE %_Super; ; 199 cycles or about 44 microseconds for SUPERSELF (chain dist = 1) ; uses A0,A1,D0,D1,D2 (MOVE.L (SP)+,A1 ;08 A1 := Return Address (MOVE #0,D1 ;04 D1 := Method Number (1-origin) (MOVE.B 1(SP),D1 ;12 (LSL.W #2,D1 ;10 Change to a byte offset (MOVE #0,D0 ;04 D0 := Level Number (0-origin) (MOVE.B (SP)+,D0 ;08 Increments SP by 2!! (LSL.W #2,D0 ;10 Change to a byte offset (MOVE.W (SP)+,D2 ;08 Chain distance (MOVE.L (SP)+,A0 ;12 Slice table pointer of this class (MOVE.L A1,-(SP) ;13 Return Address := A1 (which has not been modified) (JMP ENDSUPL ;10 SUPLOOP MOVE.L -4(A0),A0 ;16 A0 := superclass slice table pointer ENDSUPL DBEQ D2,SUPLOOP ;10-14 Loop until chain distance has been traversed (or end of chain) (MOVE.L $00(A0,D0.W),A0 ;18 A0 := method table pointer for the desired level (MOVE.L -4(A0,D1.W),A0 ;18 A0 := method address (JMP (A0) ;08 Jump to method SELFNIL DIVS #0,D0 ; **Temporary** Error report (TAIL '%_SUPER ' ;============================================================================================= (.SEG 'SgPASini' ;============================================================================================= (.PROC %_JMPTO (HEAD ; PROCEDURE %_JmpTo(pc: LONGINT); ; uses A0 (MOVE.L (SP)+,A0 ; Pop Return address and ignore it (MOVE.L (SP)+,A0 ; Pop pc argument (JMP (A0) ; Jump there (TAIL '%_JMPTO ' ;============================================================================================= (.PROC %_EXITCA (HEAD ; PROCEDURE %_ExitCaller; that is, exit the caller of my caller, undoing two LINKs ; modifies A6,SP (UNLK A6 (UNLK A6 (RTS (.IF DEBUGF (.ASCII '%_EXITCA' (.ENDC ;============================================================================================= (.PROC %_EXITPO (HEAD ; PROCEDURE %_ExitPoppingTo(newSP: LONGINT); ; exit my caller, and cut back the stack of the next frame to newSP ; uses A0,A1 and modifies A6,SP (MOVE.L 4(A6),A0 ; A0 := caller's return address (MOVE.L 4(SP),A1 ; A1 := newSP (UNLK A6 ; pop my caller's stack frame (MOVE.L A1,SP ; SP := newSP (JMP (A0) (.IF DEBUGF (.ASCII '%_EXITPO' (.ENDC ;============================================================================================= (.FUNC %_NextMethod (HEAD ; FUNCTION %_NextMethod(VAR pc@12: LONGINT; ; VAR impLevelNumber@8, impMethNumber@4: INTEGER ; )@16: ProcPtr; ; uses A0,A1,D0 (MOVE.L 12(SP),A0 ; @PC (MOVE.L (A0),A1 ; PC throughout this routine (TST.B (A1) ; swap in the code to test INTRPLP CMP.W #$4EBA,(A1) ; test for JSR PC+d (BEQ JSR_PC (CMP.W #$4EAD,(A1) ; test for JSR d(A5) (BEQ JSR_A5 (CMP.B #$A0,(A1) ; test for IUJSR (BEQ INTJSR (CMP.W #$3F3C,(A1) ; test for MOVE.W #nn,-(SP) (BEQ PSHCON (DIVS #0,D0 ; supposedly impossible PSHCON MOVE.W #0,D0 ; Clear D0 before loading a byte into it (MOVE.B 2(A1),D0 ; D0 := the "Hi" of JSR PC+HiLo, i.e., levelNumber (MOVE.L 8(SP),A0 ; A0 := @levelNumber (MOVE.W D0,(A0) ; store levelNumber from D0 (MOVE.W #0,D0 ; Clear D0 before loading a byte into it (MOVE.B 3(A1),D0 ; D0 := the "Lo" of JSR PC+HiLo, i.e., methodNumber (SUB.W #1,D0 ; decrement methodNumber (will be re-incremented by FINJSR) (MOVE.L 4(SP),A0 ; A0 := @methodNumber (MOVE.W D0,(A0) ; store methodNumber-1 from D0 (ADD.L #4,A1 ; increment PC past MOVE (JMP INTRPLP INTJSR MOVE.L (A1),D1 ; D1 := IUJSR xxx (AND.L #$FFFFFF,D1 ; D1 := targetLocation (MOVE.L D1,A0 ; A0 := targetLocation FINJSR MOVE.L A0,16(SP) ; function result := targetLocation (ADD.L #4,A1 ; increment PC past JSR (MOVE.L 12(SP),A0 ; @PC (MOVE.L A1,(A0) ; store back incremented PC (MOVE.L 4(SP),A0 ; A0 := @methodNumber (ADD.W #1,(A0) ; increment methodNumber (MOVE.L (SP)+,A0 ; pop and save return address (ADD.L #12,SP ; pop and discard arguments (JMP (A0) ; return JSR_PC MOVE.W 2(A1),D0 ; D0 := the "d" of JSR PC+d (LEA 2(A1,D0.W),A0 ; A0 := targetLocation (JMP FINJSR JSR_A5 MOVE.W 2(A1),D0 ; D0 := the "d" of JSR d(A5) (LEA 0(A5,D0.W),A0 ; A0 := targetLocation (JMP FINJSR (TAIL '%_NEXTME' ;============================================================================================= (.FUNC %_InsStack (HEAD ; PROCEDURE %_InsStack(addrToInsertAt, bytesToInsert: LONGINT); ; ; This routine must be used with extreme care. It inserts space in the middle of the stack. ; It adjusts A6, A7, and the static chain, but it can not adjust other pointers that may ; exist into the moved area; that is the responsibility of the caller. ; This assumes that at least one static link needs adjustment ; uses A0,A1,D0,D1,D2; modifies A6,A7 and static chain (MOVE.L (SP)+,D2 ; D2 := Return address (MOVE.L (SP)+,D1 ; D1 := bytesToInsert: must be even and at least 4 (MOVE.L (SP)+,D0 ; D0 := addrToInsertAt: must be even (SUB.L SP,D0 ; D0 := how many bytes need to move (SUB.W #2,D0 ; D0.W := how many longs (LSR.W #2,D0 ; ... need to move (MOVE.L SP,A0 ; A0 := Old SP (SUB.L D1,SP ; SP := ultimate SP (MOVE.L SP,A1 ; A1 := ultimate SP (TST.W -1024(SP) ; Make the OS expand the stack if necessary INSLP MOVE.L (A0)+,(A1)+ ; Move the data (DBF D0,INSLP (SUB.L D1,A6 ; A6 := ultimate A6 (MOVE.L A6,A1 ; A1 := addr of first static link ADJLP SUB.L D1,(A1) ; adjust this static link (MOVE.L (A1),A1 ; A1 := addr of next static link (MOVE.L (A1),D0 ; D0 := value of that static link (CMP.L A0,D0 ; If (value of that static link - first unmoved addr) (BLT ADJLP ; < 0 then that static link needs adjusting, too (MOVE.L D2,A1 ; A1 := Return address (JMP (A1) ; Return and Pray (TAIL '%_INSSTA' ;============================================================================================= (.END Kb> TK Source 1̆V{t-#1#1-T8̆VmK :a$kTk\:)$ "#." #"##%& ! .3. "6F^9ClD!$ǐ^(66A\f; ${$ENDC} "{Hash the name of the superclass} $IF itsSuperName = 'NIL ' THEN (BEGIN {This class has no superclass (e.g., TObject)} (superClIndex := 0; (itsLevelNumber := 0; (superSTP := NIL; (END $ELSE (BEGIN (superClIndex := pHashName^[LookupClassAlpha(superAlpha, FALSE)]; (itsLevelNumber := NumSlices(superClIndex); (superSTP := pSTables^[superClIndex]; (END; "{Fill this slice table with NI{UClascal -- In Spring '84 Release, part of PASLIB: only special units like UOBJECT will ever USE it} {Copyright 1984, Apple Computer, Inc.} {changed 04/02/84 1330 Before exiting %_PGM2, see if the compiler saved A7 away, and if so  0 THEN (BEGIN (trialSTP := PPPST(ordObject)^^; (pSTP := @trialSTP; (TPByte(pSTP)^ := 0; (WHILE trialSTP <> PST(ordSTP) DO ,BEGIN ,IF classesInitialized THEN 0trialSTP := trialSTP^[-1] ,ELSE 0trialSTP := PST (TPMethodArray(pSTables^[pClasses^[CiOfCp(TPSliceTable(trialSTP))].superIndex])); ,IF ORD(trialSTP) <= 0 THEN 0EXIT(%_InObCp); ,END; (%_InObCp := TRUE; (END; END; FUNCTION %_InObCn(ordObject: LONGINT; VAR className: TS8): BOOLEAN; $TYPE PST = ^TST; ,TST = ARRAY[0..0] OF PST; ,PPST = ^PST; ,PPPST = ^PPST; $VAR trialSTP: PST; (tryClassName: TS8; (pSTP: PPST; BEGIN $%_InObCn := FALSE; $IF ordObject <> 0 THEN (BEGIN (trialSTP := PPPST(ordObject)^^; (pSTP := @trialSTP; (TPByte(pSTP)^ := 0; (REPEAT ,CpToCn(TPSliceTable(trialSTP), tryClassName); ,IF tryClassName = className THEN 0BEGIN 0%_InObCn := TRUE; 0EXIT(%_InObCn); 0END; ,IF classesInitialized THEN 0trialSTP := trialSTP^[-1] ,ELSE 0trialSTP := PST(TPMethodArray(pSTables^[pClasses^[CiOfCp(TPSliceTable(trialSTP))].superIndex])); *UNTIL ORD(trialSTP) <= 0; (END; END; {Each typecast expression TFoo(val) with range checking on generates: $%_CkObCp(val, classPtr) or %_CkObCn(val, 'TFOO ') $The former ("Check Object Class Pointer") is generated when TFoo is defined in the same unit. $The latter ("Check Object Class Name") is generated when TFoo is defined in another unit. $Both are defined below} FUNCTION %_CkObCp(ordObject, ordSTP: LONGINT): LONGINT; $VAR objClassName: TS8; (desClassName: TS8; BEGIN $%_CkObCp := ordObject; $IF ordObject <> 0 THEN (IF NOT %_InObCp(ordObject, ordSTP) THEN ,BEGIN ,CpToCn(TPSliceTable(Handle(ordObject)^^), objClassName); ,CpToCn(TPSliceTable(ordSTP), desClassName); ,{$IFC fDbgClascal} ,CLABreak(CONCAT('Attempt to coerce an object of class ',  0 THEN (IF NOT %_InObCn(ordObject, className) THEN ,BEGIN ,CpToCn(TPSliceTable(Handle(ordObject)^^), objClassName); ,{$IFC fDbgClascal} ,CLABreak(CONCAT('Attempt to coerce an object of class ', = addrOfOtherArray THEN ,addrOfOtherArray := addrOfOtherArray - bytesToInsert; ({$IFC fTrcClascal} (WriteLn(addrOfOtherArray:12); ({$ENDC} $END; BEGIN ${$IFC fTrcClascal} $WriteLn('$$$ About to insert ', bytesToInsert:4, ' bytes after byte ', afterByte:3, ,' of ', addrOfGrownArray:5, '$$$'); ${$ENDC} $%_InsStack(addrOfGrownArray + afterByte, bytesToInsert); {bytesToInsert must be even and at least 4} $AdjustPArray(LONGINT(pAuthors), 'pAuthors'); $AdjustPArray(LONGINT(pAliases), 'pAliases'); $AdjustPArray(LONGINT(pClasses), 'pClasses'); $AdjustPArray(LONGINT(pSTables), 'pSTables'); $AdjustPArray(LONGINT(pMethods), 'pMethods'); $AdjustPArray(LONGINT(pHashName),'pHashName'); $AdjustPArray(LONGINT(pHashUnit),'pHashUnit'); END; FUNCTION MAllocate(numNeeded, numToGrowBy: INTEGER): LONGINT; ({** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING InsStack **} $VAR numBytes: LONGINT; (bytesToInsert: LONGINT; BEGIN $numBytes := 4 * numNeeded; $mAllocAddr := mAllocAddr - numBytes; $MAllocate := mAllocAddr; $bytesToInsert := ORD(pMethods) - mAllocAddr; $IF bytesToInsert > 0 THEN (BEGIN (IF bytesToInsert < (4 * numToGrowBy) THEN ,bytesToInsert := 4 * numToGrowBy; (InsStack(ORD(pMethods), 0, bytesToInsert); (END; ${$IFC fTrcClascal} $WriteLn('******* Allocated ', numNeeded:3, ' method entries at ', mAllocAddr:5, '********'); ${$ENDC} END; FUNCTION RAllocate(bytesPerRec, numNow, numToGrowBy, numRoomFor, maxNumAllowed: INTEGER; 3whutzits: TS8; ordPArray: LONGINT): INTEGER; ({** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING InsStack **} ({bytesPerRec must be even; this function returns the new numRoomFor value} $VAR bytesToInsert: INTEGER; BEGIN $IF (numRoomFor + numToGrowBy) > maxNumAllowed THEN (numToGrowBy := maxNumAllowed - numRoomFor; $IF numToGrowBy <= 0 THEN ({$IFC fDbgClascal} (CLABreak(CONCAT('Too many ', whutzits), maxNumAllowed); ({$ELSEC} (CLAFail(0); ({$ENDC} $bytesToInsert := bytesPerRec * numToGrowBy; $InsStack(ordPArray, bytesPerRec * numNow, bytesToInsert); $RAllocate := numRoomFor + numToGrowBy; END; FUNCTION LookupAuthor(VAR classAuthor: TA32): INTEGER; ({There should be room for two Authors (a ClassAuthor & a UnitAuthor) because %_Class checked} $VAR addr: LONGINT; (i: INTEGER; BEGIN $addr := ORD(pAuthors); $FOR i := 1 TO numAuthors DO (BEGIN (IF TPA32(addr)^ = classAuthor THEN ,BEGIN ,LookupAuthor := i; ,EXIT(LookupAuthor); ,END; (addr := addr + 32; (END; $IF numAuthors >= limAuthors THEN (CLAFail(0) $ELSE (BEGIN (numAuthors := numAuthors + 1; (TPA32(addr)^ := classAuthor; (LookupAuthor := numAuthors; (END; END; {** I tried merging the routines above and below, but I don't think it is worth it **} FUNCTION LookupAlias(VAR classAlias: TA8): INTEGER; ({There should be room for one alias because %_Class checked} $VAR addr: LONGINT; (i: INTEGER; BEGIN $addr := ORD(pAliases); $FOR i := 1 TO numAliases DO (BEGIN (IF TPA8(addr)^ = classAlias THEN ,BEGIN ,LookupAlias := i; ,EXIT(LookupAlias); ,END; (addr := addr + 8; (END; $IF numAliases >= limAliases THEN (CLAFail(0) $ELSE (BEGIN (numAliases := numAliases + 1; (TPA8(addr)^ := classAlias; (LookupAlias := numAliases; (END; END; PROCEDURE QUnitAuthor(VAR companyAndAuthor: TA32); BEGIN $IF classesInitialized THEN (CLAFail(0); $authorOfUnit := LookupAuthor(companyAndAuthor); END; PROCEDURE QClassAuthor(VAR companyAndAuthor: TA32); BEGIN {Must call procedures before the WITH because Lookups might move pClasses^} $IF classesInitialized THEN (CLAFail(0); $pClasses^[numClasses].companyAndAuthor := LookupAuthor(companyAndAuthor); END; PROCEDURE QClassAlias(VAR classAlias: TA8); BEGIN {Must call procedures before the WITH because Lookups might move pClasses^} $IF classesInitialized THEN (CLAFail(0); $pClasses^[numClasses].classAlias := LookupAlias(classAlias); END; PROCEDURE QClassVersion(itsVersion, oldestItCanRead: TByte); BEGIN $IF classesInitialized THEN (CLAFail(0); $WITH pClasses^[numClasses] DO (BEGIN (version := itsVersion; (oldestReadableVersion := oldestItCanRead; (END; END; FUNCTION NumSlices(classIndex: INTEGER): INTEGER; $VAR n: INTEGER; BEGIN $n := 0; $WHILE classIndex > 0 DO (BEGIN (classIndex := pClasses^[classIndex].superIndex; (n := n + 2; (END; $NumSlices := n; END; FUNCTION CallCallPC: LONGINT; $VAR dummy: INTEGER; { must be first local and two bytes long } BEGIN $CallCallPC := TPLint(TPLint(TPLint(ORD(@dummy) + 2)^)^ + 4)^; {caller's caller's return address} END; FUNCTION CallPC: LONGINT; $VAR dummy: INTEGER; { must be first local and two bytes long } BEGIN $CallPC := TPLint(TPLint(ORD(@dummy) + 2)^ + 4)^; {caller's return address} END; PROCEDURE SetCallPC(pc: LONGINT); $VAR dummy: INTEGER; { must be first local and two bytes long } (addrOfPC: LONGINT; BEGIN $addrOfPC := TPLint(ORD(@dummy) + 2)^ + 4; $TPLint(addrOfPC)^ := pc; {caller's return address} END; FUNCTION LookupInHashArray(tblSize: INTEGER; hashKey: LONGINT; toInsert: BOOLEAN; 0FUNCTION Compare(index: INTEGER): THashCompare): INTEGER; ({toInsert, return: -index if entry already there, index (>0) if a hole found} ({not toInsert, return: index (> 0) if entry found, -index if not there} ({return 0 if table is full} $VAR probe: INTEGER; (origProbe: INTEGER; (hashCompare: THashCompare; BEGIN {This could be made faster -- and probably should be} $LookupInHashArray := 0; $probe := hashKey; $probe := (ABS(probe) MOD tblSize) + 1; $origProbe := probe; $REPEAT (hashCompare := Compare(probe); (IF hashCompare <> cMismatch THEN ,BEGIN ,IF toInsert = (hashCompare = cHole) THEN 0LookupInHashArray := probe ,ELSE 0LookupInHashArray := - probe; ,EXIT(LookupInHashArray); ,END; (probe := probe + 1; (IF probe > tblSize THEN ,probe := 1; &UNTIL probe = origProbe; END; {$IFC fTrcClascal} PROCEDURE DumpArrays; $VAR index: INTEGER; (itsSTP: TPSliceTable; (slices: INTEGER; (s: TS8; (j: INTEGER; (i: INTEGER; (level: INTEGER; (methArrPtr: TPMethodArray; (numAtThatLevel: INTEGER; BEGIN $WriteLn; $WriteLn(' *************** ARRAYS *************** '); $WriteLn; $FOR index := 1 TO numClasses DO (BEGIN (Write('Class Index = ', index:3); (itsSTP := pSTables^[index]; (Write(' Class Pointer = ', ORD(itsSTP):10); (slices := NumSlices(index); (Write(' Number of slices = ', slices:3); (s[0] := CHAR(8); (FOR j := 1 TO 8 DO ,s[j] := pClasses^[index].classAlpha[j]; (WriteLn(' Name = ', s); (i := index; (FOR level := slices - 1 DOWNTO 0 DO ,BEGIN ,Write(' Level ', level:1); ,Write(' Index ', i:2); ,methArrPtr := itsSTP^[level]; ,Write(' Method array ptr = ', ORD(methArrPtr):10); ,numAtThatLevel := TPWords(pSTables^[i])^[ORD(ODD(level))-2]; ,Write(' numAtThatLevel ', numAtThatLevel:2); ,IF methArrPtr = NIL THEN 0WriteLn(', ... all Abstract') ,ELSE 0BEGIN 0WriteLn; 0FOR j := 1 TO numAtThatLevel DO 4WriteLn(j:10, ORD(methArrPtr^[j]):10); 0END; ,IF NOT ODD(level) THEN 0i := pClasses^[i].superIndex; ,WriteLn; ,END; (WriteLn; (END; END; {$ENDC} {The main program starts with: $JSR %_Pgm1 ; Defined below $JSR unit#m ; for every unit USEd by the main program within $CLASSES+ (in order USEd)... $... $JSR unit#n $JSR %_Pgm2 ; Defined below} PROCEDURE %_Pgm1; $VAR methads: ARRAY [1..minMethods] OF ProcPtr; {!!! MUST MUST MUST be the first VAR !!!} (aliases: ARRAY [1..minAliases] OF TA8; {!!! Should be in this group of VARs !!!} (authors: ARRAY [1..minAuthors] OF TA32; {!!! Should be in this group of VARs !!!} (sTables: ARRAY [1..minClasses] OF TPSliceTable;{!!! Should be in this group of VARs !!!} (classes: ARRAY [1..minClasses] OF TClassInfo; {!!! Should be in this group of VARs !!!} &{The arrays above can grow; only one ptr to each is maintained in a global variable, e.g., pMethods} (excepName: T_Ex_Name; {These all stay allocated until the end of %_Pgm2} (error: INTEGER; (addr: LONGINT; (i: INTEGER; (hashUnit: TUnitArray; (hashName: TIdxArray; BEGIN #{Install Default Finished procedure} $pFinishedProc := @DefaultFinished; #{Initialize global interface variables} $pleaseInitClascal := TRUE; {A global set to FALSE in InitClascal} $classesInitialized := FALSE; {A global set TRUE in %_Pgm2} $pClasses := @classes; $pSTables := @sTables; $pAuthors := @authors; $pAliases := @aliases; $pMethods := @methads; {methads spelled funny because METHODS is a reserved word} ({NOTE: pMethods^[] is never written; the "ARRAY" can be > 32K bytes if necessary} $limClasses := minClasses; $limAuthors := minAuthors; $limAliases := minAliases; $limMethods := minMethods; $numClasses := 0; {incremented by %_Class} $numAuthors := 0; {never modified in this unit; UOBJECT manages them} $numAliases := 0; {never modified in this unit; UOBJECT manages them} $numMethods := 0; {incremented by FillArraysFrom, called by %_Class} #{Set the scheduling mode} $Sched_Class(error, TRUE); $IF error > 0 THEN (CLAFail(error); #{Set six bytes at 0(A5) to JMP %_MethodCall in XFER} $addr := %_GetA5; $TPInt(addr)^ := $4EF9; {JMP fullAddr} $addr := addr + 2; $TPLint(addr)^ := ORD(@%_MethodCall); #{Clear hash tables} $FOR i := 1 TO maxUnits DO (hashUnit[i] := 0; $FOR i := 1 TO maxClasses DO (hashName[i] := 0; #{Initialize global implementation variables} $pHashName := @hashName; $pHashUnit := @hashUnit; $authorOfUnit := 0; $mAllocAddr := ORD(pMethods) + limMethods * 4; $biggestAbstractClass := 1; {Could be 0, but this produces a more comprehensible memory dump} $currCallCallPC := 0; $p%_Class := @%_Class; {The %_NextMethod loop in %_Class stops at a JSR %_Class} $pJmp%_Class := GetPJmp%_Class; {A function in another segment must get the jump table address for me} #{We can never return because we need our locals around during the unit initializations and need 'the method tables around forever} $%_JmpTo(CallPC); END; PROCEDURE EndPreviousUnit; {We don't require companyAndAuthor--but client could do so at the end of %_Pgm2} $VAR i: INTEGER; BEGIN $IF authorOfUnit <> 0 THEN (FOR i := oldNumClasses + 1 TO numClasses DO ,WITH pClasses^[i] DO 0IF companyAndAuthor = 0 THEN 4companyAndAuthor := authorOfUnit; $authorOfUnit := 0; $oldNumClasses := numClasses; END; PROCEDURE %_Pgm2; ({** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING MAllocate **} $VAR dummy: LONGINT; {MUST BE FIRST VAR AND 4 BYTES LONG!!!} (pAbstracts: TPMethodArray; (index: INTEGER; (extraLongs: LONGINT; (itsSTP: TPSliceTable; (slices: INTEGER; (level: INTEGER; (objSize: INTEGER; (pInt: TPInt; (pLint: TPLint; BEGIN $EndPreviousUnit; "{For any slice that was fully abstract, we will make it point at a special block of @_Abstract} $pAbstracts := TPMethodArray(MAllocate(biggestAbstractClass, 16)); $numMethods := numMethods + biggestAbstractClass; $FOR index := 1 TO biggestAbstractClass DO (pAbstracts^[index] := ORD(@ _Abstract); "{Assure sufficient room for names} $dictBase := mAllocAddr + (numMethods * 4); $firstPackedName := (numMethods DIV 8) + 1; $extraLongs := 2 * (numClasses - firstPackedName + 1); $IF extraLongs > 0 THEN (dummy := MAllocate(extraLongs, 0); ${$IFC fTrcClascal} $WriteLn('biggestAbstractClass = ', biggestAbstractClass:6); $WriteLn('numMethods allocated = ', numMethods:6); $WriteLn('firstPackedName = ', firstPackedName:6); $WriteLn('extraLongs = ', extraLongs:6); $WriteLn('mAllocAddr = ', mAllocAddr:6); $WriteLn('dictBase = ', dictBase:6); $WriteLn('pClasses = ', ORD(pClasses):6); $WriteLn('pSTables = ', ORD(pSTables):6); ${$ENDC} "{Search back from call to %_PGM2 for a MOVE.L A7, xxxx(A5) (opcode $2B4F); if found, calculate the (address that contains the saved A7 and stuff in mAllocAddr instead. Stop searching if we (find a LINK A5, xxxx instruction.} $pLint := Pointer(Ord(@dummy) + 8); {pLint^ should be our return address} $pInt := Pointer(pLint^); $WHILE (pInt^ <> $2B4F {MOVE.L A7, xxxx(A5)}) AND (pInt^ <> $4E55 {LINK A5, xxxx}) DO (pInt := Pointer(Ord(pInt) - 2); $IF pInt^ = $2B4F THEN (BEGIN (pInt := Pointer(Ord(pInt) + 2); (pLint := Pointer(pInt^ + %_GetA5); (pLint^ := mAllocAddr; (END; "{Final initialization of each class in turn} $FOR index := 1 TO numClasses DO (BEGIN &{Fill in missing slices} (itsSTP := pSTables^[index]; (slices := NumSlices(index); (FOR level := 0 TO slices - 1 DO ,IF itsSTP^[level] = NIL THEN 0itsSTP^[level] := pAbstracts; &{Copy the name to the method table area} (StoreCn(index, pClasses^[index].classAlpha); &{The class index is recorded in the slice table, bytes 0 and 4 (high and low order bytes)} &{The object size is recorded in the slice table, bytes 8 and 12, unless there are only two slices,} &{..in which case the long before the slice table has a -1 in the even word and the object size )in the odd word, instead of a superlink} (objSize := pClasses^[index].objectSize; (IF slices > 2 THEN ,BEGIN ,TPOctets(itsSTP)^[8] := TPOctets(@objSize)^[0]; ,TPOctets(itsSTP)^[12] := TPOctets(@objSize)^[1]; ,itsSTP^[-1] := TPMethodArray(pSTables^[pClasses^[index].superIndex]); ,END (ELSE ,BEGIN ,TPWords(itsSTP)^[-2] := -1; ,TPWords(itsSTP)^[-1] := objSize; ,END; (TPOctets(itsSTP)^[0] := TPOctets(@index)^[0]; (TPOctets(itsSTP)^[4] := TPOctets(@index)^[1]; (END; "{Report success to higher levels and let it copy the tables it may desire before we destroy them} $CallFinishedProc(DefaultFinishedProc, 0); $pClasses := NIL; $pSTables := NIL; $pAuthors := NIL; $pAliases := NIL; $pMethods := NIL; "{Just to keep things clean and consistent} $pHashName := NIL; $pHashUnit := NIL; "{Disable UnitAuthor, ClassAuthor, ClassVersion, ClassSize, and FinishedProc} $classesInitialized := TRUE; "{Exit from %_Pgm1, finally freeing its local storage below the TMethodArray} $%_ExitPoppingTo(mAllocAddr); END; {Each unit ends with: $.PROC unit#i $JSR %_Unit ; Defined below $JSR unit#x ; for every unit USEd by the unit within $CLASSES+ (in order USEd)... $... $JSR unit#z $JSR class-init#1 ; for every class implemented in unit#i... $... $JSR class-init#k $RTS } PROCEDURE %_Unit; $VAR unitPC: LONGINT; (hashUNIndex: INTEGER; $FUNCTION CompareUnit(hashIndex: INTEGER): THashCompare; (VAR pc: LONGINT; $BEGIN (pc := pHashUnit^[hashIndex]; (IF pc = 0 THEN ,CompareUnit := cHole (ELSE (IF pc = unitPC THEN ,CompareUnit := cMatch (ELSE ,CompareUnit := cMismatch; $END; BEGIN $unitPC := CallPC; $hashUNIndex := LookupInHashArray(maxUnits, unitPC, TRUE, CompareUnit); $IF hashUNIndex > 0 THEN {first time here -- let the initialization happen} (pHashUnit^[hashUNIndex] := unitPC $ELSE (%_ExitCaller(0); {exit from .PROC unit#i because we have already initialized this unit} END; ${toInsert, return: -index if class already there or if table full, index (> 0) if a hole found} ${not toInsert, return: index (> 0) if class found, -index if not there} ${return 0 if table is full} FUNCTION LookupClassAlpha(keyA8: TA8; toInsert: BOOLEAN): INTEGER; $FUNCTION CompareName(hashIndex: INTEGER): THashCompare; (VAR myIndex: INTEGER; $BEGIN (myIndex := pHashName^[hashIndex]; (IF myIndex = 0 THEN ,CompareName := cHole (ELSE (IF pClasses^[myIndex].classAlpha = keyA8 THEN ,CompareName := cMatch (ELSE ,CompareName := cMismatch; $END; BEGIN $LookupClassAlpha := LookupInHashArray(maxClasses, ORD(keyA8[2])*ORD(keyA8[4])+ORD(keyA8[6]), JtoInsert, CompareName); END; FUNCTION FillArraysFrom(pc: LONGINT; itsLevelNumber: INTEGER; superSTP: TPSliceTable; 8itsSTP: TPSliceTable; itsOddMethods: INTEGER): LONGINT; ({** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING MAllocate **} $VAR impLevelNumber: INTEGER; (impMethNumber: INTEGER; (targetLocation: ProcPtr; (fini: BOOLEAN; (impMethodArrayPtr: TPMethodArray; (index: INTEGER; (level: INTEGER; (numAtThatLevel: INTEGER; (superMethodArrayPtr: TPMethodArray; (canInherit: BOOLEAN; (methodNumber: INTEGER; BEGIN $impLevelNumber := itsLevelNumber; $impMethNumber := 0; $REPEAT (targetLocation := %_NextMethod(pc, impLevelNumber, impMethNumber); (fini := (targetLocation = p%_Class) OR (targetLocation = pJmp%_Class); (IF NOT fini THEN ,BEGIN ,impMethodArrayPtr := itsSTP^[impLevelNumber]; ,IF impMethodArrayPtr = NIL THEN 0BEGIN 0index := numClasses; 0level := itsLevelNumber; {always even} 0{$IFC fTrcClascal} 0WriteLn('pClasses = ', ORD(pClasses)); 0WriteLn('Index Level', ' impLevelNumber = ', impLevelNumber:3); 0WriteLn(index:3, level:12); 0{$ENDC} 0WHILE level > impLevelNumber DO 4BEGIN 4index := pClasses^[index].superIndex; 4level := level - 2; 4{$IFC fTrcClascal} 4WriteLn(index:3, level:12); 4{$ENDC} 4END; 0{$IFC fTrcClascal} 0WriteLn('-- In FillArrays, making a new method table --'); 0WriteLn('pc = ', pc:12, ' itsLevelNumber = ', itsLevelNumber:3, 8' superSTP = ', ORD(superSTP):12, ' itsSTP = ', ORD(itsSTP):12); 0WriteLn(' itsOddMethods = ', itsOddMethods:3, 8' impMethNumber = ', impMethNumber:3, 8' targetLocation = ', ORD(targetLocation):12); 0WriteLn(' index = ', index:3, 8' level = ', level:3, 8' word[-2] = ', TPWords(pSTables^[index])^[-2]:7, 8' word[-1] = ', TPWords(pSTables^[index])^[-1]:7); 0{$ENDC} 0numAtThatLevel := TPWords(pSTables^[index])^[ORD(ODD(impLevelNumber))-2]; 0{$IFC fTrcClascal} 0WriteLn('numAtThatLevel = ', numAtThatLevel:3); 0{$ENDC} 0impMethodArrayPtr := TPMethodArray(MAllocate(numAtThatLevel, growMethods)); 0numMethods := numMethods + numAtThatLevel; 0itsSTP^[impLevelNumber] := impMethodArrayPtr; 0IF superSTP = NIL THEN 4superMethodArrayPtr := NIL 0ELSE 4superMethodArrayPtr := superSTP^[impLevelNumber]; {may be NIL} 0canInherit := (impLevelNumber < itsLevelNumber) AND (superMethodArrayPtr <> NIL); 0FOR methodNumber := 1 TO numAtThatLevel DO 4IF canInherit THEN 8impMethodArrayPtr^[methodNumber] := superMethodArrayPtr^[methodNumber] 4ELSE 8impMethodArrayPtr^[methodNumber] := ORD(@ _Abstract); 0END; ,impMethodArrayPtr^[impMethNumber] := ORD(targetLocation); ,END; $UNTIL fini; "{For any inherited slice that had no overrides, make it point at the same slice as the superclass} $FOR level := 0 TO itsLevelNumber - 1 DO (IF itsSTP^[level] = NIL THEN ,itsSTP^[level] := superSTP^[level]; {may be NIL, too} "{If the odd slice has only ABSTRACT methods, then use a global to tell %_Pgm2 what to do} $IF itsSTP^[itsLevelNumber + 1] = NIL THEN (IF itsOddMethods > biggestAbstractClass THEN ,biggestAbstractClass := itsOddMethods; ${$IFC fTrcClascal} $DumpArrays; {*************************************************************************} ${$ENDC} $FillArraysFrom := pc; END; {The class-init routine of TFoo = SUBCLASS OF TSuperclass starts with: $JSR %_Class('TFOO ', 'TSUPERCL', @sliceTable, sizeOfEvenSlice, sizeOfOddSlice, objSize); Defined below $JSR method#1(sliceNumber*256 + methodNumber) ; for every method in the IMPLEMENTATION $... ; these calls are not executed: %_Class interprets them $JSR method#r(sliceNumber*256 + methodNumber) ; slice 0 is TObject, method 1 is first method $JSR %_Class ; just a terminator (The first call on %_Class interprets through here)} PROCEDURE %_Class(itsClassName, itsSuperName: TS8; itsSTP: TPSliceTable; 3itsEvenMethods, itsOddMethods, itsObjSize: INTEGER); ({** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING RAllocate & FillArraysFrom **} $VAR i: INTEGER; (itsAlpha: TA8; (superAlpha: TA8; (nameHashIndex: INTEGER; (superClIndex: INTEGER; (superSTP: TPSliceTable; (itsLevelNumber: INTEGER; (pc: LONGINT; (level: INTEGER; BEGIN "{First class of a unit?} $IF CallCallPC <> currCallCallPC THEN (BEGIN (EndPreviousUnit; (currCallCallPC := CallCallPC; (END; "{Increment numClasses but first be sure there is room in the arrays... this could move ALL the arrays!} $IF numClasses > (limClasses - 2) THEN (BEGIN (i {dummy} := RAllocate(SIZEOF(TClassInfo), numClasses, @growClasses, limClasses, maxClasses, 'Classes', ORD(pClasses)); (limClasses := RAllocate(SIZEOF(TPSliceTable), numClasses, @growClasses, limClasses, maxClasses, 'Classes', ORD(pSTables)); (END; $numClasses := numClasses + 1; "{Convert names from TS8 to TA8 type} $FOR i := 1 TO 8 DO (BEGIN (itsAlpha[i] := itsClassName[i]; (superAlpha[i] := itsSuperName[i]; (END; "{Enter this class into the name hash table} $nameHashIndex := LookupClassAlpha(itsAlpha, TRUE); {Temporary variable needed because stack may quake} $IF nameHashIndex > 0 THEN (pHashName^[nameHashIndex] := numClasses $ELSE ${$IFC fDbgClascal} $IF nameHashIndex < 0 THEN (CLABreak('Class name appeared twice', numClasses) $ELSE (CLABreak('Class Name Hash table full', maxClasses); ${$ELSEC} (CLAFail(0); ${$ENDC} "{Hash the name of the superclass} $IF itsSuperName = 'NIL ' THEN (BEGIN {This class has no superclass (e.g., TObject)} (superClIndex := 0; (itsLevelNumber := 0; (superSTP := NIL; (END $ELSE (BEGIN (superClIndex := pHashName^[LookupClassAlpha(superAlpha, FALSE)]; (itsLevelNumber := NumSlices(superClIndex); (superSTP := pSTables^[superClIndex]; (END; "{Fill this slice table with NILs for the moment} $FOR level := 0 TO itsLevelNumber + 1 DO (itsSTP^[level] := NIL; "{To be referenced from FillArraysFrom to calculate numAtThatLevel} $TPWords(itsSTP)^[-2] := itsEvenMethods; $TPWords(itsSTP)^[-1] := itsOddMethods; "{Initialize the fields of the class record} $WITH pClasses^[numClasses] DO (BEGIN (classAlpha := itsAlpha; (superIndex := superClIndex; (objectSize := itsObjSize; {may be changed by a call on ClassSize from the class-init block} (classAlias := 0; {may be supplied by a call on ClassAuthor from the class-init block} (companyAndAuthor := 0; {may be supplied by a call on ClassAuthor or UnitAuthor} (version := 1; {may be changed by a call on ClassVersion from the class-init block} (oldestReadableVersion := 1; {may be changed by a call on ClassVersion from the class-init block} (END; "{Record the slice table pointer} $pSTables^[numClasses] := itsSTP; "{Before running the user's class-init code, be sure there is space for him to add an Alias and two Authors} $IF numAuthors > (limAuthors - 2) THEN (limAuthors := RAllocate(SIZEOF(TA32), numAuthors, @growAuthors, limAuthors, maxAuthors, 'Authors', ORD(pAuthors)); $IF numAliases > (limAliases - 1) THEN (limAliases := RAllocate(SIZEOF(TA8), numAliases, @growAliases, limAliases, maxAliases, 'Aliases', ORD(pAliases)); ${$IFC fTrcClascal} $WriteLn(' End of %_Class!, stp = ', ORD(itsSTP):5); ${$ENDC} "{[Interpret and] skip the MOVE/JSR pairs after the call of this procedure} $SetCallPC(FillArraysFrom(CallPC, itsLevelNumber, superSTP, itsSTP, itsOddMethods)); END; END. 3. "6F^9 SD!$ǐ^  6 6PL clipboard.hasUniversalText) THEN }; nd}; aw} !}!}}%!HnHz~Hn?. 8. %bcLbLjLj'̓. L ^V0SELF.DoCutCopy(clipboard.window.selectPanel.selection, SELF.isCut, cmdPhase); 0clipboard.EndCut; 0END; ,undoPhase: 0BEGIN 0IF SELF.isCut THEN 4BEGIN 4IF NOT clipboard.hasView THEN 8ABCbreak('undoing Cut but clipboard has no vi{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} 4CASE INTEGER OF {$IFC libraryVersion <= 20} { P E P S I } 81: (prPrf: TPrPrf; prIns: TPrIns); {$ELSEC} 81: (prPrf: TPrRec); {$ENDC} { S P R I N G} 82: (reserve: TPrReserve); 4END; %TMapTable = RECORD {Alias for menuBar.mapping TArray} 4header: TArrayHeader; 4table: ARRAY [1..8000] OF TWmgrCmd; 1END; %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; 7PROCEDURE 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:  20} ,1294, erWrongPassword:  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; PnumBytes, 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 4NOT (fs.atEnd AND (whichWay = xRead)) DO 0BEGIN 0IF numbytes > chunksize THEN 4xferAmount := chunksize 0ELSE 4xferAmount := numbytes; 0IF process.AbortRequest THEN 4fs.error := erAborted 0ELSE 4BEGIN 4fs.XferSequential(whichWay, pFirst, xferAmount); 4xferAmount := fs.actual; 4{$IFC fDbgABC} 4IF (xferAmount <= 0) AND (fs.error <= 0) THEN 8ABCbreak('In TProcess.AbortXferSequential, fs.actual <= 0', xferAmount); 4{$ENDC} 4actual := actual + xferAmount; 4numbytes := numBytes - xferAmount; 4pFirst := POINTER(ORD(pFirst) + xferAmount); 4END; 0END; ,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? ***} 0BackOutOfScrap; ,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 0document.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 0BEGIN 0WriteLn; 0WriteLn; 0Exit(DumpGlobals); 0END; ,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 0inactive, StopCondition will be called before the process is suspended (to give you 0a chance to regain control), but all the process' documents will be unbound. You can 0check 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 0BEGIN 0LetOthersRun; 0GOTO 9; 0END; (END; (PROCEDURE GetAndObeyEvent; ,LABEL 1; (BEGIN ,{$IFC fTrace}BP(1);{$ENDC} ,GetEvent(event); ,{$IFC fDbgABC} ,IF fExperimenting and eventDebug THEN 0WITH event.who^.portRect DO 4BEGIN 4WriteLn('GetAndObeyEvent (event.who):', ORD(event.who)); 4WriteLn(left, top, right, bottom); 4WriteLn(event.where.h, event.where.v); 4END; ,{$ENDC} ,IF ImActive THEN 0IF SELF.AbortRequest THEN 4IF event.what IN [keyDown, buttonDown, buttonUp] THEN 8GOTO 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 L(2) process is running in the background and has a document } (REPEAT ,WHILE NOT (ImActive OR amDying OR (currentWindow <> NIL)) DO 0BEGIN 0IF NOT EventAvail THEN 4StopTest; 0GetAndObeyEvent; {may suspend me} 0END; ,WHILE (ImActive OR (currentWindow <> NIL)) AND NOT amDying DO 0IF EventAvail THEN 4GetAndObeyEvent 0ELSE 4BEGIN 4StopTest; 4currentWindow.Update(TRUE); 4IF currentWindow.dialogBox <> NIL THEN 8currentWindow.dialogBox.Update(TRUE); 4IF NOT (amDying OR eventAvail) THEN 8BEGIN 8selection := currentWindow.selectWindow.selectPanel.selection; 8idleTime := Time; 8selection.IdleBegin(idleTime); 8WHILE NOT (amDying OR eventAvail) DO  erAborted THEN 0BEGIN 0WriteLn('--------------------'); 0ReportFilerEvent(flrParams); 0ABCbreak('TProcess.ObeyFilerEvent got an error (event listed above)', abortReason); 0END; ,{$ENDC} ,IF (flrOp = fcResume) OR (flrOp = fcNone) THEN 0BEGIN 0IF window <> NIL THEN 4PopFocus; 0IF wasSuspended THEN 2{ Close but don't kill the datasegs } 4BEGIN 4FOR i := 1 TO maxSegments DO 8IF document.dataSegment.refnum[i] >= 0 THEN  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: 0BEGIN .{ The assumption for aborting here is things will, where possible, be cleaned up along the way 0by anyone detecting the abort. Things that have already happened after the abort is 0detected will be cleaned up in CheckAbort. The process will of course continue after the 0abort. } 0IF (inBackground) AND (doclist.size > 0) THEN 4TellFiler(error, docClosd, noMoreDocs, event.who) {No multiple doc's in background} 0ELSE 4BEGIN 8{ Set badReply in case Abort is detected } 4badReply := docClosd; 4TakeWindow(event.who); 4WITH flrParams DO 8BEGIN 8openAsTool := flrOp = fcNone; 8IF openAsTool THEN  20} 8document.files.password := thePassword; 8{$ENDC} 8END; 4IF document = NIL THEN {application refused the request} 8TellFiler(error, docClosd, noMoreDocs, event.who) 4ELSE 8BEGIN 8document.openedAsTool := openAsTool; 8SetPort(event.who); {so things like InvalRect in BlankStationery will work} :{ Returns Abort as error = erAborted } 8document.Open(error, ORD(event.who), wasSuspended); 8window := NIL; {so CheckAbort will not PopFocus} 8CheckAbort(error); 8PushFocus; 8window := document.window; 8window.Focus; 8window.Resize(FALSE); 8CheckAbort(0); 8InvalRect(window.innerRect); 8window.Update(TRUE); 8CheckAbort(0); 8PopFocus; 8IF event.who = activeFolder THEN {already active so we don't get a folderActivate}  0) THEN 4BEGIN 4fileOpKind := fopCopyDoc; 4document := NIL; 4END 0ELSE 4BEGIN 4fileOpKind := fopNone; 4document := POINTER(GetFldrRefCon(event.who)); 4document.Bind; 4END; {$ENDC} 0CASE flrOp OF 4fcClose, fcSuspend, fcShred: 8BEGIN 8IF flrOp = fcClose THEN  0 THEN @fileOpKind := fopSaveVersion;  fopCopyDoc THEN  NIL THEN 4document.ConserveMemory(0, TRUE {GC}); 0CheckAbort(0); 0CASE fileOpKind OF 4fopSuspend: 8IF document.files.shouldSuspend THEN  20} 4fopCopyDoc: 8SELF.CopyExternalDoc(error, flrParams.theResult, volumePrefix); {$ENDC} 4END; 2{ You cannot abort after SaveVersion or Suspend unless the abort was detected within 4SaveVersion or Suspend and indicated by their returned error being erAborted } 0IF error > 0 THEN 4IF flrOp = fcShred THEN 8BEGIN {try to close all files} 8document.CloseFiles; 8document.KillSegments(1, maxSegments); 8error := 0; {always give a good reply to the filer} 8END 4ELSE 8CheckAbort(error); 0TellFiler(error, reply, FilerReason(error), event.who); 0IF flrOp <> fcCopy THEN 4BEGIN 4closedDocument := document; 4closedBySuspend := doSuspend; 4END; 0allowAbort := TRUE; 0END; ,fcDfClose: 0BEGIN 0badReply := dfNotClosed; 0Close_Object(error, flrParams.theDf); 0CheckAbort(error); 0TellFiler(error, dfClosed, allOk, event.who); 0END; ,fcTerminate: 0amDying := TRUE; ,END; $1: {$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $PROCEDURE {TProcess.}ObeyTheEvent; 0{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 0BEGIN 0dialogBox := currentWindow.dialogBox; 0IF dialogBox <> NIL THEN 4IF dialogBox.keyResponse = diDismissDialogBox THEN 8dialogBox.BeDismissed 4ELSE *{+SW+} IF (dialogBox.keyResponse = diAccept) AND (currentWindow.selectWindow = dialogBox) THEN 8EvtWindow := dialogBox 0END; ,{$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 0SELF.ObeyFilerEvent ,ELSE ,IF who <> alertFolder THEN 0BEGIN 0IF what = folderActivate THEN 4TakeControl(event, FALSE, FALSE); 0eventDocument := currentDocument; 0IF who = menuFolder THEN {much changed} 4BEGIN 4eventWindow := currentWindow; 4dialogBox := currentWindow.dialogBox; 4IF dialogBox <> NIL THEN 8IF dialogBox.menuResponse = diDismissDialogBox THEN  NIL THEN 4BEGIN 4PushFocus; 4IF who = menuFolder THEN 8eventWindow.Focus 4ELSE 8BEGIN 8SetPort(event.who); 8{$IFC fDbgABC} 8IF fExperimenting and eventDebug THEN  keyDown) OR appleKey THEN  EvtWindow(pkEvent)) OR R(pkEvent.what <> keyDown) OR R((pkEvent.what = keyDown) AND (pkEvent.AppleKey)) {LSR} DELSE Hpaused := TRUE; DIF NOT paused THEN HBEGIN HGetEvent(event); HeventTime := event.when; HeventType := event.what; H{$IFC fDbgABC} HIF eventDebug THEN LReportEvent; H{$ENDC} HEND DELSE DIF eventWindow.selectPanel <> NIL THEN HeventWindow.selectPanel.selection.KeyPause; BUNTIL paused; 8END; 4IF (closedDocument = NIL) AND (currentWindow <> NIL) THEN 8BEGIN {+SW+} 8IF NOT deferUpdate THEN  NIL THEN @currentWindow.dialogBox.Update(TRUE);  NIL THEN {+SW+}  NIL THEN ,BEGIN ,closedDocument.Close(closedBySuspend); ,closedDocument.Free; ,closedDocument := NIL; ,END; (process.BindCurrentDocument; {This also unbinds the eventDocument, in the case where Hwe 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 0BEGIN 0docHeap := boundDocument.docHeap; 0IF docHeap <> NIL THEN 4BEGIN 4numObjects := CountHeap(docHeap); 4Write('; boundDocument heap has ', numObjects:1, ' objects'); 4MarkHeap(docHeap, ORD(boundDocument.dataSegment.preludePtr^.docDirectory)); 4SweepHeap(docHeap, TRUE); 4END; 0END; ,IF boundClipboard <> NIL THEN 0BEGIN 0docHeap := boundClipboard.docHeap; 0IF docHeap <> NIL THEN 4BEGIN 4numObjects := CountHeap(docHeap); 4Write('; boundClipboard heap has ', numObjects:1, ' objects'); 4END; 0END; ,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 0BEGIN 0{$IFC fTrace} 0(** SuErrText('OSERRS.ERR', error, @erStr); **) 0Writeln; 0Writeln('Error # ', error, '; ', erStr); 0{$ENDC} 0Phrase := phUnknown; 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TProcess.}HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGINT; Lwhen: 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 0BEGIN 0who := NIL; {can't tell what window we are sending to} 0what := typeOfEvent; 0when := Time; 0toProcess := targetProcess; 0fromProcess := myProcessID; 0userData := otherData; 0END; ,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 0IF currentWindow.dialogBox.downInMainWindowResponse = diRefuse THEN {was cantDown} 4cursorNumber := 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 0refnum[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];', 5'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***} 0error := erPassword; ,END; (**) IF error <= 0 THEN ,IF NeedConversion(exClasses, olderVersion, newerVersion) THEN 0BEGIN 0IF newerVersion THEN 4doConvert := process.Caution(phNewerVersion) 0ELSE 0IF olderVersion THEN 4doConvert := process.Caution(phOlderVersion) 0ELSE 4doConvert := TRUE; 0IF doConvert THEN 4BEGIN 4process.BeginWait(phConverting); 4allowAbort := FALSE; {cannot abort the conversion} 4ConvertHeap(SELF.docHeap, exClasses); 4exDocDirectory.Adopt; (*^*) 4SELF.ConserveMemory(docExcess, TRUE {GC}); 4allowAbort := TRUE; 4process.EndWait; 4END 0ELSE 4error := erVersion; 0END; (**) ({$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 0boundDocument.Unbind; ,i := 1; {We must bind segment #1 before we can find out numSegments} ,REPEAT 0Sched_Class(sched_err, FALSE); 0Bind_DataSeg(error, SELF.dataSegment.refnum[i]); 0Sched_Class(sched_err, TRUE); 0IF error > 0 THEN 4ABCBreak('Bind_DataSeg', error); 0i := 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 0BEGIN 0MarkHeap(heap, ORD(SELF.dataSegment.preludePtr^.docDirectory)); 0{$IFC fDbgABC} 0SweepHeap(heap, TRUE); {Report garbage} 0{$ELSEC} 0SweepHeap(heap, FALSE); {Free garbage} 0{$ENDC} 0END; ,hz := POINTER(ORD(heap)); ,REPEAT 0bytesReduced := CbShrinkHz(hz, maxSegSize) ,UNTIL bytesReduced < maxSegSize; ,SELF.SetSegSize(error, CbOfHz(hz) + SELF.dataSegment.preludePtr^.preludeSize, maxExcess); ,IF error > 0 THEN 0process.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 0BEGIN 0WriteLn; 0WriteLn; 0Exit(DumpPrelude); 0END; ,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 0BEGIN 0dsPathName := CONCAT(SELF.files.volumePrefix, suspendSuffix[i]); 0{$IFC LibraryVersion > 20} 0Change_Password(error, dsPathname, dsPassword, blankPasswd); 0{$ENDC} 0Kill_DataSeg(error, dsPathname); 0Close_DataSeg(error, SELF.dataSegment.refnum[i]); 0SELF.dataSegment.refnum[i] := -1; 0END; ({$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; 0PTempType = ^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; 0we 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 0BEGIN 0Sched_Class(sched_err, FALSE); 0Size_DataSeg(error, dsRefnum, maxSegSize - dsInfo.mem_size, newSize, NmaxSegSize - dsInfo.disc_size, newSize); 0Sched_Class(sched_err, TRUE); 0END ,ELSE 0ABCbreak('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 0WriteLn('In TDocManager.MakeSegments: error from Open_Dataseg=', error:1); ,{$ENDC} ,IF error > 0 THEN 0BEGIN 0Sched_Class(sched_err, FALSE); 0Make_Dataseg(error, dsPathname, thisSegSize, thisSegSize, dsRefnum, memOrd, ldsn, ds_shared); 0Sched_Class(sched_err, TRUE); 0END ,ELSE 0BEGIN 0SetAccess_DataSeg(error, dsRefnum, FALSE); {Make writeable} 0IF error <= 0 THEN 4BEGIN 4Info_DataSeg(error, dsRefnum, dsInfo); 4IF error <= 0 THEN 8BEGIN 8Sched_Class(sched_err, FALSE); 8Size_DataSeg(error, dsRefnum, thisSegSize - dsInfo.mem_size, newSize, VthisSegSize - dsInfo.disc_size, newSize); 8Sched_Class(sched_err, TRUE); 8END; 4END; 0END; ,IF error > 0 THEN 0ABCBreak('In TDocManager.MakeSegments: Make_Dataseg', error) ,ELSE 0BEGIN 0{$IFC LibraryVersion > 20} 0Change_Password(error, dsPathname, blankPasswd, dsPassword); 0IF error > 0 THEN 4ABCBreak('In TDocManager.MakeSegments: Change_Password', error); 0{$ENDC} 0SELF.dataSegment.refnum[newSegments] := dsRefnum; 0IF ldsn = docLdsn THEN 4p := POINTER(memOrd); 0END; ,currDocSize := currDocSize + thisSegSize; ,IF process.AbortRequest THEN 0error := erAborted; ,END; (IF error <= 0 THEN ,WITH SELF.dataSegment DO 0BEGIN 0IF oldSegments = 0 THEN 4BEGIN 4boundDocument := SELF; 4FOR i := 1 TO SIZEOF(TPrelude) DO 8p^[i] := 0; 4preludePtr := POINTER(ORD(p)); 4END; 0preludePtr^.docSize := currDocSize; 0preludePtr^.numSegments := newSegments; 0END; ({$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 0BEGIN 0aFile.Become(TFile.CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), '')); 0IF aFile.Exists(error) THEN 4aFile.Rename(error, volumePrefix); 0END; ,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 0IF SELF.files.saveExists THEN {won't even try this if we don't create save files} 4SELF.OpenSaved(error, wmgrID) 0ELSE 4SELF.OpenBlank(error, wmgrID) ,ELSE 0openedSuspended := 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), JNIL, LIntDivInt(heapSize, 10), 0, @ExpandHeap, JPOINTER(procNil), POINTER(procNil), POINTER(procNil)))); @{*** DANGER ***} 1{@ExpandHeap is a pointer outside the data segment} 1{TDocManager.Assimilate must guarantee its accuracy} ,CheckAbort; ,PrPrfDefault(prPrfAlias.prPrf); ,WITH SELF.dataSegment.preludePtr^ DO 0BEGIN 0password := 25376; {*** temporary ***} 0version := 1; {*** should be this software's version ***} 0country := countryCode; 0language := countryCode; {*** same as country code? ***} 0preludeSize := SIZEOF(TPrelude); 0printPref := prPrfAlias.reserve; 0END; ,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 0BEGIN 0preludePtr := SELF.dataSegment.preludePtr; 0process.AbortXferSequential(xRead, POINTER(ORD(preludePtr)), fileSize, abortChunkSize, fs); 0error := fs.error; 0IF error <= 0 THEN 4SELF.ResumeAfterOpen(error, wmgrID); 0preludePtr^.docDirectory.window.changes := 0; 0END; ,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 ***} 0error := 313 {*** What it should return for Revert ***} ,ELSE {*** Remove these lines when fixed ***} 0BEGIN 0{$IFC LibraryVersion > 20} 0Change_Password(error, dsPathname, dsPassword, blankPasswd); 0{$ENDC} 0Open_DataSeg(error, dsPathname, dsRefnum, memOrd, ldsn); 0END; ,IF error <= 0 THEN 0BEGIN 0SELF.dataSegment.refnum[i] := dsRefnum; 0IF ldsn = docLdsn THEN 4preludePtr := POINTER(memOrd); 0SetAccess_DataSeg(error, dsRefnum, FALSE); {Make writeable} 0IF error > 0 THEN 4ABCBreak('In TDocManager.OpenSuspended: SetAccess_DataSeg', error); 0{$IFC LibraryVersion > 20} 0Change_Password(error, dsPathname, blankPasswd, dsPassword); 0IF error > 0 THEN 4ABCBreak('In TDocManager.OpenSuspended: Change_Password', error); 0{$ENDC} 0i := i + 1; 0END; ,IF process.AbortRequest THEN 0error := erAborted; ,IF error > 0 THEN 0cease := TRUE ,ELSE 0cease := 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} 0BEGIN 0i := i - 1; 0Unbind_Dataseg(otherError, SELF.dataSegment.refnum[i]); 0{$IFC fDbgABC} 0IF otherError > 0 THEN 4WriteLn(CHR(7), 'Error unbinding dataseg=', otherError:1); 0{$ENDC} 0SELF.dataSegment.refnum[i] := -1; 0END; ({$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 0error := erAborted ,ELSE 0BEGIN 0{$IFC LibraryVersion <= 20} 0tmpFile := TFile.CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), ''); 0{$ELSEC} 0tmpFile := TFile.CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), SELF.files.password); 0{$ENDC} 0fs := tmpFile.ScannerFrom(0, [fWrite]); 0error := fs.error; 0IF error <= 0 THEN 4IF process.AbortRequest THEN 8error := erAborted; 0IF error > 0 THEN 4BEGIN 4tmpFile.Delete(localError); 4fs.Free; 4END 0ELSE 4BEGIN 4process.AbortXferSequential(xWrite, POINTER(ORD(SELF.dataSegment.preludePtr)), LSELF.dataSegment.preludePtr^.docSize, abortChunkSize, fs); 4fs.Compact; 4{*** we should set the logical file size to the logical EOF ***} 4error := fs.error; 4{*** Be sure buffers are flushed ***} 4IF error <= 0 THEN 8IF process.AbortRequest THEN  0 THEN 8BEGIN 8{$IFC fDbgABC} 8ABCbreak('In TDocManager.SaveVersion, error saving file=', error); 8{$ENDC} 8{this is after we wrote out the file, need a wait alert if user aborted} 8IF error = erAborted THEN  0 THEN  0 THEN  minSize + maxExcess) THEN 0{need to adjust the segment size} 0BEGIN 0newSize := minSize + maxExcess; 0newSegments := LIntDivLInt(newSize + maxSegSize - 1, maxSegSize); 0{$IFC fDbgABC} 0IF (numSegments < 1) OR (numSegments > maxSegments) THEN 4ABCBreak('SetSegSize: numSegments NOT IN 1..maxSegments', numSegments); 0IF (newSegments < 1) OR (newSegments > maxSegments) THEN 4ABCBreak('SetSegSize: newSegments NOT IN 1..maxSegments', newSegments); 0{$ENDC} 0IF numSegments > newSegments THEN 4{kill off whole segments we don't need anymore} 4SELF.KillSegments(newSegments + 1, numSegments) 0ELSE 0IF numSegments < newSegments THEN 4SELF.MakeSegments(error, numSegments, newSize); 8{this sets all the segment sizes correctly} 0{resize the new last segment} 0newSegSize := newSize - (maxSegSize*(newSegments-1)); >{total doc size - size of all segments before last one} 0Info_DataSeg(error, SELF.dataSegment.refNum[newSegments], dsInfo); 0IF error > 0 THEN 4ABCBreak('SetSegSize: Info_Dataseg', error); 0WITH dsInfo DO 4BEGIN 4Sched_Class(sched_err, FALSE); 4Size_Dataseg(error, SELF.dataSegment.refnum[newSegments], AnewSegSize-mem_size, temp, newSegSize-disc_size, temp); 4Sched_Class(sched_err, TRUE); 4END; 0{$IFC fDbgABC} 0IF fExperimenting THEN 4BEGIN 4WriteLn('In SetSegSize: newSize=', newSize:1, ' newSegments=', newSegments:1); 4WITH dsInfo DO 8WriteLn('newSegSize=',newSegSize:1, ' mem_size=', mem_size:1, @' disc_size=', disc_size:1); 4END; 0{$ENDC} 0IF error > 0 THEN 4BEGIN 4{$IFC fDbgABC} 4WriteLn('In SetSegSize: newSize=', newSize:1, ' newSegments=', newSegments:1); 4WITH dsInfo DO 8WriteLn('newSegSize=',newSegSize:1, ' mem_size=', mem_size:1, @' disc_size=', disc_size:1); 4{$ENDC} 4ABCBreak('In TDocManager.SetSegSize: Size_Dataseg', error); 4END 0ELSE 4BEGIN 4docSize := newSize; 4numSegments := newSegments; 4END; 0END; ,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 0BEGIN 0volumePrefix := SELF.files.volumePrefix; 0FOR reopenedSeg := 1 TO lastSegClosed DO 4BEGIN 4ldsn := reopenedSeg + docLdsn-1; 4dsPathname := CONCAT(volumePrefix, suspendSuffix[reopenedSeg]); 4Open_DataSeg(osErr, dsPathname, dsRefnum, memOrd, ldsn); 4LatestError(osErr, error); 4IF osErr <= 0 THEN 8BEGIN 8SELF.dataSegment.refnum[reopenedSeg] := dsRefnum; 8SetAccess_DataSeg(osErr, dsRefnum, FALSE); {Make writeable} 8IF osErr > 0 THEN  0 THEN 4ABCBreak('Unbind_DataSeg', error); 0END; ,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; 0fs: TFileScanner; 0dsInfo: 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 0ABCbreak('CopyScrap: error from Info_Dataseg', error); ,{$ENDC} ,WITH dsInfo DO 0fs.XferSequential(xWrite, Ptr(AddrOfScrapDSeg), mem_size); (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF boundClipboard <> SELF THEN ,BEGIN ,IF boundClipboard <> NIL THEN 0boundClipboard.Unbind; ,boundClipboard := SELF; ,{Open the clipboard data segment} ,StartGetScrap(error); ,IF error > 0 THEN 0BEGIN 0ABCBreak('StartGetScrap', error); 0BackOutOfScrap; 0{need to put up alert that scrap cannot be bound and pass this info back up the ladder} 0END ,ELSE 0BEGIN 0{Obtain write access} 0SetAccess_DataSeg(error, DSegOfScrap, FALSE); 0IF error > 0 THEN 4ABCBreak('SetAccess_DataSeg', error); 0{Find out what is there to be pasted} 0GetScrap(which, what); 0SELF.window := NIL; {$IFC LibraryVersion > 20} 0IF scrapProcess = myProcessID THEN 4IF which = scrapRef THEN 8BEGIN 8which := toolKitType; 8what := Pointer(Ord(GetFldrRefCon(scrapFolder))); 8END; {$ENDC} 0IF which = toolKitType THEN 4BEGIN 4docDirectory := POINTER(ORD(what)); (**) (*^*) IF scrapProcess <> myProcessID THEN {Don't waste time checking if I put it there myself} 8IF NeedConversion(docDirectory.classWorld, olderVersion, newerVersion) THEN  0 THEN 0ABCBreak('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} 0BEGIN {LSR} 0panel := TPanel(window.panels.First); 0pane := TPane(panel.panes.First); 0viewExtentLRect := window.selectPanel.view.extentLRect; 0{Let the Window Manager have a picture to display while inactive [if open]} 0GetWindInfo(POINTER(window.wmgrID), info); 0IF info.visible THEN 4window.StashPicture(hNone); 0{Let others have a picture to paste} 0noPad.RectToLRect(hugeRect, picLRect); 0IF SectLRect(viewExtentLRect, picLRect, picLRect) AND NOT EmptyLRect(picLRect) THEN 4BEGIN 4GetHeap(tempHeap); 4SetHeap(POINTER(ORD(HzOfScrap))); 4{Before calling Focus, set up everything for unclipped drawing of the view} 4tempPad := TPad.CREATE(NIL, mainHeap, hugeRect, picLRect, screenRes, HscreenRes, thePort); 4tempPad.LRectToRect(picLRect, picRect); 4RectRgn(altVisRgn, picRect); 4useAltVisRgn := TRUE; { enable clipping to whole picture } 4{Focus on the Clipboard} 4PushFocus; 4tempPad.Focus; 4focusArea := NIL; {To trap illegal attempts to Push/PopFocus during UTView.Draw} 4{Generate the Universal Picture} 4pic := OpenPicture(picRect); 4genClipPic := TRUE; { enable putting comments into picture } 4PicComment(cPicGeDwg, 0, NIL); { needed for pasting into LisaDraw } 4PicGrpBegin; { every LisaDraw picture from other apps is a group } 4panel.view.Draw; { tell the application to draw now } 4PicGrpEnd; 4ClosePicture; 4{Put it in the Clipboard} 4PutGrScrap(pic, error); 4IF error > 0 THEN 8ABCBreak('PutGrScrap', error); 4{Generate the Universal Text} 4panel.view.CreateUniversalText; 4{Unravel} 4genClipPic := FALSE; { disable putting comments into picture } 4useAltVisRgn := FALSE; { disable clipping to whole window } 4PopFocus; 4tempPad.Free; 4SetHeap(tempHeap); 4END; 0END; {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 0BEGIN 0fs.XferRandom(xRead, Ptr(AddrOfScrapDSeg), fs.actual, fAbsolute, 0); 0fs.Free; 0SELF.clipCopy := NIL; 0END; (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF = boundClipboard THEN ,BEGIN ,RestoreScrap; ,{$IFC fDbgABC} ,IF SELF = currentDocument THEN 0ABCBreak('TClipboard.Unbind currentDocument', ORD(SELF)); ,{$ENDC} ,boundClipboard := NIL; ,{Relinquish access} ,SELF.window := NIL; ,EndGetScrap(error); ,IF error > 0 THEN 0ABCBreak('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 0BEGIN 0unHiliteBefore[cmdPhase] := TRUE; 0hiliteAfter[cmdPhase] := TRUE; 0END; ,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; HitsImage: 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; KcmdPhase: 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: 0BEGIN 0clipboard.AboutToCut; 0clipboard.BeginCut; 0SELF.DoCutCopy(clipboard.window.selectPanel.selection, SELF.isCut, cmdPhase); 0clipboard.EndCut; 0END; ,undoPhase: 0BEGIN 0IF SELF.isCut THEN 4BEGIN 4IF NOT clipboard.hasView THEN 8ABCbreak('undoing Cut but clipboard has no view', 0) 4ELSE 8BEGIN 8clipboard.Bind; 8IF clipboard.window = NIL THEN  TXLRect(hugeLRect) THEN 0BEGIN 0IF NOT asMuchAsPossible THEN 4BEGIN 4hMin := 30; 4vMin := 20; 4END 0ELSE 4WITH lr DO 8BEGIN 8hMin := Min(MAXINT, right - left + 6); 8vMin := Min(MAXINT, bottom - top + 4); {INCLUDE FILE UABC3 -- IMPLEMENTATION OF UABC} {Copyright 1983, 1984, Apple Computer, Inc.} ({TImage-TView-TPaginatedView-TPageView-TPrintManager-THeading-TSelection} METHODS OF TImage; ${$S SgABCini} $FUNCTION {TImage.}CREATE{(object: TObject; heap: THeap; itsExtent: LRect; itsView: TView): TImage}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TImage(object); (WITH SELF DO ,BEGIN ,extentLRect := itsExtent; ,view := itsView; ,allowMouseOutside := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TImage.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (Field('extentLRect: LRect'); (Field('view: TView'); (Field('allowMouseOutside: BOOLEAN'); (Field(''); $END; ${$S SgABCres} ${$ENDC} ${$S Override} $FUNCTION {TImage.}CursorAt{(mouseLPt: LPoint): TCursor}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (CursorAt := NoCursor; ({$IFC fTrace}EP;{$ENDC} $END; ${$S Override} $PROCEDURE {TImage.}Draw; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S Override} $PROCEDURE {TImage.}EachActualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (SELF.view.panel.window.EachActualPart(DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sFilter} $PROCEDURE {TImage.}EachVirtualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (SELF.view.panel.window.FilterDispatch(NIL, SELF, DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sFilter} $PROCEDURE {TImage.}FilterAndDo{(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.view.panel.window.FilterDispatch(actualObj, SELF, DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCldInit} $PROCEDURE {TImage.}HaveView{(view: TView)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.view := view; {fancier subclasses do fancier things here} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TImage.}Hit{(mouseLPt: LPoint): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (Hit := LRectHasLPt(SELF.extentLRect, mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}Invalidate; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (IF thePad <> NIL THEN ,thePad.InvalLRect(SELF.extentLRect); ({$IFC fTrace}EP;{$ENDC} $END; {$S Override} $FUNCTION {TImage.}LaunchLayoutBox{(view: TView): TImage}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (LaunchLayoutBox := NIL; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}OffSetBy{(deltaLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} "{$H-} OffsetLRect(SELF.extentLRect, deltaLPt.h, deltaLPt.v); {$H+} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}OffSetTo{(newTopLeft: LPoint)}; (VAR deltaLPt: LPoint; ,curTopLeft: LPoint; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (curTopLeft := SELF.extentLRect.topLeft; (SetLPt(deltaLPt, newTopLeft.h - curTopLeft.h, newTopLeft.v - curTopLeft.v); (SELF.OffsetBy(deltaLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}MouseMove{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.view.panel <> NIL THEN ,SELF.view.panel.selection.MouseMove(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}MousePress{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.view.panel <> NIL THEN ,SELF.view.panel.selection.MousePress(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}MouseRelease; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.view.panel <> NIL THEN ,SELF.view.panel.selection.MouseRelease; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}MouseTrack{(mPhase: TMousePhase; mouseLPt: LPoint)}; (VAR panel: TPanel; ,window: TWindow; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (panel := SELF.view.panel; (IF panel <> NIL THEN ,BEGIN ,IF NOT (panel.selection.canCrossPanels OR SELF.allowMouseOutside) THEN 0LRectHaveLPt(SELF.extentLRect, mouseLPt); ,window := panel.window; ,window.clickPanel := panel; ,END; (SELF.view.clickLPt := mouseLPt; {e.g., for Set Page Breaks use} (CASE mPhase OF ,mPress: SELF.MousePress(mouseLPt); ,mMove: SELF.MouseMove(mouseLPt); ,mRelease: BEGIN 8SELF.MouseMove(mouseLPt); 8window.Update(TRUE); 8SELF.MouseRelease; 8END; ,END; (window.Update(TRUE); ({$IFC fTrace}EP;{$ENDC} $END; ${$S Override} $PROCEDURE {TImage.}ReactToPrinterChange; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S Override} $PROCEDURE {TImage.}RecalcExtent; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TImage.}Resize{(newExtent: LRect)}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (SELF.extentLRect := newExtent; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TImage.}SeesSameAs{(image: TImage): BOOLEAN; DEFAULT}; {$} $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (SeesSameAs := image = SELF; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCini} END; METHODS OF TView; ${$S SgABCini} $FUNCTION {TView.}CREATE{(object: TObject; heap: THeap; itsPanel: TPanel; itsExtent: LRect; 0itsPrintManager: TPrintManager; itsDfltMargins: LRect; itsFitPagesPerfectly:BOOLEAN; 0itsRes: Point; isMainView: BOOLEAN): TView}; ,VAR screenPad: TPad; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TView(TImage.CREATE(object, heap, itsExtent, NIL)); (WITH SELF DO ,BEGIN ,view := SELF; ,panel := itsPanel; ,printManager := itsPrintManager; ,res := itsRes; ,clickLPt := itsExtent.topLeft; ,fitPagesPerfectly := itsFitPagesPerfectly; ,{$H-} ,SetPt(scrollPastEnd, 60, 40); ,{$H+} ,END; (SELF.isMainView := isMainView; (SELF.isPrintable := (itsPrintManager <> NIL) AND isMainView; (screenPad := TPad.CREATE(NIL, heap, zeroRect, zeroLRect, screenRes, SELF.res, NIL); (SELF.screenPad := screenPad; #{$H-}SetLPt(SELF.stdScroll, (16 * SELF.res.h) DIV screenRes.h, (11 * SELF.res.v) DIV screenRes.v); {$H+} (IF isMainView THEN ,BEGIN ,itsPanel.HaveView(SELF); ,IF itsPrintmanager <> NIL THEN 0itsPrintManager.Init(SELF, itsDfltMargins); ,SELF.ReactToPrinterChange; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCini} $PROCEDURE {TView.}Free; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.isMainView THEN ,Free(SELF.printManager); (Free(SELF.screenPad); (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TImage.Fields(Field); (Field('panel: TPanel'); (Field('clickLPt: LPoint'); (Field('printManager: TPrintManager'); (Field('res: Point'); (Field('screenPad: TPad'); (Field('fitPagesPerfectly: BOOLEAN'); (Field('isPrintable: BOOLEAN'); (Field('isMainView: BOOLEAN'); (Field('stdScroll: LPoint'); (Field('scrollPastEnd: Point'); (Field(''); $END; ${$S SgABCres} ${$ENDC} ${$S SgABCpri} $PROCEDURE {TView.}AddStripOfPages{(vhs: VHSelect)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.printManager <> NIL THEN ,SELF.printManager.AddStripOfPages(vhs); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} #{$S sCldInit} $PROCEDURE {TView.}BeInPanel{(panel: TPanel)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.panel := panel; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $PROCEDURE {TView.}CreateUniversalText; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sRes} $FUNCTION {TView.}CursorAt{(mouseLPt: LPoint): TCursorNumber}; $BEGIN ({$IFC fTrace}BP(2);{$ENDC} (CursorAt := arrowCursor; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgDRWres} $FUNCTION {TView.}DoReceive{(selection: TSelection; lPtInView: LPoint): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (DoReceive := FALSE; {Default is to refuse cross-panel drag} ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} ${$S sStartup} $FUNCTION {TView.}ForceBreakAt{(vhs: VHSelect; precedingLocation: LONGINT; =proposedLocation: LONGINT): LONGINT}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (ForceBreakAt := proposedLocation; {default is to accept the proposal; client can override} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sScroll} $PROCEDURE {TView.}GetStdScroll{(VAR deltaLStd: LPoint)}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (IF NOT SELF.panel.zoomed THEN ,deltaLStd := SELF.stdScroll (ELSE ,WITH SELF.panel.zoomFactor DO *{$H-} BEGIN 0deltaLStd.h := LIntOvrInt(LIntMulInt(ORD4(SELF.stdScroll.h), denominator.h), numerator.h); 0deltaLStd.v := LIntOvrInt(LIntMulInt(ORD4(SELF.stdScroll.v), denominator.v), numerator.v); &{$H+} END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCpri} $FUNCTION {TView.}MaxPageToPrint{: LONGINT}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (MaxPageToPrint := SELF.printManager.breaks[v].size * SELF.printManager.breaks[h].size; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sStartup} $FUNCTION {TView.}NoSelection{: TSelection}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (NoSelection := TSelection.CREATE(NIL, SELF.Heap, SELF, nothingKind, zeroLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TView.}OKToDrawIn{(lRectInView: LRect): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (OKToDrawIn := FALSE; {The default is to assume the worst, unless the application overrides} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCldInit} $PROCEDURE {TView.}ReactToPrinterChange; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.printManager <> NIL THEN ,SELF.printManager.ReactToPrinterChange; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sStartup} $PROCEDURE {TView.}RedoBreaks; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (IF SELF.printManager <> NIL THEN ,SELF.printManager.RedoBreaks; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TView.}RemapManualBreaks{( ,FUNCTION NewBreakLocation(vhs: VHSelect; oldBreak: LONGINT): LONGINT)}; (VAR printManager: TPrintManager; ,oldLoc: LONGINT; ,newLoc: LONGINT; ,oldIndex: LONGINT; ,vhs: VHSelect; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (printManager := SELF.printManager; (IF printManager <> NIL THEN ,BEGIN ,printManager.ClearPageBreaks(TRUE); ,FOR vhs := v TO h DO 0FOR oldIndex := 1 TO printManager.breaks[vhs].size - 1 DO 0BEGIN 0oldLoc := TpLONGINT(printManager.breaks[vhs].At(oldIndex))^; 0newLoc := - NewBreakLocation(vhs, ABS(oldLoc)); 0printManager.breaks[vhs].PutAt(oldIndex, @newLoc); 0END; ,SELF.RedoBreaks; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCldInit} $PROCEDURE {TView.}Resize{(newExtent: LRect)}; (VAR s: TListScanner; ,pageBreak: LONGINT; ,vhs: VHSelect; ,oldLimit: LONGINT; ,newLimit: LONGINT; ,breakIndex: INTEGER; ,breakArray: TArray; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF NOT (SELF.isMainView) OR NOT(SELF.isPrintable) THEN ,SUPERSELF.Resize(newExtent) (ELSE ,IF NOT EqualLRect(SELF.extentLRect, newExtent) THEN 0BEGIN 0FOR vhs := v TO h DO 4BEGIN 4oldLimit := SELF.extentLRect.botRight.vh[orthogonal[vhs]]; 4newLimit := newExtent.botRight.vh[orthogonal[vhs]]; 4breakIndex := 1; 4breakArray := SELF.printManager.breaks[vhs]; 4WHILE breakIndex <= breakArray.size DO 8BEGIN 8pageBreak := TpLONGINT(breakArray.At(breakIndex))^; 8IF pageBreak = oldLimit THEN = newLimit THEN <{discard other now-too-big pagebreaks}  theMarginPad THEN {need to refocus onto the exterior...} ,theMarginPad.Focus; ({frame the overall page} (penNormal; (penMode(patOr); (penSize(3,2); (FrameLRect(printManager.paperLRect); ({draw a very light-gray pattern everywhere in the margins} (theMarginPad.LRectToRect(printManager.paperLRect, paperRect); (RectRgn(padRgn, paperRect); (theMarginPad.LRectToRect(printManager.contentLRect, contentRect); (RectRgn(scrRgn1ForDrawHdgs, contentRect); (DiffRgn(padRgn, scrRgn1ForDrawHdgs, scrRgn1ForDrawHdgs); (PenMode(patOr); (theMarginPad.LPatToPat(marginPattern, pat); (PenPat(pat); (PaintRgn(scrRgn1ForDrawHdgs); (IF NOT EqualRect(theBodyPad.nonNullBody, theBodyPad.innerRect) THEN ,BEGIN ,RectRgn(scrRgn1ForDrawHdgs, theBodyPad.innerRect); ,RectRgn(scrRgn2ForDrawHdgs, theBodyPad.nonNullBody); ,DiffRgn(scrRgn1ForDrawHdgs, scrRgn2ForDrawHdgs, scrRgn1ForDrawHdgs); ,{Both theBodyPad.innerRect & theBodyPad.nonNullBody are expressed in (0,0)-origined 0window coordinates; since we are focused on theMarginPad now, must offset the 0rgn by its origin.} ,WITH theMarginPad.origin DO 0{$H-} 0OffsetRgn(scrRgn1ForDrawHdgs, h, v); 0{$H+} ,thePad.SetPen(limboPen); ,PaintRgn(scrRgn1ForDrawHdgs); ,END; &{Frame the content rectangle--normally directly abuts the margin} (penNormal; (penMode(patOr); (FrameRect(contentRect); &{draw page numbers in corners} (IntToStr(theMarginPad.pageNumber, @pgNum); (SetQDTypeStyle(cornerNumberStyle); (numberLength := StringWidth(pgNum); (r := paperRect; (GetFontInfo(fInfo); (DistinguishScreenFeedback(pgNum, r.left + lrOffset, r.top + topOffset); (DistinguishScreenFeedback(pgNum, r.right - numberLength - lrOffset, r.top + topOffset); (DistinguishScreenFeedback(pgNum, r.right - numberLength - lrOffset, r.bottom - bottomOffset); (DistinguishScreenFeedback(pgNum, r.left + lrOffset, r.bottom - bottomOffset); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} #{$S SgABCpri} #FUNCTION {TPaginatedView.}CursorAt{(mouseLPt: LPoint): TCursorNumber}; L{later deal with cursor for margins} (VAR unPagLPt: LPoint; $BEGIN '{$IFC fTrace}BP(9);{$ENDC} 'SELF.DepagifyLPoint(mouseLPt, unPagLPt); 'CursorAt := SELF.unpaginatedView.CursorAt(unPagLPt); '{$IFC fTrace}EP;{$ENDC} $END; "PROCEDURE {TPaginatedView.}DepagifyLPoint{(pagLPt: LPoint; VAR unPagLPt: LPoint)}; #{Given a point in the paginated view, determine the nearest corresponding point in the unpaginated view} (VAR printManager: TPrintManager; ,meatLRect: LRect; {the portion of the page that displays a part of the main view} ,vhs: VHSelect; ,breakArray: TArray {OF LONGINT}; ,strip: INTEGER; {the ordinal number of the strip containing the page} ,breakLocation: LONGINT; {the coordinate of the start of the page} ,pageBreak: LONGINT; {the page break at the beginning of the page} ,nextBreak: LONGINT; {the page break at the end of the page} ,pageOrigin: LPoint; {the top left corner of the page, in the paginated view} ,strips: Point; {the strip numbers in each direction, stored as a Point} ,lOffsetPt: LPoint; {the top left corner of the meat rect of the page, in the main view} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (LRectHaveLPt(SELF.extentLRect, pagLPt); (printManager := SELF.unpaginatedView.printManager; (meatLRect := printManager.contentLRect; (FOR vhs := v TO h DO ,BEGIN ,breakArray := printManager.breaks[orthogonal[vhs]]; *{compute strip number} ,strip := Min(LIntDivLInt(pagLPt.vh[vhs], SELF.pageSize[vhs]) + 1, breakArray.size); *{compute breakLocation, being the location in the main view of the top-leftmost 4content point of the page in which our boy was found} ,IF strip = 1 THEN 0breakLocation := 0 ,ELSE 0BEGIN 0pageBreak := TpLONGINT(breakArray.At(strip - 1))^; 0breakLocation := ABS(pageBreak); 0END; *{recompute end of meatLRect (limbo boundary)} ,nextBreak := TpLONGINT(breakArray.At(strip))^; ,meatLRect.botRight.vh[vhs] := meatLRect.topLeft.vh[vhs] + ABS(nextBreak) - breakLocation; *{compute pageOrigin -- the location in the paginated view of the topleft corner of this page} ,pageOrigin.vh[vhs] := LIntMulInt(SELF.pageSize[vhs], strip - 1); *{stuff strip and breakLocation into points for future reference} ,strips.vh[vhs] := strip; ,lOffsetPt.vh[vhs] := breakLocation; ,END; &{project the point into the (0,0)-origined space that the printManager rectangles are in} (LPtMinusLPt(pagLPt, pageOrigin, pagLPt); (LRectHaveLPt(meatLRect, pagLPt); {force it to meat rectangle} (LPtMinusLPt(pagLPt, meatLRect.topLeft, pagLPt); {get offset from inner corner} (LPtPlusLPt(pagLPt, lOffsetPt, unPagLPt); {project onto main view} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPaginatedView.}DoOnPages{(focusOnInterior: BOOLEAN; PROCEDURE DoOnAPage))}; (VAR pgsPerStrip: INTEGER; {pages per row-strip if pageRiseDirection = h} ,firstRowStrip: INTEGER; ,firstColStrip: INTEGER; ,lastRowStrip: INTEGER; ,lastColStrip: INTEGER; ,row: INTEGER; ,column: INTEGER; ,pageNumber: LONGINT; ,lOrigin: LPoint; ,origin: Point; ,anLRect: LRect; ,incomingPane: TPane; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ,incomingPane := TPane(thePad); ,anLRect := thePad.visLRect; ,IF SectLRect(anLRect, SELF.extentLRect, anLRect) THEN 0{thanks for the lovely intersection}; ,IF EqualLRect(anLRect, zeroLRect) THEN 0BEGIN 0{$IFC fTrace}EP;{$ENDC} 0EXIT(DoOnPages); 0END; ,pgsPerStrip := SELF.printManager.breaks[ @orthogonal[SELF.printManager.pageRiseDirection]].size; ,WITH anLRect, SELF DO 0BEGIN ){$H-} firstRowStrip := LIntDivLInt(topLeft.v, pageSize[v]) + 1; 0firstColStrip := LIntDivLInt(topLeft.h, pageSize[h]) + 1; 0lastRowStrip := MIN(LIntDivLInt(botRight.v, pageSize[v]) + 1, 9SELF.printManager.breaks[h].size); 0lastColStrip := MIN(LIntDivLInt(botRight.h, pageSize[h]) + 1, 9SELF.printManager.breaks[v].size); ){$H+} END; ,PushFocus; ,IF (theMarginPad.view <> SELF.unpaginatedView) OR (theMarginPad.port = printerPseudoPort) THEN /theMarginPad.Rework(SELF.unpaginatedView, zeroPt, screenRes, 1, 9SELF.panel.zoomFactor, POINTER(SELF.panel.window.wmgrId)); ,FOR row := firstRowStrip TO lastRowStrip DO 0FOR column := firstColStrip to lastColStrip DO 4BEGIN 4IF SELF.printManager.pageRiseDirection = h THEN 8pageNumber := (row - 1) * pgsPerStrip + column 4ELSE 8pageNumber := (column - 1) * pgsPerStrip + row; 4SetLPt(lOrigin,  SELF.printManager.breaks[orthoVhs].Size) THEN 0ABCBreak('PagifyLPt: strip=', strip.vh[orthoVHs]) {only for short-term debugging} ,ELSE ,IF strip.vh[orthoVhs] = 1 THEN 0pagLPt.vh[vhs] := unPagLPt.vh[vhs] + SELF.printManager.contentLRect.topLeft.vh[vhs] ,ELSE 0BEGIN 0pageBreak := TpLONGINT(SELF.printManager.breaks[orthoVhs].At(strip.vh[orthoVhs] - 1))^; 0pagLPt.vh[vhs] := unPagLPt.vh[vhs] + SELF.printManager.contentLRect.topLeft.vh[vhs] 9+ LIntMulInt(SELF.pageSize[vhs], strip.vh[orthoVhs] - 1) - ABS(pageBreak); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; #{$S SgABCpri} $PROCEDURE {TPaginatedView.}ReactToPrinterChange; (VAR panel: TPanel; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (panel := SELF.panel; (panel.Preview(mPrvwOff); {get back to main-view metrics in the panes} '{Don't refer to SELF after this, since Preview has deallocated me} (panel.view.ReactToPrinterChange; (panel.Preview(mPrvwMargins); {creates fresh paginated view with correct info} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} $PROCEDURE {TPaginatedView.}RedoBreaks; (VAR panel: TPanel; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (panel := SELF.panel; (panel.Preview(mPrvwOff); {get back to main-view metrics in the panes} '{Don't refer to SELF after this, since Preview has deallocated me} (panel.view.ReDoBreaks; (panel.Preview(mPrvwMargins); {creates fresh paginated view with correct info} ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCini} END; {$S SgABCres} METHODS OF TPageView; {$S sCldInit} $FUNCTION {TPageView.}CREATE{(object: TObject; heap: THeap; itsPrintManager: TPrintManager): TPageView}; (VAR view: TView; $BEGIN '{$IFC fTrace}BP(9);{$ENDC} (view := itsPrintManager.view; (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TPageView(TView.CREATE(object, heap, view.panel, itsPrintManager.paperLRect, =itsPrintManager, zeroLRect, FALSE, view.res, FALSE)); '{$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$S SgABCpri} $PROCEDURE {TPageView.}Draw; (VAR s: TListScanner; ,heading: THeading; ,pageNumber: LONGINT; ,outerFrame: LRect; ,headings: TList; ,editing: BOOLEAN; $BEGIN '{$IFC fTrace}BP(9);{$ENDC} (PenNormal; (IF SELF.printManager.frameBody THEN {body should be framed...} ,IF amPrinting THEN 0FrameLRect(SELF.printManager.contentLRect); (editing := (SELF.printManager.layoutDialogBox <> NIL) AND ,(SELF.printManager.view.panel.window.dialogBox = SELF.printManager.layoutDialogBox); (headings := SELF.printManager.headings; (IF headings <> NIL THEN ,BEGIN ,pageNumber := theMarginPad.pageNumber; ,s := headings.Scanner; {tell each Heading to draw itself} ,WHILE s.Scan(heading) DO 0IF heading.ShouldDraw(pageNumber) THEN 4BEGIN 4IF NOT editing THEN 8BEGIN 8heading.AdjustForPage(pageNumber, FALSE); {client changes contents/extent} 8heading.LocateOnPage(FALSE); {...then we adjust to page} 8END; 4heading.Draw; 4END; ,END; '{$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$S SgABCini} END; {$S SgABCres} {$S SgABCini} METHODS OF TPrintManager; $FUNCTION {TPrintManager.}CREATE{(object: TObject; heap: THeap): TPrintManager}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TPrintManager(object); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPrintManager.}Init{(itsMainView: TView; itsDfltMargins: LRect)}; (VAR paperLRect: LRect; ,l: TArray; ,vhs: VHSelect; ,pageView: TView; ,pageBreak: LONGINT; ,newList: TList; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (newList := TList.CREATE(NIL, itsMainView.Heap, 0); {the Headings} (WITH SELF DO ,BEGIN ,view := itsMainView; ,headings := newList; ,pageRiseDirection := h; ,frameBody := FALSE; ,layoutDialogBox := NIL; ,canEditPages := FALSE; {subclass may make true} ,END; (FOR vhs := v TO h DO ,BEGIN ,l := TArray.CREATE(NIL, itsMainView.Heap, 1, SIZEOF(LONGINT)); ,pageBreak := itsMainView.extentLRect.botRight.vh[orthogonal[vhs]]; ,l.InsFirst(@pageBreak); ,SELF.breaks[vhs] := l; ,END; (WITH itsDfltMargins DO ,BEGIN {$H-} ,left := ABS(left); ,top := ABS(top); ,right := - ABS(right); ,bottom := - ABS(bottom); ,END; {$H+} (SELF.pageMargins := itsDfltMargins; (pageView := SELF.NewPageView(NIL); (SELF.pageView := pageView; (SELF.SetDfltHeadings; {NB: TView.CREATE will, after calling me, call ReactToPrinterChange; Juntil that's done, things are not necessarily in synch} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCini} $PROCEDURE {TPrintManager.}Free; (VAR vhs: VHSelect; $BEGIN ({$IFC fTrace}BP(2);{$ENDC} (FOR vhs := v TO h DO ,IF SELF.breaks[vhs] <> NIL THEN 0SELF.breaks[vhs].Free; (Free(SELF.pageView); (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TPrintManager.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (Field('view: TView'); (Field('pageView: TPageView'); (Field('breaks: ARRAY[0..1] OF TArray'); (Field('pageMargins: LRect'); (Field('headings: TList'); (Field('canEditPages: BOOLEAN'); (Field('layoutDialogBox: TDialogBox'); (Field('frameBody: BOOLEAN'); (Field('paperLRect: LRect'); (Field('printableLRect: LRect'); {safeLRect out} (Field('contentLRect: LRect'); (Field(CONCAT('printerMetrics: RECORD paperRect: Rect; printRect: Rect; ', 6'res: Point; reserve: ARRAY[0..7] OF Byte END')); (Field('pageRiseDirection: BOOLEAN'); (Field(''); $END; ${$S SgABCres} ${$ENDC} ${$S SgABCpri} $PROCEDURE {TPrintManager.}AddStripOfPages{(vhs: VHSelect)}; (VAR newExtentLRect: LRect; ,adjustment: LONGINT; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ,WITH SELF.contentLRect DO {cd save a mote by flipping vhs just before this} 0adjustment := botRight.vh[orthogonal[vhs]] - topLeft.vh[orthogonal[vhs]]; ,WITH SELF.view.extentLRect DO 0IF vhs = v THEN &{$H-} SetLRect(newExtentLRect, left, top, right + adjustment, bottom) 0ELSE 4SetLRect(newExtentLRect, left, top, right, bottom + adjustment); {$H+} ,SELF.view.Resize(newExtentLRect); ,SELF.RedoBreaks; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCpri} $PROCEDURE {TPrintManager.}ChangeMargins{(margins: LRect)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (WITH margins DO ,BEGIN {$H-} ,left := ABS(left); ,top := ABS(top); ,right := - ABS(right); ,bottom := - ABS(bottom); ,END; {$H+} (SELF.pageMargins := margins; (SELF.view.panel.currentView.ReactToPrinterChange; (SELF.view.panel.Invalidate; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sCldInit} $PROCEDURE {TPrintManager.}ClearPageBreaks{(automatic: BOOLEAN)}; )VAR s: TListScanner; -break: LONGINT; -vhs: VHSelect; -endOfView: LONGINT; -breakIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} ({ Clears all page breaks of the specified kind EXCEPT for the one marking the end of the view } ,FOR vhs := v TO h DO 0BEGIN 0endOfView := SELF.view.extentLRect.botRight.vh[orthogonal[vhs]]; 0breakIndex := 1; 0WHILE breakIndex < SELF.breaks[vhs].size DO 4BEGIN 4break := TpLONGINT(SELF.breaks[vhs].At(breakIndex))^; 4IF (break >= 0) = automatic THEN 8IF ABS(break) < endOfView THEN = limit THEN = 0) AND manualOnly) THEN @SELF.DrawOneBreak(pageBreak, vhs); 8breakIndex := breakIndex + 1; 8END; 4END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPrintManager.}DrawOneBreak{(pageBreak: LONGINT; vhs: vhSelect)}; (VAR lPt1: LPoint; ,lPt2: LPoint; ,pt: Point; ,wPt: Point; {width of line} $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (IF pageBreak >= 0 THEN ,thePad.SetPen(autoBreakPen) (ELSE ,thePad.SetPen(manualBreakPen); (lPt1 := zeroLPt; (lPt2 := SELF.view.extentLRect.botRight; (lPt1.vh[orthogonal[vhs]] := ABS(pageBreak); (lPt2.vh[orthogonal[vhs]] := ABS(pageBreak); (wPt := thePort^.pnSize; (wPt.vh[vhs] := 0; (thePad.LPtToPt(lPt1, pt); (MoveTo(pt.h - wPt.h, pt.v - wPt.v); {wPt adjustment to hang line off top/left, not bot/right} (thePad.LPtToPt(lPt2, pt); (LineTo(pt.h - wPt.h, pt.v - wPt.v); {wPt adjustment to hang line off top/left, not bot/right} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCpri} $PROCEDURE {TPrintManager.}DrawPage; (VAR heading: THeading; 0contentRect: Rect; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF (amPrinting) AND (SELF.frameBody) THEN {client wants frame drawn on printed page} ,BEGIN ,theMarginPad.LRectToRect(SELF.contentLRect, contentRect); ,PenNormal; ,PenSize(3,2); ,PenMode(patOr); ,InsetRect(contentRect, -1, -1); ,FrameRect(contentRect); ,END; (SELF.pageView.Draw; {will draw headings and possibly frame body} (theBodyPad.Focus; (SELF.view.Draw; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} #{$S SgABCpri} $PROCEDURE {TPrintManager.}EnterPageEditting; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCpri} $PROCEDURE {TPrintManager.}GetPageLimits{(pageNumber: LONGINT; VAR viewLRect: LRect)}; ${ NB: *The default is that page numbers go up from left-to-right, as illustrated by: -|--------|--------|--------| -| page 1 | page 2 | page 3 | -|--------|--------|--------| -| page 4 | page 5 | page 6 | -|--------|--------|--------| *This is what is obtained by leaving TPrintManager.pageRiseDirection +at its default value of 'h'; to get the transpose, set pageRiseDirection 'v' &} (VAR ,totalStrips: INTEGER; {if pageRiseDirection is h, this is the total number of column Lstrips} ,pageRiseDirection: VHSelect; ,orthoDirection: VHSelect; ,strips: Point; ,vhs: VHSelect; ,breakArray: TArray {OF LONGINT}; ,strip: INTEGER; ,nextLocation: LONGINT; ,pageBreak: LONGINT; %BEGIN ({$IFC fTrace}BP(9);{$ENDC} (pageRiseDirection := SELF.pageRiseDirection; (orthoDirection := orthogonal[pageRiseDirection]; (totalStrips := SELF.breaks[orthoDirection].size; (strips.vh[orthoDirection] := ((pageNumber - 1) DIV totalStrips) + 1; (strips.vh[pageRiseDirection] := pageNumber - ((strips.vh[orthoDirection] - 1) * totalStrips); (FOR vhs := v TO h DO ,BEGIN ,breakArray := SELF.breaks[orthogonal[vhs]]; ,strip := strips.vh[vhs]; ,IF strip = 1 THEN 0nextLocation := 0 ,ELSE 0BEGIN 0pageBreak := TpLONGINT(breakArray.At(strip - 1))^; 0nextLocation := ABS(pageBreak); 0END; ,viewLRect.topLeft.vh[vhs] := nextLocation; ,pageBreak := TpLONGINT(breakArray.At(strip))^; ,viewLRect.botRight.vh[vhs] := ABS(pageBreak); ,END; ({$IFC fTrace}EP;{$ENDC} %END; ${$S SgABCres} $FUNCTION {TPrintManager.}NewPageView{(object: TObject): NewPageView}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (NewPageView := TPageView.CREATE(object, SELF.Heap, SELF); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TPrintManager.}NewPaginatedView{(object: TObject): TPaginatedView}; ${Building Block or Client reimplements this to install own flavor of paginated view} $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (NewPaginatedView := TPaginatedView.CREATE(object, SELF.Heap, SELF.view); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TPrintManager.}PageWith{(VAR lPtInView: LPoint; VAR strip: Point): LONGINT}; (VAR pageBreak: LONGINT; ,curStrip: INTEGER; ,vhs: VHSelect; ,finished: BOOLEAN; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (LRectHaveLPt(SELF.view.extentLRect, lPtInView); (FOR vhs := v TO h DO ,BEGIN ,finished := FALSE; ,curStrip := 1; ,WHILE (curStrip <= SELF.breaks[orthogonal[vhs]].size) AND NOT finished DO 0BEGIN 0pageBreak := TpLONGINT(SELF.breaks[orthogonal[vhs]].At(curStrip))^; 0IF lPtInView.vh[vhs] <= ABS(pageBreak) THEN 4BEGIN 4strip.vh[orthogonal[vhs]] := curStrip; 4finished := TRUE; 4END 0ELSE 4curStrip := curStrip + 1; 0END; ,END; ,PageWith := (strip.vh[SELF.pageRiseDirection] - 1) * FSELF.breaks[orthogonal[SELF.pageRiseDirection]].size 8* strip.vh[orthogonal[SELF.pageRiseDirection]]; ({$IFC fTrace}EP;{$ENDC} $END; {Note: The Pepsi and the Spring versions of the following procedure are completely different} {$IFC libraryVersion <= 20} { P E P S I } ${$S SgABCpri} $PROCEDURE {TPrintManager.}Print{(printPref: TPrReserve)}; (LABEL 1,2,3,4,5,6; {as demanded by Print Manager} (VAR scaleOne: TScaler; ,pageNumber: LONGINT; ,rBand: Rect; ,pgsTotal: LONGINT; ,printerMetrics: TPrinterMetrics; ,error: INTEGER; ,dispatchCode: INTEGER; {dispatch code from LisaPrint} ,fSpool: BOOLEAN; ,prPrfAlias: TPrPrfAlias; (BEGIN ({$IFC fTrace}BP(9);{$ENDC} ,prPrfAlias.reserve := printPref; ,printerMetrics := SELF.printerMetrics; ,SetPt(ScaleOne.numerator, 1, 1); ,SetPt(ScaleOne.denominator, 1, 1); ,pgsTotal := SELF.view.MaxPageToPrint; {by default, # of rowBreaks * # of colBreaks} ,fSpool := TRUE; 1: ,PrDocStart(dispatchCode, prPrfAlias.prIns, printLDSN); {open the printer} ,CASE PrCheckErr(dispatchCode) OF 0PrGoDocStart: BEGIN AfSpool := FALSE; AGOTO 1; AEND; 0PrGoDocEnd: GOTO 5; 0PrGoExit: GOTO 6; ,END; { case } +theMarginPad.Rework 0(SELF.view, zeroPt, printerMetrics.res, 1, 4scaleOne, printerPseudoPort); {set up margin/body pads...} +pageNumber := 0; +REPEAT /pageNumber := pageNumber + 1; 2: PrStartPage(dispatchCode); /CASE PrCheckErr(dispatchCode) OF 3prGoDocStart: BEGIN DfSpool := FALSE; DGOTO 1; DEND; 3prGoStartPage: GOTO 2; 3prGoEndPage: BEGIN DSELF.SkipPage(pageNumber); {read on to start of next page, without `printing this one} DGOTO 4; DEND; 3prGoDocEnd: GOTO 5; 3prGoExit: GOTO 6; 3prGoCont: {actually print the page} 7BEGIN 7theMarginPad.SetForPage(pageNumber, zeroPt); 7WHILE PrNextBand(rBand) DO ;BEGIN ;theMarginPad.ClipFurtherTo(rBand); ;theMarginPad.Focus; ;SELF.DrawPage; 3: PrDumpBand(dispatchCode); ;CASE PrCheckErr(dispatchCode) OF ?PrGoDocStart: OBEGIN OfSpool := FALSE; OGOTO 1; OEND; ?PrGoStartPage: ABCBreak('PrGoStartPage received; page #=', pageNumber); ?PrGoDumpBand : GOTO 3; ?PrGoEndPage : GOTO 4; ?PrGoDocEnd : GOTO 5; ?PrGoExit : GOTO 6; ?END; { CASE } ;END; {WHILE PrNextBand} 7END; {prGoCont dispatch code from prStartPage} .END; {case on Err from StartPage} 4: PrEndPage(dispatchCode); .CASE PrCheckErr(dispatchCode) OF 1PrGoDocStart: BEGIN @fSpool := FALSE; @GOTO 1; @END; 1PrGoExit: GOTO 2; .END; { case } (UNTIL pageNumber = pgsTotal; 5: PrDocEnd(dispatchCode); +CASE PrCheckErr(dispatchCode) OF /PrGoDocStart: BEGIN >fSpool := FALSE; >GOTO 1; >END; /PrGoStartPage: ABCBreak('PrGoStartPage received; page #=', pageNumber); /PrGoDocEnd : GOTO 5; /PrGoExit : GOTO 6; +END; { case } 6: ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} { END of Pepsi-release version of TPrintmanager.Print } (*********************************************************************************************************) {$ELSEC} {spring-release version of TPrintManager.Print follows} ${$S SgABCpri} $PROCEDURE {TPrintManager.}Print{(printPref: TPrReserve)}; (VAR unzoomed: TScaler; ,pageNumber: LONGINT; ,pgsTotal: LONGINT; ,prPort: TPrPort; ,prPrfAlias: TPrPrfAlias; ,resPageEnd: BOOLEAN; %BEGIN ({$IFC fTrace}BP(9);{$ENDC} (prPrfAlias.reserve := printPref; (SetPt(unzoomed.numerator, 1, 1); (SetPt(unzoomed.denominator, 1, 1); (pgsTotal := SELF.view.MaxPageToPrint; {by default, # of rowBreaks * # of colBreaks} {$IFC LibraryVersion < 30} (prPrfAlias.prPrf.prLdsn := printLDSN; (IF PrDocStart(prPrfAlias.prPrf, prPort {, printLDSN} ) THEN {open the printer} {++} ,{NB ldsn param not currently in spring interface, but Eric Z says it's going back in} {$ELSEC} (IF PrDocStart(prPrfAlias.prPrf, prPort , printLDSN, TRUE) THEN {open the printer} {++} {$ENDC} ,BEGIN ,theMarginPad.Rework 1(SELF.view, zeroPt, SELF.printerMetrics.res, 1, 5unzoomed, printerPseudoPort); {set up margin/body pads...} ,RectRgn(altVisRgn, hugeRect); ,useAltVisRgn := TRUE; ,pageNumber := 0; ,REPEAT 0pageNumber := pageNumber + 1; 0IF NOT PrPageStart(prPrfAlias.prPrf, prPort) THEN {+SW+} 4SELF.SkipPage(pageNumber) {read on to start of next page, without printing this one} 0ELSE 4BEGIN 4theMarginPad.SetForPage(pageNumber, zeroPt); 4theMarginPad.Focus; 4SELF.DrawPage; 4END; 0resPageEnd := PrPageEnd(prPrfAlias.prPrf, prPort); ,UNTIL 0resPageEnd OR (pageNumber >= pgsTotal); ,PrDocEnd(prPrfAlias.prPrf, prPort); ,{??? Do we need to stuff the prRec back into the doc?? Must ask Bayles} ,useAltVisRgn := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$ENDC} {End of Spring-Release version of TPrintManager.Print} ${$S sCldInit} $PROCEDURE {TPrintManager.}ReactToPrinterChange; {several changes} (VAR newExtent: LRect; ,minViewLRect: LRect; ,s: TListScanner; ,pageBreak: LONGINT; ,vhs: VHSelect; ,curLPt: LPoint; ,pageIncrement: LONGINT; ,metrics: TPrinterMetrics; (PROCEDURE ScaleToViewedSpace(printRect: Rect; VAR viewedLRect: LRect); ,BEGIN 0SetLRect(viewedLRect, 2LIntOvrInt(ORD4(printRect.left) * SELF.view.res.h, metrics.res.h), 2LIntOvrInt(ORD4(printRect.top) * SELF.view.res.v, metrics.res.v), 2LIntOvrInt(ORD4(printRect.right) * SELF.view.res.h, metrics.res.h), 2LIntOvrInt(ORD4(printRect.bottom) * SELF.view.res.v, metrics.res.v)); ,END; %BEGIN ({$IFC fTrace}BP(9);{$ENDC} ){ SELF.InvalidatePageBreaks, or some such ???} )SELF.view.panel.window.GetPrinterMetrics; {except maybe for view in first Panel created, this will Ube an unnecessary (but inexpensive) step} )metrics := SELF.view.panel.window.printerMetrics; )SELF.printerMetrics := metrics; )WITH SELF, printerMetrics DO -BEGIN {$H-} ScaleToViewedSpace(paperRect, paperLRect); -ScaleToViewedSpace(printRect, printableLRect); -END; (LRectPlusLRect(SELF.paperLRect, SELF.pageMargins, SELF.contentLRect); {$H+} (SELF.pageView.Resize(SELF.paperLRect); (SELF.view.SetMinViewSize(newExtent); {++} (SELF.view.Resize(newExtent); {set view back to its min size} (SELF.RedoBreaks; {may resize the view upwards again by a bit} '{SELF.InvalidatePageBreaks again -- to force update where new breaks are to be shown} %{$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sCldInit} $PROCEDURE {TPrintManager.}RedoBreaks; )VAR vhs: VHSelect; -maxViewPixelsPerPage: INTEGER; -curLocation: LONGINT; -onePixelTooMuch: LONGINT; -endOfView: LONGINT; -s: TListScanner; -nextPageBreak: LONGINT; -breakIndex: INTEGER; -penultimatePageBreak: LONGINT; -newViewExtent: LRect; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (newViewExtent := SELF.view.extentLRect; (SELF.ClearPageBreaks(TRUE); {clear out old automatic breaks} (FOR vhs := v TO h DO ,BEGIN ,WITH SELF.contentLRect DO 0IF vhs = v THEN 4maxViewPixelsPerPage := right - left 0ELSE 4maxViewPixelsPerPage := bottom - top; ,endOfView := SELF.view.extentLRect.botRight.vh[orthogonal[vhs]]; ,breakIndex := 1; ,curLocation := 0; ,WHILE curLocation < endOfView DO 0BEGIN 0nextPageBreak := TpLONGINT(SELF.breaks[vhs].At(breakIndex))^; 0onePixelTooMuch := Min(curLocation + MaxViewPixelsPerPage, endOfView); 0IF ABS(nextPageBreak) <= onePixelTooMuch THEN 4curLocation := ABS(nextPageBreak) 0ELSE {no manual page break; impose an automatic one -- propose onePixelTooMuch} 4BEGIN 4curLocation := SELF.view.ForceBreakAt(vhs, curLocation, onePixelTooMuch); 4SELF.breaks[vhs].InsAt(breakIndex, @curLocation); 4END; 0breakIndex := breakIndex + 1; 0END; ,IF SELF.view.fitPagesPerfectly THEN {make minor adjustment upward} 0BEGIN 0IF (SELF.breaks[vhs].size > 1) THEN 4penultimatePageBreak := TpLONGINT(SELF.breaks[vhs].At(SELF.breaks[vhs].size - 1))^ 0ELSE 4penultimatePageBreak := 0; 0newViewExtent.botRight.vh[orthogonal[vhs]] := ABS(penultimatePageBreak) + `maxViewPixelsPerPage; 0END; ,END; {for vhs := v to h} (SELF.view.Resize(newViewExtent); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCpri} $PROCEDURE {TPrintManager.}SetBreak{(vhs: VHSelect; where: LONGINT; isAutomatic: BOOLEAN)}; )VAR s: TListScanner; -break: LONGINT; {comment gone} -prevBreakLoc: LONGINT; -breakIndex: INTEGER; -finished: BOOLEAN; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (prevBreakLoc := 0; (breakIndex := 1; (finished := FALSE; (WHILE (breakIndex <= SELF.breaks[vhs].size) AND NOT finished DO ,BEGIN ,break := TpLONGINT(SELF.breaks[vhs].At(breakIndex))^; ,IF ABS(break) > where THEN .{found where to insert!} 0BEGIN 0where := SELF.view.ForceBreakAt(vhs, prevBreakLoc, where); 0break := where; 0IF NOT isAutomatic THEN 4break := - break; 0SELF.breaks[vhs].InsAt(breakIndex, @break); 0finished := TRUE; 0END ,ELSE ,IF ABS(break) = where THEN /{replace an existing page break} 0BEGIN 0break := where; 0IF NOT isAutomatic THEN 4break := - break; 0SELF.breaks[vhs].PutAt(breakIndex, @break); 0finished := TRUE; 0END ,ELSE 0prevBreakLoc := ABS(break); ,breakIndex := breakIndex + 1; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $PROCEDURE {TPrintManager.}SetDfltHeadings; {client redefines} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCpri} %PROCEDURE {TPrintManager.}SkipPage{(pageNumber: LONGINT)}; {client may want to redefine} %BEGIN ({$IFC fTrace}BP(9);{$ENDC} ({$IFC fTrace}EP;{$ENDC} %END; ${$S SgABCres} {$S SgABCini} END; {$S SgABCres} METHODS OF THeading; {$S SgABCini} $FUNCTION {THeading.}CREATE{(object: TObject; heap: THeap; itsPrintManager: TPrintManager; *itsExtentLRect: LRect; itsPageAlignment: TPageAlignment; itsOffsetFromAlignment: LPoint): THeading}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := THeading(TImage.CREATE(object, heap, itsExtentLRect, itsPrintManager.pageView)); (WITH SELF DO ,BEGIN ,printManager := itsPrintManager; ,pageAlignment := itsPageAlignment; ,offsetFromAlignment := itsOffsetFromAlignment; ,oddOnly := FALSE; ,evenOnly := FALSE; ,minPage := 2; ,maxPage := MAXLINT; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {THeading.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TImage.Fields(Field); (Field('printManager: TPrintManager'); (Field('pageAlignment: Byte'); {enumerated type} (Field('offsetFromAlignment: LPoint'); (Field('oddOnly: BOOLEAN'); (Field('evenOnly: BOOLEAN'); (Field('minPage: LONGINT'); (Field('maxPage: LONGINT'); (Field(''); $END; ${$S SgABCcld} ${$ENDC} $PROCEDURE {THeading.}AdjustForPage{(pageNumber: LONGINT; editing: BOOLEAN)}; ${will be overridden in Subclass if meaningful} $BEGIN ({$IFC fTrace}BP(9);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {THeading.}ChangePageAlignment{(newPageAlignment: TPageAlignment)}; (VAR newOffset: LPoint; (FUNCTION Mid(anLRect: LRect; vhs: VHSelect): LONGINT; ,BEGIN ,Mid := (anLRect.topLeft.vh[vhs] + anLRect.botRight.vh[vhs]) DIV 2; ,END; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF SELF.pageAlignment <> newPageAlignment THEN ,BEGIN ,CASE newPageAlignment OF 0aTopLeft, aBottomLeft: 4newOffset.h := SELF.extentLRect.left - SELF.view.extentLRect.left; 0aTopCenter, aBottomCenter: 4newOffset.h := Mid(SELF.extentLRect, h) - Mid(SELF.view.extentLRect, h); 0aTopRight, aBottomRight: 4newOffset.h := SELF.extentLRect.right - SELF.view.extentLRect.right; 0END; ,CASE newPageAlignment OF 0aTopLeft, aTopCenter, aTopRight: 4newOffset.v := SELF.extentLRect.top - SELF.view.extentLRect.top; 0aBottomLeft, aBottomCenter, aBottomRight: 4newOffset.v := SELF.extentLRect.bottom - SELF.view.extentLRect.bottom; 0END; ,SELF.offsetFromAlignment := newOffset; ,SELF.pageAlignment := newPageAlignment; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {THeading.}Draw; {will be overridden in Subclass if meaningful} $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF SELF.shouldFrame THEN ,FrameLRect(SELF.extentLRect); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {THeading.}LocateOnPage{(editing: BOOLEAN)}; ${called after client has adjusted the extentLRect and (possibly) the offsetFromAlignment} (VAR currentH, currentV, targetH, targetV: LONGINT; ,offset: LPoint; ,pmgr: TPrintManager; (* CIRCUMVENT COMPILER BUG *) ({NB: Someday someone could use vhs and other tricks to tighten this up} $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (WITH SELF DO *BEGIN (* CIRCUMVENT COMPILER BUG *) *pmgr := SELF.printManager; (* CIRCUMVENT COMPILER BUG *) *WITH pmgr, paperLRect DO ,BEGIN ,CASE {SELF.}pageAlignment OF 0aTopLeft, 2aBottomLeft: BEGIN DcurrentH := {SELF.}extentLRect.left; DtargetH := {paperLRect.}left; DEND; 0aTopCenter, 2aBottomCenter: BEGIN DcurrentH := (extentLRect.right + extentLRect.left) DIV 2; DtargetH := {paperLRect.}(right + left) DIV 2; DEND; 0aTopRight, 2aBottomRight: BEGIN DcurrentH := extentLRect.right; DtargetH := right; DEND; 0END; ,CASE {SELF.}pageAlignment OF 0aTopLeft, 2aTopCenter, 2aTopRight: BEGIN DcurrentV := extentLRect.top; DtargetV := top; DEND; 0aBottomLeft, 2aBottomCenter, 2aBottomRight: BEGIN DcurrentV := extentLRect.bottom; DtargetV := bottom; DEND; 0END; ,END; *END; (* CIRCUMVENT COMPILER BUG *) (WITH SELF.offsetFromAlignment DO ,{$H-}SetLPt(offset, targetH - currentH + h, targetV - currentV + v); {$H+} (SELF.OffsetBy(offset); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {THeading.}ShouldDraw{(pageNumber: LONGINT): BOOLEAN}; (VAR judgment: BOOLEAN; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (WITH SELF DO ,IF (oddOnly AND NOT ODD(pageNumber)) OR /(evenOnly AND ODD(pageNumber)) OR /(pageNumber < minPage) OR /(pageNumber > maxPage) THEN 4judgment := FALSE ,ELSE /judgment := TRUE; (ShouldDraw := judgment; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {THeading.}ShouldFrame{: BOOLEAN}; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (ShouldFrame := NOT amPrinting; {default} ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCini} END; {$S SgABCres} METHODS OF TSelection; ${$S sStartup} $FUNCTION {TSelection.}CREATE{(object: TObject; heap: THeap; itsView: TView; itsKind: INTEGER; @itsAnchorLPt: LPoint): TSelection}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TSelection(object); (WITH SELF DO ,BEGIN ,currLPt := itsAnchorLPt; ,anchorLPt := itsAnchorLPt; ,boundLRect := hugeLRect; ,kind := itsKind; ,view := itsView; ,panel := view.panel; ,IF panel <> NIL THEN 0window := panel.window; ,coSelection := NIL; ,canCrossPanels := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TSelection.}Clone{(heap: Theap): TObject}; $VAR selection: TSelection; (coSelection: Tselection; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (selection := TSelection(SUPERSELF.Clone(heap)); (IF SELF.coSelection <> NIL THEN ,BEGIN ,coSelection := TSelection(SELF.coSelection.Clone(heap)); ,selection.coSelection := coSelection; ,END; (Clone := selection; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}Free; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (Free(SELF.coSelection); (TObject.Free; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TSelection.}FreedAndReplacedBy{(selection: TSelection): TSelection}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.Become(selection); (FreedAndReplacedBy := SELF; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TSelection.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (Field('window: TWindow'); (Field('panel: TPanel'); (Field('view: TView'); (Field('kind: INTEGER'); (Field('anchorLPt: LPoint'); (Field('currLPt: LPoint'); (Field('boundLRect: LRect'); {+++LSR+++} (Field('coSelection: TSelection'); (Field('canCrossPanels: BOOLEAN'); (Field(''); $END; ${$S SgABCres} ${$ENDC} ${$S sRes} $FUNCTION {TSelection.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (IF SELF.coSelection <> NIL THEN ,CanDoCommand := SELF.coSelection.CanDoCommand(cmdNumber, checkIt) (ELSE ,CanDoCommand := SELF.window.CanDoCommand(cmdNumber, checkIt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sAlert} $PROCEDURE {TSelection.}CantDoCmd{(cmdNumber: TCmdNumber)}; (VAR cmdStr: S255; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF menuBar.GetCmdName(cmdNumber, @cmdStr) THEN ,BEGIN ,process.ArgAlert(1, cmdStr); ,process.Stop(phUnkCmd); ,END (ELSE ,SELF.CantDoIt; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sAlert} $PROCEDURE {TSelection.}CantDoIt; (VAR ph: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.kind = nothingKind THEN ,ph := phNoSel (ELSE ,ph := phSelCant; (process.Stop(ph); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}Deselect; $VAR selection: TSelection; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.panel.Highlight(SELF, hOnToOff); (selection := SELF.FreedAndReplacedBy(SELF.view.NoSelection); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TSelection.}DrawGhost; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}DoKey{(ascii: CHAR; keycap: Byte; shiftKey, appleKey, optionKey: BOOLEAN)}; (VAR cmdNumber: TCmdNumber; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF appleKey THEN ,BEGIN ,SELF.window.SetupMenus; ,cmdNumber := menuBar.CmdKey(ascii); ,SELF.window.DoCommand(cmdNumber); ,END (ELSE (IF currentDocument = clipboard THEN ,process.Stop(phEditClip) (ELSE (IF SELF.kind = nothingKind THEN ,process.Stop(phNoSel) (ELSE ,BEGIN ,CASE ORD(ascii) OF 0ascArwDown: 4SELF.KeyEnter(0, 1); 0ascArwLeft: 4SELF.KeyEnter(-1, 0); 0ascArwRight: 4SELF.KeyEnter(1, 0); 0ascArwUp: 4SELF.KeyEnter(0, -1); 0ascClear: 4SELF.KeyClear; 0ascEnter: 4SELF.KeyEnter(0, 0); 0OTHERWISE 4CASE ORD(ascii) OF 8ascBackspace:  ascClear THEN 0process.RememberCommand(uKeyDown); {clear is special} ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}GetHysteresis{(VAR hysterPt: Point)}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (SetPt(hysterPt, stdHHysteresis, stdVHysteresis); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCpri} $PROCEDURE {TSelection.}HaveView{(view: TView)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.view := view; (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.HaveView(view); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $PROCEDURE {TSelection.}Highlight{(highTransit: THighTransit)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.Highlight(highTransit); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}IdleBegin{(centiSeconds: LONGINT)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.IdleBegin(centiSeconds) (ELSE ,SELF.window.IdleBegin(centiSeconds); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}IdleContinue{(centiSeconds: LONGINT)}; $BEGIN ({$IFC fTrace}BP(5);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.IdleContinue(centiSeconds) (ELSE ,SELF.window.IdleContinue(centiSeconds); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}IdleEnd{(centiSeconds: LONGINT)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.IdleEnd(centiSeconds) (ELSE ,SELF.window.IdleEnd(centiSeconds); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyBack{(fWord: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyBack(fWord) (ELSE ,SELF.CantDoCmd(uBackspace); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyChar{(ch: CHAR)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyChar(ch) (ELSE ,SELF.CantDoCmd(uTyping); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyClear; (VAR dummy: BOOLEAN; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyClear (ELSE IF (menubar.GetCmdName(uClear, NIL)) {there is a CLEAR menu item} AND 0(SELF.CanDoCommand(uClear, dummy)) {the selection says it can do it} THEN ,BEGIN {make believe the user chose the menu item} ,menuBar.HighlightMenu(uClear); ,SELF.window.DoCommand(uClear); ,END (ELSE ,BEGIN ,SELF.CantDoCmd(uClear); ,process.RememberCommand(uClear); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyEnter{(dh, dv: INTEGER)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyEnter(dh, dv) (ELSE ,SELF.CantDoCmd(uEnter); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyForward{(fWord: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyForward(fWord) (ELSE ,SELF.CantDoCmd(uForwardSpace); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyPause; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyPause; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyReturn; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyReturn (ELSE ,SELF.CantDoCmd(uReturn); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}KeyTab{(fBackward: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.KeyTab(fBackward) (ELSE ,SELF.CantDoCmd(uTab); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} $PROCEDURE {TSelection.}MarkChanged; (VAR delta: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.panel.window = currentWindow THEN ,BEGIN ,IF currentWindow.lastCmd = NIL THEN 0delta := 1 ,ELSE ,IF currentWindow.lastCmd.doing THEN 0delta := 1 ,ELSE 0delta := -1; ,currentWindow.changes := currentWindow.changes + delta; ,IF boundDocument = currentDocument THEN 0WITH boundDocument DO 4dataSegment.changes := dataSegment.changes + delta; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}MousePress{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.MousePress(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}MouseMove{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.MouseMove(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}MouseRelease; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.MouseRelease; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TSelection.}MoveBackToAnchor; {dest panel of cross-panel drag refused DoReceive} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TSelection.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,NewCommand := SELF.coSelection.NewCommand(cmdNumber) (ELSE ,NewCommand := SELF.window.NewCommand(cmdNumber); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}PerformCommand{(command: TCommand; cmdPhase: TCmdPhase)};{+sw+} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (command.doing := (cmdPhase <> undoPhase); (command.Perform(cmdPhase); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}Restore; {SELF should be undoSelection} (VAR selection: TSelection; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (selection := SELF.panel.selection.FreedAndReplacedBy( LTSelection(SELF.panel.undoSelection.Clone(SELF.Heap))); {$} (selection := SELF.panel.undoSelection.FreedAndReplaceBy(SELF.view.NoSelection); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}Reveal(asMuchAsPossible: BOOLEAN); (TYPE TXLRect = PACKED ARRAY [1..SIZEOF(LRect)] OF CHAR; (VAR lr: LRect; ,hMin: INTEGER; ,vMin: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.Reveal(asMuchAsPossible) (ELSE ,BEGIN ,lr := SELF.boundLRect; ,IF TXLRect(lr) <> TXLRect(hugeLRect) THEN 0BEGIN 0IF NOT asMuchAsPossible THEN 4BEGIN 4hMin := 30; 4vMin := 20; 4END 0ELSE 4WITH lr DO 8BEGIN 8hMin := Min(MAXINT, right - left + 6); 8vMin := Min(MAXINT, bottom - top + 4); 8END; 0SELF.panel.RevealLRect(lr, hMin, vMin); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}Save; (VAR selection: TSelection; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (selection := SELF.panel.undoSelection.FreedAndReplacedBy(TSelection(SELF.Clone(SELF.Heap))); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TSelection.}SelectParagraphs; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF.coSelection <> NIL THEN ,SELF.coSelection.SelectParagraphs; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCini} BEGIN $cSelection := THISCLASS; END; {$S SgABCres} 3. "6F^9NDD!$ǐ^ 2Lzy: INTEGER): TFont}; si version} og box} ; ); ndow}; }!}}%!HnHz~Hn?. 8. %bcLbLjLj'̓. L ^V$END; ${$S sRes} $PROCEDURE {TMenuBar.}EndCmd; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (HiLiteMenu(0); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $FUNCTION {TMenuBar.}GetCmdName{(cmdNumber: TCmdNumber; pName: TPString): BOOLEAN{INCLUDE FILE UABC4 -- IMPLEMENTATION OF UABC} {Copyright 1983, 1984, Apple Computer, Inc.} @{TWindow-TDialogBox-TMenuBar-TFont} {changed 05/07/84 17:45 Fixed (hopefully) a bug in binary search of InAllMenusDo.} METHODS OF TWindow; ${$S SgABCini} $FUNCTION {TWindow.}CREATE{(object: TObject; heap: THeap; itsWmgrID: TWindowID; itsResizability: BOOLEAN) ?: TWindow}; (VAR pWindow: WindowPtr; ,panels: TList; ,info: WindowInfo; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TWindow(object); (GetWindInfo(WindowPtr(itsWmgrID), info); (WITH SELF DO ,BEGIN ,panelTree := NIL; ,dialogBox := NIL; ,selectPanel := NIL; ,undoSelPanel := NIL; ,clickPanel := NIL; ,undoClickPanel := NIL; ,wmgrID := itsWmgrID; ,isResizable := itsResizability; ,believeWmgr := info.visible; ,changes := 0; ,selectWindow := SELF ; ,undoSelWindow := NIL; {+SW+} ,lastCmd := NIL; ,parentBranch := NIL; ,pgSzOK := TRUE; {client can explicitly set this to FALSE if bothered} ,pgRgOK := TRUE; {client can explicitly set this to FALSE if does own page-ranging} ,panelToPrint := NIL; ,objectToFree := NIL; {+SW+} ,END; (panels := TList.CREATE(NIL, heap, 1); (SELF.panels := panels; (IF itsWmgrID = 0 THEN ,SELF.SetInnerRect(zeroRect) (ELSE ,BEGIN ,pWindow := POINTER(itsWmgrID); ,SELF.SetInnerRect(pWindow^.portRect); ,END; "{$H-} SELF.maxInnerSize := Point(FDiagRect(SELF.innerRect)); {$H+} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCini} $PROCEDURE {TWindow.}Free; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (Free(SELF.dialogBox); (SELF.panels.Free; (TArea.Free; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TWindow.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TArea.Fields(Field); (Field('panels: TList'); (Field('panelTree: TArea'); (Field('dialogBox: TDialogBox'); (Field('selectPanel: TPanel'); (Field('undoSelPanel: TPanel'); (Field('clickPanel: TPanel'); (Field('undoClickPanel: TPanel'); (Field('selectWindow: TWindow'); (Field('undoSelWindow: TWindow'); {+SW+} (Field('wmgrID: Ptr'); (Field('isResizable: BOOLEAN'); (Field('believeWmgr: BOOLEAN'); (Field('maxInnerSize: Point'); (Field('changes: LONGINT'); (Field('lastCmd: TCommand'); (Field(CONCAT('printerMetrics: RECORD paperRect: Rect; printRect: Rect;', 6'res: Point; reserve: ARRAY[0..3] OF INTEGER END')); (Field('pgSzOK: BOOLEAN'); (Field('pgRgOK: BOOLEAN'); (Field('panelToPrint: TPanel'); (Field('objectToFree: TObject'); {+SW+} (Field(''); $END; ${$S SgABCres} ${$ENDC} {$S SgABCcld} $PROCEDURE {TWindow.}AbortEvent; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$S SgABCpri} $PROCEDURE {TWindow.}AcceptNewPrintingInfo{(document: TDocManager; prReserve: TPrReserve)}; %VAR s: TListScanner; *panel: TPanel; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (SELF.selectPanel.selection.MarkChanged; (IF document = clipboard THEN {first, stuff the revised print record back in document} ,clipPrintPref := prReserve (ELSE ,document.dataSegment.preludePtr^.printPref := prReserve; (SELF.GetPrinterMetrics; (s := SELF.panels.Scanner; (WHILE s.Scan(panel) DO ,panel.currentView.ReactToPrinterChange; {tell each view that printer style changed} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sStartup} $PROCEDURE {TWindow.}Activate; {assumes we are focused on the window already} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF NOT SELF.believeWmgr THEN {is this needed????} ,SELF.Resize(FALSE); (SELF.Update(TRUE); {force update in case just opened from an icon} (currentWindow := SELF; ({NOTE: currentDocument has already been set} (activeWindowID := SELF.wmgrID; (SELF.Refresh([rFrame], hDimToOn); (IF currentDocument <> clipboard then ,SELF.ChkPrMismatch; (SELF.PickStdCursor; (clipboard.Inspect; (IF SELF.dialogBox <> NIL THEN ,SELF.dialogBox.Appear; (IF currentDocument.pendingNote <> 0 THEN ,BEGIN ,process.Note(currentDocument.pendingNote); ,currentDocument.pendingNote := 0; ,END; ({reset undo} (SELF.LoadMenuBar; (menuBar.Draw; (SetPt(clickState.where, -MAXINT, -MAXINT); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S Override} $PROCEDURE {TWindow.}BlankStationery; (VAR panel: TPanel; ,view: TView; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (panel := TPanel.CREATE(NIL, SELF.Heap, SELF, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); (view := panel.NewStatusView(NIL, zeroLRect); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sCommand} $FUNCTION {TWindow.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (CanDoCommand := currentWindow.CanDoStdCommand(cmdNumber, checkIt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $FUNCTION {TWindow.}CanDoStdCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; (VAR previewMode: TPreviewMode; ,couldPrint: BOOLEAN; ,panelToUse: TPanel; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (CanDoStdCommand := FALSE; (couldPrint := (SELF.panelToPrint <> NIL); (IF couldPrint THEN ,IF SELF.selectPanel.view.isPrintable THEN 0panelToUse := SELF.selectPanel ,ELSE 0panelToUse := SELF.panelToPrint; (IF couldPrint THEN ,previewMode := panelToUse.previewMode; (CASE cmdNumber OF *{File/Print} ,uSetAllAside, uSetAside, uSetClipAside: 0CanDoStdCommand := TRUE; ,uPutAway, uRevertVersion: 0CanDoStdCommand := clipboard.window <> SELF; ,uSaveVersion: 0CanDoStdCommand := (clipboard.window <> SELF) AND C(currentDocument.files.shouldToolSave OR DNOT currentDocument.openedAsTool); {$IFC LibraryVersion <= 20} ,uPrFmt, uPrint: 0CanDoStdCommand := onDesktop AND (SELF.dialogBox = NIL) AND couldPrint; {$ELSEC} ,uPrFmt, uPrint, uPrintAsIs: 0CanDoStdCommand := onDesktop AND (SELF.dialogBox = NIL) AND couldPrint; {$ENDC} ,uPrMonitor: 0CanDoStdCommand := onDesktop AND (SELF.dialogBox = NIL); {**temporary**} *{Edit} ,uUndoLast: 0IF SELF.lastCmd = NIL THEN 4CanDoStdCommand := FALSE 0ELSE 4CanDoStdCommand := SELF.lastCmd.undoable; *{Page Layout} ,uPrvwMargins, uPrvwBreaks, uPrvwOff, uAddColumnStrip, uAddRowStrip: 0IF couldPrint THEN 4BEGIN 4CanDoStdCommand := TRUE; {or they wouldnt've been in the phrase file} 4CASE cmdNumber OF 8uPrvwMargins:  NIL); 4END; ,uSetHorzBreak, uSetVertBreak, uClearBreaks: 0CanDoStdCommand := SELF.clickPanel.view.isPrintable; ,uShowFullSize, uReduce70Pct, uReduceToFit: 0CanDoStdCommand := fExperimenting; {**temporary**} ,uRiseVertically, uRiseHorizontally: 0IF couldPrint THEN 4BEGIN 4CanDoStdCommand := TRUE; 4checkIt := panelToUse.view.printManager.pageRiseDirection = \VHSelect(cmdNumber = uRiseHorizontally); 4END 0ELSE 4CanDoStdCommand := FALSE; *{$IFC fDbgABC} *{Debug} ,uReportEvents, uCountHeap, uCheckIndices, .uExperimenting, uDumpGlobals, uDumpPrelude, .uMainScramble, uDocScramble: 0BEGIN 0CanDoStdCommand := TRUE; 0CASE cmdNumber OF 4uReportEvents: 8checkIt := eventDebug; 4uCountHeap: 8checkIt := fCountHeap; 4uCheckIndices: 8checkIt := fCheckIndices; 4uExperimenting: 8checkIt := fExperimenting; 4uMainScramble: 8checkIt := THz(mainHeap)^.fScramble; 4uDocScramble: 8IF currentDocument <> NIL THEN  SELF; *{$ENDC} ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} ${$S sStartup} $PROCEDURE {TWindow.}ChkPrMismatch; (VAR styleDidChange: BOOLEAN; ,prPrfAlias: TPrPrfAlias; ,s: TListScanner; ,panel: TPanel; ,error: INTEGER; ,document: TDocManager; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF currentDocument <> NIL THEN ,document := currentDocument (ELSE ,document := boundDocument; (IF document = clipboard THEN ,prPrfAlias.reserve := clipPrintPref (ELSE ,prPrfAlias.reserve := document.dataSegment.preludePtr^.PrintPref; {$IFC libraryVersion <= 20} { P E P S I } (IF FPrArbRqd(prPrfAlias.prPrf) THEN ,BEGIN ,PrArbDlg(error, prPrfAlias.prPrf, styleDidChange); {$ELSEC} { S P R I N G } (IF NOT fPrPrfValid(prPrfAlias.prPrf) THEN ,BEGIN ,PrPrfDlg(prPrfAlias.prPrf, styleDidChange, NOT SELF.pgSzOK); {$ENDC} ,IF styleDidChange THEN 0SELF.AcceptNewPrintingInfo(document, prPrfAlias.reserve); ,END; ({?? Do we need to worry about refreshing the window when needed?} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $PROCEDURE {TWindow.}CommitLast; (VAR lastCmd: TCommand; ,lastView: TView; {+SW+} ,selection: TSelection; {+SW+} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF <> currentWindow THEN ,currentWindow.CommitLast (ELSE ,BEGIN ,lastCmd := SELF.lastCmd; ,IF lastCmd <> NIL THEN 0BEGIN 0IF lastCmd.doing THEN 4lastCmd.Commit; (***** 0IF lastCmd.image <> NIL THEN 4BEGIN 4lastView := lastCmd.image.view; 4selection := lastView.panel.undoSelection.FreedAndReplacedBy(lastView.NoSelection); 4END; *****) 0lastCmd.Free; 0SELF.lastCmd := NIL; 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $FUNCTION {TWindow.}CursorFeedback{: TCursorNumber}; (VAR s: TListScanner; ,panel: TPanel; ,cursorNumber: TCursorNumber; ,mousePt: Point; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (PushFocus; (SELF.Focus; (cursorNumber := noCursor; (GetMouse(mousePt); (IF RectHasPt(SELF.innerRect, mousePt) THEN ,IF SELF.isResizable AND fGrowHit(mousePt) THEN 0cursorNumber := arrowCursor ,ELSE 0BEGIN 0s := SELF.panels.Scanner; 0WHILE s.Scan(panel) DO 4BEGIN 4cursorNumber := panel.CursorAt(mousePt); 4IF cursorNumber <> noCursor THEN 8s.Done; 4END; 0IF cursorNumber = noCursor THEN 4cursorNumber := arrowCursor; 0END; (PopFocus; (CursorFeedback := cursorNumber; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TWindow.}Deactivate; {assumes we are focused on the window already} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (******************** these lines are needed for the Extra Window feature *) (IF currentWindow <> SELF THEN ,BEGIN ,GiveControl(event); {This must be last} ,{$IFC fTrace}EP;{$ENDC} ,EXIT(Deactivate); ,END; (* ********************) (SELF.CommitLast; (IF SELF.dialogBox <> NIL THEN ,SELF.dialogBox.Disappear; (activeWindowID := 0; {must precede StashPicture and Refresh so scroll bars are white} (SELF.Refresh([rFrame], hOnToDim); {do first to give user feedback} (SELF.StashPicture(hOfftoDim); (IF (SELF.wmgrId <> ORD(scrapFolder)) AND (event.fromProcess <> myProcessID) THEN ,clipboard.Publicize; (focusArea := NIL; (IF NOT inBackground THEN ,currentDocument.Deactivate; (GiveControl(event); {This must be last} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sCommand} $PROCEDURE {TWindow.}DoCommand{(cmdNumber: TCmdNumber)}; (VAR command: TCommand; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF cmdNumber <> 0 THEN ,BEGIN ,IF cmdNumber = uUndoLast THEN 0SELF.UndoLast ,ELSE 0BEGIN 0command := SELF.selectPanel.selection.NewCommand(cmdNumber); 0IF command <> NIL THEN {NOTE: If NewCommand Frees SELF (this window), it MUST return NIL} 4SELF.PerformCommand(command); 0END; ,process.RememberCommand(cmdNumber); ,END; (menuBar.EndCmd; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sClick} $FUNCTION {TWindow.}DownAt{(mousePt: Point): BOOLEAN}; (VAR s: TListScanner; ,panel: TPanel; ,b: BOOLEAN; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (b := FALSE; (IF RectHasPt(SELF.innerRect, mousePt) THEN ,BEGIN ,IF SELF.isResizable THEN 0IF fGrowHit(mousePt) THEN 4BEGIN 4SELF.DownInSizeBox(mousePt); 4b := TRUE; 4process.RememberCommand(uResizeWindow); 4END; ,IF NOT b THEN 0BEGIN 0b := TRUE; 0s := SELF.panels.Scanner; 0WHILE s.Scan(panel) DO 4IF panel.DownAt(mousePt) THEN 8s.Done; 0END; ,END; (DownAt := b; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sClick} $PROCEDURE {TWindow.}DownEventAt{(mousePt: Point)}; $VAR clickNeighborhood: Rect; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.Update(TRUE); {In case an alert box was dismissed by the click} ,{ given that previous click was at (0,0), clickNeighborhood is a rectangle in which 0this click must fall for it to have a chance at being a double click } (SetRect(clickNeighborhood, -9, -6, 9, 6); { clickNeighborhood should be a method call; Xhow much flexibility is needed???? } (IF ((event.when - clickState.when) < clickDelay) AND +(RectHasPt(clickNeighborhood, Point(FPtMinusPt(event.where, clickState.where)))) THEN ,clickState.clickCount := Min(clickState.clickCount + 1, 3) (ELSE ,BEGIN ,clickState.clickCount := 1; ,clickState.fShift := event.shiftKey; ,clickState.fOption := event.codeKey; ,clickState.fApple := event.appleKey; ,END; (clickState.when := event.when; (clickState.where := event.where; (IF SELF.DownAt(mousePt) THEN; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sClick} $PROCEDURE {TWindow.}DownInSizeBox{(mousePt: Point)}; (VAR oldRect: Rect; ,fullRect: Rect; {includes title tab} ,minExtent: Point; ,minBotRight: Point; ,maxBotRight: Point; ,savePort: GrafPtr; ,newBotRight: Point; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (oldRect := SELF.innerRect; (SELF.GetMinExtent(minExtent, TRUE); (minBotRight := Point(FPtPlusPt(oldRect.topLeft, minExtent)); (LocalToGlobal(minBotRight); (LocalToGlobal(mousePt); (LocalToGlobal(oldRect.topLeft); (LocalToGlobal(oldRect.botRight); (maxBotRight := Point(FPtMaxPt(minBotRight, screenBits.bounds.botRight)); (fullRect := oldRect; (fullRect.top := fullRect.top - dvSBox; {allow for title tab} (GetPort(savePort); (SetPort(deskPort); (ResizeFeedback(mousePt, minBotRight, maxBotRight, fullRect, dvSBox, dhSBox, dvSBox, newBotRight); (SetPort(savePort); (SELF.ResizeTo(Point(FPtMinusPt(newBotRight, oldRect.topLeft))); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sFilter} {+SW+} $PROCEDURE {TWindow.}EachActualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; (VAR n: INTEGER; ,cmdWindow: TWindow; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({$IFC fDbgABC} (IF SELF = currentWindow.dialogBox THEN ,cmdWindow := currentWindow (ELSE ,cmdWindow := SELF; (IF cmdWindow.lastCmd = NIL THEN ,n := 0 (ELSE ,n := cmdWindow.lastCmd.cmdNumber; (ABCBreak('A View or Window tried to filter but did not implement EachActualPart: lastCmd =', n); ({$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sFilter} $PROCEDURE {TWindow.}EachVirtualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.FilterDispatch(NIL, NIL, DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sFilter} $PROCEDURE {TWindow.}FilterAndDo{(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.FilterDispatch(actualObj, NIL, DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sFilter} $PROCEDURE {TWindow.}FilterDispatch{(actualObj: TObject; image: TImage; HPROCEDURE DoToObject(filteredObj: TObject))}; $VAR filterCommand: TCommand; (filtering: BOOLEAN; (cmdWindow: TWindow; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (cmdWindow := SELF; (IF currentWindow <> NIL THEN ,IF SELF = currentWindow.dialogBox THEN 0cmdWindow := currentWindow; (filterCommand := cmdWindow.lastCmd; (filtering := FALSE; (IF filterCommand <> NIL THEN ,IF filterCommand.doing THEN 0IF filterCommand.image <> NIL THEN 4filtering := filterCommand.image.SeesSameAs(image); (IF filtering THEN ,IF actualObj <> NIL THEN 0filterCommand.FilterAndDo(actualObj, DoToObject) ,ELSE 0filterCommand.EachVirtualPart(DoToObject) (ELSE (IF actualObj <> NIL THEN ,DoToObject(actualObj) (ELSE (IF image <> NIL THEN ,image.EachActualPart(DoToObject) (ELSE ,SELF.EachActualPart(DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; {$S sStartup} $PROCEDURE {TWindow.}Focus; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (SetPort(POINTER(SELF.wmgrID)); (SetOrigin(0, 0); (ClipRect(thePort^.portRect); (IF useAltVisRgn THEN ,focusRgn := altVisRgn {Instigated by TWindow.StashPicture or TClipboard.Publicize} (ELSE ,focusRgn := thePort^.visRgn; (focusArea := SELF; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$S sStartup} $PROCEDURE {TWindow.}Frame; (VAR growRect: Rect; $BEGIN ({$IFC fTrace}BP(6);{$ENDC} (IF SELF.isResizable THEN ,BEGIN ,GetGrowRect(growRect); ,IF RectIsVisible(growRect) THEN 0IF SELF.IsActive THEN 4PaintGrow 0ELSE 4FillRect(growRect, white); ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} ${$S sCldInit} $PROCEDURE {TWindow.}GetPrinterMetrics; )VAR prPrfAlias: TPrPrfAlias; .prInfo: TPrInfo; .tkDevice: INTEGER; .document: TDocManager; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF currentDocument <> NIL THEN ,document := currentDocument (ELSE ,document := boundDocument; (IF document = clipboard THEN ,prPrfAlias.reserve := clipPrintPref (ELSE ,prPrfAlias.reserve := document.dataSegment.preludePtr^.printPref; {$IFC libraryVersion <= 20} { P E P S I } (PrMetrics(prPrfAlias.prPrf, prInfo); {$ELSEC} { S P R I N G } (prInfo := prPrfAlias.prPrf.prInfo; {this looks odd, but the prPrf is of type prRec really} {$ENDC} (WITH SELF.printerMetrics, prInfo DO ,BEGIN ,printRect := rPrintable; ,paperRect := rPaper; ,END; (SELF.printerMetrics.res.h := prInfo.hRes; (SELF.printerMetrics.res.v := prInfo.vRes; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sStartup} $PROCEDURE {TWindow.}GetMinExtent{(VAR minExtent: Point; windowIsResizingIt: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (SELF.panelTree.GetMinExtent(minExtent, windowIsResizingIt); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sRes} $PROCEDURE {TWindow.}GetTitle{(VAR title: S255)}; (VAR kludge: Str255; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (GetFldrTitle(POINTER(SELF.wmgrID), kludge); (title := kludge; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $PROCEDURE {TWindow.}Highlight{(highTransit: THighTransit)}; (PROCEDURE HilitePanel(obj: TObject); (BEGIN ,TPanel(obj).Highlight(TPanel(obj).selection, highTransit); (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.panels.Each(HilitePanel); ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} ${$S sRes} $PROCEDURE {TWindow.}IdleBegin{(centiSeconds: LONGINT)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (LetOthersRun; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TWindow.}IdleContinue{(centiSeconds: LONGINT)}; $BEGIN ({$IFC fTrace}BP(5);{$ENDC} (IF SELF.IsActive THEN ,process.TrackCursor; (LetOthersRun; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sRes} $PROCEDURE {TWindow.}IdleEnd{(centiSeconds: LONGINT)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $FUNCTION {TWindow.}IsActive{: BOOLEAN}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (IF activeWindowID = 0 THEN {nothing is active} ,IsActive := FALSE (ELSE IF currentWindow = NIL THEN ,BEGIN ,IsActive := FALSE; ,{$IFC fDbgABC} ,Writeln(CHR(7), '********************'); ,Writeln('In TWindow.IsActive, activeWindowID <> 0 AND currentWindow = NIL'); ,Writeln('activeWindowID=', activeWindowID:1, ' currentWindow=', ORD(currentWindow):1); ,Writeln('********************'); ,{$ENDC} ,END (ELSE ,IsActive := (SELF.wmgrID = activeWindowID) OR (SELF.wmgrID = ORD(dialogFolder)); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sStartup} $FUNCTION {TWindow.}IsVisible{: BOOLEAN}; (VAR info: WindowInfo; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (GetWindInfo(WindowPtr(SELF.wmgrID), info); (IsVisible := info.visible; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sStartup} $PROCEDURE {TWindow.}LoadMenuBar; (VAR i: INTEGER; ,menuID: INTEGER; ,inClipboard: BOOLEAN; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (inClipboard := activeWindowID = ORD(scrapFolder); (FOR i := 1 TO menuBar.numMenus DO ,BEGIN ,menuID := wmgrMenus[i].menuID; ,IF SELF.WantMenu(menuID, inClipboard) THEN 0menuBar.Insert(menuID, 0); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sRes} $PROCEDURE {TWindow.}MenuEventAt{(mousePt: Point)}; (VAR cmdNumber: TCmdNumber; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.SetupMenus; (cmdNumber := menuBar.DownAt(mousePt); (IF SELF.selectPanel = NIL THEN ,{$IFC fDbgABC} ABCBreak('ObeyTheEvent: selectPanel=NIL', 0) {$ENDC} (ELSE ,SELF.DoCommand(cmdNumber); ({$IFC fTrace}EP;{$ENDC} $END; {$IFC LibraryVersion > 20} {$S SgABCcld} $PROCEDURE {TWindow.}NameToPrefix(VAR error, offset: INTEGER; VAR name, prefix: TFilePath); $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (NameToPrefix(error, offset, WindowPtr(SELF.wmgrID), Pathname(name), Pathname(prefix)); ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$ENDC} ${$S sCommand} $FUNCTION {TWindow.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (NewCommand := currentWindow.NewStdCommand(cmdNumber); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $FUNCTION {TWindow.}NewStdCommand{(cmdNumber: TCmdNumber): TCommand}; $VAR document: TDocManager; (didStyleChange: BOOLEAN; {$IFC LibraryVersion <= 20} (prPrf: TPrPrf; {$ENDC} (prPrfAlias: TprPrfAlias; (shouldPrint: BOOLEAN; (error: INTEGER; (str: S255; (permCmd: BOOLEAN; { TRUE iff the command is a permanent one } (command: TCommand; (s: TListScanner; (panel: TPanel; (zoomNum: Point; (zoomDen: Point; (selectPanel: TPanel; (clickPanel: TPanel; (selection: TSelection; (vhs: VHSelect; (andContinue: BOOLEAN; (excessBytes: INTEGER; (printManager: TPrintManager; (panelToUse: TPanel; (FUNCTION RevertConfirmed: BOOLEAN; ,VAR s: TParamAlert; 0ph: INTEGER; {$IFC LibraryVersion <= 20} 0info: fs_info; {$ELSEC} 0info: Q_Info; {$ENDC} 0osErr: INTEGER; 0pPath: ^Pathname; 0osDT: LONGINT; (BEGIN ,RevertConfirmed := FALSE; ,IF SELF.changes = 0 THEN 0process.Note(phUnchanged) ,ELSE 0BEGIN 0IF document.files.saveExists THEN 4BEGIN 4pPath := @document.files.volumePrefix; {$IFC LibraryVersion <= 20} 4Lookup(osErr, pPath^, info); {$ELSEC} 4Quick_Lookup(osErr, pPath^, info); {$ENDC} 4IF osErr <= 0 THEN 8osDT := info.DTM 4ELSE 8osDT := -1; 4{$IFC LibraryVersion < 13} 4DTAlert(osDT, s); 4{$ELSEC} 4DTAlert(alerts, osDT, s); 4{$ENDC} 4process.ArgAlert(1, s); 4ph := phRevert; 4END 0ELSE 4ph := phRevBlank; 0IF process.Caution(ph) THEN 4RevertConfirmed := TRUE; 0END; (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (document := currentDocument; ({$IFC fDbgABC} (IF SELF.wmgrID <> document.window.wmgrID THEN ,ABCbreak('In TWindow.NewStdCommand: SELF.wmgrID <> document.window.wmgrID; document=', 8ORD(document)); ({$ENDC} (selectPanel := SELF.selectPanel; (clickPanel := SELF.clickPanel; (selection := selectPanel.selection; (IF selectPanel.view.isPrintable THEN ,panelToUse := selectPanel (ELSE ,panelToUse := SELF.panelToPrint; (error := 0; (NewStdCommand := NIL; {the default return value} (permCmd := FALSE; {if set to TRUE, make a permanent command object} (allowAbort := TRUE; {??? should we assume this ???} (CASE cmdNumber OF +{File/Print Menu} ,uSetAllAside: 0BEGIN 0SELF.CommitLast; 0DoFilingCmd(cmdClosAll); 0permCmd := TRUE; 0END; ,uSetAside, uSetClipAside: 0BEGIN 0SELF.CommitLast; 0DoFilingCmd(cmdClose); 0permCmd := TRUE; 0END; ,uPutAway, uSaveVersion: {must be the active window to do this} 0BEGIN 0andContinue := cmdNumber = uSaveVersion; 0SELF.CommitLast; 0IF andContinue THEN 4excessBytes := docExcess 0ELSE 4excessBytes := 0; 0document.ConserveMemory(excessBytes, TRUE {do GC}); 0IF (document.window.changes <> 0) AND 3(document.files.shouldToolSave OR NOT document.openedAsTool) THEN 4BEGIN 4process.BeginWait(phSaving); 4document.SaveVersion(error, document.files.volumePrefix, andContinue); 4process.EndWait; 4END 0ELSE IF andContinue THEN 4process.Note(phUnchanged); 0{shouldn't we put up a message on Save & Put Away even if document is unchanged???} 0IF (error <= 0) AND NOT andContinue THEN {*** some cases worse! ***} 4BEGIN 4TellFiler(error, docClosd, docPutBack, POINTER(activeWindowID)); 4IF error > 0 THEN 8BEGIN 8ABCBreak('TellFiler', error); 8error := 0; 8END; 4closedDocument := document; 4closedBySuspend := FALSE; 4END; 0{do something if there was an error} 0IF error = erAborted THEN 4process.Stop(phTerminated) 0ELSE IF error > 0 THEN 4process.Stop(phCantSave); 0error := 0; {we already put up the alert} 0permCmd := TRUE; 0END; ,uRevertVersion: 0IF RevertConfirmed THEN 4BEGIN 4document.RevertVersion(error, activeWindowID); 4{do something if there was an error} 4IF error = erAborted THEN 8process.Stop(phTerminated) 4ELSE IF error > 0 THEN 8BEGIN 8process.Stop(phCantRevert); 8process.Complete(FALSE); {nothing else to do: we unbound out data segments} 8END; 4error := 0; {we already put up the alert} 4permCmd := TRUE; {no need to CommitLast} 4END; {long-standing commented-out code now out} ,uPrFmt: 0BEGIN 0IF document = clipboard THEN 4prPrfAlias.reserve := clipPrintPref 0ELSE 4prPrfAlias.reserve := document.dataSegment.preludePtr^.printPref; 0PushFocus; {$IFC libraryVersion <= 20} { P E P S I } 0PrPrfDlg(error, prPrfAlias.prPrf, didStyleChange); {$ELSEC} { S P R I N G } 0PrPrfDlg(prPrfAlias.prPrf, didStyleChange, NOT SELF.pgSzOK); {$ENDC} 0PopFocus; 0IF didStyleChange THEN 4BEGIN 4SELF.AcceptNewPrintingInfo(document, prPrfAlias.reserve); 4permCmd := TRUE; 4END; 0END; ,uPrint: 0SELF.Print(panelToUse, NOT SELF.pgRgOK, FALSE {put up dialog} ); ,uPrintAsIs: 0SELF.Print(panelToUse, TRUE {suppress page range}, TRUE {suppress dialog}); ,uPrMonitor: 0BEGIN 0PushFocus; {$IFC libraryVersion <= 20} { P E P S I } 0PrBgdDlg(error, TRUE); {$ELSEC} { S P R I N G } 0PrBgdDlg; {$ENDC} 0PopFocus; 0END; +{Zooming & previewing pages} {some or all of these must become command objects} ,uPrvwMargins: 0panelToUse.Preview(mPrvwMargins); ,uPrvwBreaks: 0panelToUse.Preview(mPrvwBreaks); ,uPrvwOff: 0panelToUse.Preview(mPrvwOff); ,uDesignPages: 0BEGIN 0printManager := panelToUse.view.printManager; 0IF printManager <> NIL THEN 4printManager.EnterPageEdit; 0END; ,uRiseVertically, 0uRiseHorizontally: 4BEGIN 4IF cmdNumber = uRiseVertically THEN 8panelToUse.view.printManager.pageRiseDirection := v 4ELSE 8panelToUse.view.printManager.pageRiseDirection := h; 4IF panelToUse.previewMode = mPrvwMargins THEN 8panelToUse.Invalidate; 4END; ,uAddColumnStrip, 0uAddRowStrip: 4BEGIN 4IF cmdNumber = uAddColumnStrip THEN 8vhs := v 4ELSE 8vhs := h; 4panelToUse.currentView.AddStripOfPages(vhs); 4END; ,uShowFullSize: 0BEGIN 0SetPt(zoomNum, 1, 1); 0selectPanel.SetZoomFactor(zoomNum, zoomNum); {++ should this be panelToUse?? ++} 0selectPanel.Invalidate; 0END; ,uReduce70Pct: 0BEGIN 0WITH selectPanel.zoomFactor DO 4IF numerator.h = 1 THEN 8BEGIN  clipboard THEN 4BEGIN 4MarkHeap(document.docHeap, ORD(document.dataSegment.preludePtr^.docDirectory)); 4SweepHeap(document.docHeap, cmdNumber = uReptGarbage); 4END; ,uMainScramble: 0THz(mainHeap)^.fScramble := NOT THz(mainHeap)^.fScramble; ,uDocScramble: 0IF currentDocument <> NIL THEN 4THz(currentDocument.docHeap)^.fScramble := 8NOT THz(currentDocument.docHeap)^.fScramble; ,{$ENDC} ,OTHERWISE 0BEGIN 0IF menuBar.GetCmdName(cmdNumber, @str) THEN 4process.ArgAlert(1, str) 0ELSE 4BEGIN 4{$IFC fDbgABC} 4ABCbreak('called new command, but no command in menu', cmdNumber); 4{$ENDC} 4process.ArgAlert(1, 'Unknown Command'); 4END; 0IF selection.kind = nothingKind THEN 4process.Stop(phNoSel) 0ELSE 4process.Stop(phUnkCmd); 0END; ,END; (IF permCmd THEN ,BEGIN ,command := TCommand.CREATE(NIL, SELF.Heap, cmdNumber, NIL, FALSE, revealNone); ,WITH command DO 0BEGIN 0unHiliteBefore[doPhase] := FALSE; 0hiliteAfter[doPhase] := FALSE; 0END; ,NewStdCommand := command; ,END; (IF error > 0 THEN ,process.Stop(process.Phrase(error)); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sCommand} $PROCEDURE {TWindow.}PerformCommand{(newCommand: TCommand)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF newCommand <> NIL THEN {this is a command that changes the document} ,BEGIN ,{commit the previous command} ,SELF.CommitLast; ,{save the new command & get rid of the old one} ,SELF.SaveCommand(newCommand); ,{execute the new command} ,SELF.PerformLast(doPhase); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sCommand} $PROCEDURE {TWindow.}PerformLast{(cmdPhase: TCmdPhase)}; {+SW+} {LSR: Your version below, commented out} $VAR image: TImage; (lastCmd: TCommand; (lastWindow: TWindow; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF <> currentWindow THEN ,currentWindow.PerformLast(cmdPhase) (ELSE ,BEGIN ,lastCmd := SELF.lastCmd; ,image := lastCmd.image; ,IF image = NIL THEN 0lastWindow := SELF ,ELSE 0lastWindow := image.view.panel.window; {+SW+} ,{UnHighlight all selections before performing the command (unless command object says otherwise)} ,IF lastCmd.unHiliteBefore[cmdPhase] THEN 0currentWindow.selectWindow.Highlight(hOnToOff); {+sw+} ,IF cmdPhase <> doPhase THEN 0lastWindow.RestoreSelection;{+sw+} ,IF lastCmd.revelation <> revealNone THEN 0lastWindow.RevealSelection(lastCmd.revelation = revealAll, KNOT lastCmd.unHiliteBefore[cmdPhase]); ,lastWindow.selectPanel.selection.PerformCommand(lastCmd, cmdPhase); {+sw+} ,{Save selection in each panel; hilite if necessary} ,SELF.SaveSelection; ,IF NOT deferUpdate THEN 0IF lastCmd.HiliteAfter[cmdPhase] THEN 4BEGIN 4lastWindow.Update(FALSE);{+sw+} 4lastWindow.Highlight(hOffToOn);{+sw+} 4END 0ELSE 4lastWindow.Update(TRUE);{+sw+} ,END; ({$IFC fTrace}EP;{$ENDC} $END; (* PROCEDURE {TWindow.}PerformLast{(cmdPhase: TCmdPhase)}; $VAR lastCmd: TCommand; (PROCEDURE PerformIt; ,BEGIN ,{UnHighlight all selections before performing the command (unless command object says otherwise)} ,IF lastCmd.unHiliteBefore[cmdPhase] THEN 0SELF.Highlight(hOnToOff); ,IF cmdPhase <> doPhase THEN 0SELF.RestoreSelection; ,IF lastCmd.revelation <> revealNone THEN 0SELF.RevealSelection(lastCmd.revelation = revealAll, NOT lastCmd.unHiliteBefore[cmdPhase]); ,lastCmd.doing := cmdPhase <> undoPhase; ,lastCmd.Perform(cmdPhase); ,{Save selection in each panel; hilite if necessary} ,SELF.SaveSelection; ,IF lastCmd.HiliteAfter[cmdPhase] THEN 0BEGIN 0SELF.Update(FALSE); 0SELF.Highlight(hOffToOn); 0END ,ELSE 0SELF.Update(TRUE); (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF <> currentWindow THEN ,currentWindow.PerformLast(cmdPhase) (ELSE ,BEGIN ,lastCmd := SELF.lastCmd; ,PerformIt; ,END; ({$IFC fTrace}EP;{$ENDC} $END; *) ${$S sStartup} $PROCEDURE {TWindow.}PickStdCursor; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SetStdCursor(arrowCursor); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} {$IFC LibraryVersion > 20} {$S SgABCcld} $PROCEDURE {TWindow.}PrefixToName(VAR error, offset: INTEGER; VAR prefix, name: TFilePath); $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (PrefixToName(error, offset, WindowPtr(SELF.wmgrID), Pathname(prefix), Pathname(name)); ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} {$ENDC} ${$S SgABCpri} $PROCEDURE {TWindow.}Print{(panel: TPanel; nixPgRange: BOOLEAN; nixWholeDialog: BOOLEAN)}; $VAR prPrfAlias: TPrPrfAlias; (indeedPrint: BOOLEAN; (isNewStyle: BOOLEAN; (document: TDocManager; {$IFC libraryVersion <= 20} { P E P S I } (error: INTEGER; (prIns: TPrIns; {$ELSEC} { S P R I N G } (prIns: TPrRec; (prMode: PrMenuSuppress; {$ENDC} $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF currentDocument <> NIL THEN ,document := currentDocument (ELSE ,document := boundDocument; (IF document = clipboard THEN ,prPrfAlias.reserve := clipPrintPref (ELSE ,prPrfAlias.reserve := document.dataSegment.preludePtr^.PrintPref; (PushFocus; {$IFC libraryVersion <= 20} { P E P S I } (indeedPrint := FPrInsDlg(error, prPrfAlias.prPrf, prPrfAlias.prIns, isNewStyle); {$ELSEC} { S P R I N G } (IF nixWholeDialog THEN ,prMode := ePrDialogSuppress (ELSE (IF nixPgRange THEN ,prMode := ePgRangeSuppress (ELSE ,prMode := ePrNormal; (indeedPrint := FPrInsDlg(prPrfAlias.prPrf, isNewStyle, prMode); {$ENDC} (PopFocus; {$IFC libraryVersion <= 20} { P E P S I } (IF error > 0 THEN ,process.Stop(phUnknown) {PrMgr passed on an OS error} (ELSE {$ENDC} ,BEGIN ,IF isNewStyle THEN {style changed during print-instance dialog} 0SELF.AcceptNewPrinterInfo(document, prPrfAlias.reserve); ,IF indeedPrint THEN 0BEGIN 0amPrinting := TRUE; 0PushFocus; 0panel.PrintView(prPrfAlias.reserve); 0amPrinting := FALSE; 0PopFocus; 0SELF.Update(TRUE); {clear out white area from RECORDING box} {$IFC libraryVersion <= 20} { P E P S I } 0PrBgdDlg(error, FALSE); {put up background dialog} {$ENDC} {NB: For Spring, user-interface says we go back to the app, not to the background dialog} 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $PROCEDURE {TWindow.}PutUpDialogBox{(dialogBox: TDialogBox)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.CommitLast; (SELF.dialogBox := dialogBox; (* IF dialogBox.selectWindow <> NIL THEN ,SELF.selectWindow := dialogBox.selectWindow; *) {+SW+} (dialogBox.Appear; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} {$S sStartup} $PROCEDURE {TWindow.}Refresh{(rActions: TActions; highTransit: THighTransit)}; (PROCEDURE RefreshPanel(obj: TObject); ,VAR panel: TPanel; (BEGIN ,panel := TPanel(obj); ,IF RectIsVisible(panel.outerRect) THEN 0panel.Refresh(rActions, highTransit); (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF = clipboard.window THEN ,highTransit := hNone; ({$IFC fDbgABC} (IF (rBackground IN rActions) AND (highTransit > hOffToOn) THEN ,ABCBreak('Refresh: rBackground requested, but highTransit does not start from Off', 0); ({$ENDC} (IF rFrame IN rActions THEN ,SELF.Frame; (SELF.panels.Each(RefreshPanel); ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} ${$S sStartup} $PROCEDURE {TWindow.}Resize{(moving: BOOLEAN)}; ,{Make the Tool Kit data structures agree with the window manager's idea of the window size; 0also, ensure that bottom right corner of window is on the screen} (VAR oldOuterRect: Rect; ,myGrafPort: GrafPtr; ,newScreenRect: Rect; ,proposedSize: Point; ,minExtent: Point; ,newOuterRect: Rect; ,currentlyVisible: BOOLEAN; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (PushFocus; (SELF.Focus; (currentlyVisible := SELF.IsVisible; (myGrafPort:= POINTER(SELF.wmgrID); (IF currentlyVisible THEN ,BEGIN ,{ Find out where the window is on the screen } ,newScreenRect := myGrafPort^.portRect; ,proposedSize := Point(FDiagRect(newScreenRect)); ,IF NOT SELF.believeWmgr THEN 0WITH SELF DO 4BEGIN 4maxInnerSize := proposedSize; 4believeWmgr := TRUE; 4END; ,IF moving THEN { Constrain it to the maximum explicitly set by the user } 0BEGIN 0LocalToGlobal(newScreenRect.topLeft); 0{ Propose the window botRight be at the screen botRight } 0proposedSize := Point(FPtMinPt(Point(FPtMinusPt(screenBits.bounds.botRight, `newScreenRect.topLeft)), OSELF.maxInnerSize)); 0END; ,END (ELSE ,proposedSize := Point(FDiagRect(SELF.innerRect)); ({ But be sure it is at least the minimum size } (SELF.GetMinExtent(minExtent, TRUE); (proposedSize := Point(FPtMaxPt(proposedSize, minExtent)); (IF NOT moving THEN ,SELF.maxInnerSize := proposedSize; (oldOuterRect := SELF.outerRect; (SetRect(newScreenRect, 0, 0, proposedSize.h, proposedSize.v); (IF currentlyVisible THEN ,{ finally set the wmgr window ("folder") size. } ,FolderSize(myGrafPort, proposedSize.h, proposedSize.v, FALSE); ({ Reset our idea of window's size } (SELF.SetInnerRect(newScreenRect); (ClipRect(SELF.innerRect); (focusRgn := thePort^.visRgn; (newOuterRect := SELF.outerRect; (IF NOT EqualPt(oldOuterRect.botRight, newOuterRect.botRight) THEN ,SELF.panelTree.ResizeOutside(newOuterRect); (PopFocus; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $PROCEDURE {TWindow.}ResizeTo{(newSize: Point)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF NOT EqualPt(Point(FDiagRect(SELF.innerRect)), newSize) THEN ,BEGIN ,FolderSize(POINTER(SELF.wmgrID), newSize.h, newSize.v, FALSE); ,SELF.Resize(FALSE); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sRes} $PROCEDURE {TWindow.}RestoreSelection; (PROCEDURE RestoreSel(obj: TObject); (BEGIN ,TPanel(obj).undoSelection.Restore; {$} (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.selectPanel := SELF.undoSelPanel; (SELF.clickPanel := SELF.undoClickPanel; (SELF.selectWindow := SELF.undoSelWindow; {+SW+} (SELF.panels.Each(RestoreSel); (IF SELF.dialogBox <> NIL THEN ,SELF.dialogBox.RestoreSelection; ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $PROCEDURE {TWindow.}RevealSelection(asMuchAsPossible, doHilite: BOOLEAN); (PROCEDURE RevlSel(obj: TObject); (BEGIN ,TPanel(obj).selection.Reveal(asMuchAsPossible); (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.Update(doHilite); (SELF.panels.Each(RevlSel); (SELF.Update(doHilite); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $PROCEDURE {TWindow.}SaveCommand{(command: TCommand)}; (PROCEDURE SaveUndoSelection(obj: TObject); ,VAR panel: TPanel; 0sel: TSelection; (BEGIN ,panel := TPanel(obj); ,sel := panel.undoSelection.FreedAndReplacedBy(TSelection(panel.selection.Clone(SELF.Heap))); (END; $BEGIN {Called by PerformCommand between NewCommand & PerformLast to establish an undo-point} ({$IFC fTrace}BP(7);{$ENDC} (IF SELF <> currentWindow THEN ,currentWindow.SaveCommand(command) {probably this is a dialog box} (ELSE (IF SELF.lastCmd <> NIL THEN ,SELF.lastCmd.Become(command) (ELSE ,SELF.lastCmd := command; (SELF.panels.Each(SaveUndoSelection); ({$IFC fTrace}EP;{$ENDC} $END; ${$S sCommand} $PROCEDURE {TWindow.}SaveSelection; (PROCEDURE SaveSel(obj: TObject); (BEGIN ,TPanel(obj).selection.Save; (END; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.panels.Each(SaveSel); (SELF.undoSelPanel := SELF.selectPanel; (SELF.undoClickPanel := SELF.clickPanel; (SELF.undoSelWindow := SELF.selectWindow; {+SW+} (IF SELF.dialogBox <> NIL THEN ,SELF.dialogBox.SaveSelection; ({$IFC fTrace}EP;{$ENDC} $END; {$} ${$S sCommand} $PROCEDURE {TWindow.}SetupMenus; (VAR anS255: S255; ,undoTempl: TCmdNumber; ,mapHandle: TMapHandle; ,selection: TSelection; ,i: INTEGER; ,wmgrCmd: TWmgrCmd; ,checkIt: BOOLEAN; ,mainWindow: TWindow; $BEGIN {NOTE: wmgrMenus[menuIndex] can not be assigned to a local variable because it is passed as a VAR} ({$IFC fTrace}BP(5);{$ENDC} (mainWindow := currentWindow; ({First, change the text of the Set Aside and Undo items.} (mainWindow.GetTitle(anS255); {don't use SELF because we might be a dialog box} (anS255 := CONCAT('"', anS255, '"'); (menuBar.BuildCmdName(uSetAside, utSetAside, @anS255); (menuBar.BuildCmdName(uSetClipAside, utSetAside, @anS255); (IF mainWindow.lastCmd = NIL THEN {the mainWindow always has the last command} ,menuBar.BuildCmdName(uUndoLast, utUndoLast, NIL) (ELSE ,BEGIN ,IF mainWindow.lastCmd.doing THEN 0undoTempl := utUndoLast ,ELSE 0undoTempl := utRedoLast; ,IF menuBar.GetCmdName(mainWindow.lastCmd.cmdNumber, @anS255) THEN 0BEGIN 0anS255 := CONCAT('"', anS255, '"'); 0menuBar.BuildCmdName(uUndoLast, undoTempl, @anS255); 0END ,ELSE 0menuBar.BuildCmdName(uUndoLast, undoTempl, NIL); ,END; ({Then enable and check the appropriate items} (mapHandle := TMapHandle(menuBar.mapping); (selection := SELF.selectPanel.selection; (FOR i := 1 TO menuBar.numCommands DO ,BEGIN ,wmgrCmd := mapHandle^^.table[i]; ,WITH wmgrCmd DO 0IF menuBar.isLoaded[menuIndex] THEN 4BEGIN 4checkIt := FALSE; 4(********** 4IF selection.CanDoCommand(cmdNumber, checkIt) THEN 8EnableItem(wmgrMenus[menuIndex], itemIndex) 4ELSE 8DisableItem(wmgrMenus[menuIndex], itemIndex); 4**********) 3{The following line is an optimization for the preceding} 4wmgrMenus[menuIndex].enableFlags[itemIndex] := 8selection.CanDoCommand(cmdNumber, checkit); 4CheckItem(wmgrMenus[menuIndex], itemIndex, checkIt); 4END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCini} $PROCEDURE {TWindow.}SetWmgrId{(itsWmgrId: TWindowID)}; $VAR panelScanner: TListScanner; (panel: TPanel; (paneScanner: TListScanner; (pane: TPane; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (SELF.wmgrId := itsWmgrId; (panelScanner := SELF.panels.Scanner; (WHILE panelScanner.Scan(panel) DO ,BEGIN ,paneScanner := panel.panes.Scanner; ,WHILE paneScanner.Scan(pane) DO 0pane.port := POINTER(itsWmgrId); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $PROCEDURE {TWindow.}StashPicture{(highTransit: THighTransit)}; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (RectRgn(altVisRgn, SELF.outerRect); (useAltVisRgn := TRUE; {Make TPad.Focus use altVisRgn instead of visRgn} (PushFocus; (SELF.Focus; (WMOpenPicture(POINTER(SELF.wmgrID)); (SELF.Refresh([rErase, rFrame, rBackground, rDraw], highTransit); {recorded & not displayed} (WMClosePicture; (useAltVisRgn := FALSE; (PopFocus; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $PROCEDURE {TWindow.}TakeDownDialogBox; {+sw+} (VAR dialogBox: TDialogBox; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({Don't CommitLast here, because the Dialog Box may have created a command that can be undone later} (dialogBox := SELF.dialogBox; (IF dialogBox <> NIL THEN ,BEGIN ,IF SELF.lastCmd <> NIL THEN 0IF SELF.lastCmd.image <> NIL THEN 4IF SELF.lastCmd.image.view.panel.window = dialogBox THEN 8SELF.CommitLast; {+sw+} ,dialogBox.Disappear; ,IF dialogBox.freeOnDismissal THEN 0SELF.objectToFree := dialogBox; {+SW+} {will be freed at end of event loop} ,SELF.dialogBox := NIL; ,SELF.selectWindow := SELF; ,END (ELSE ,ABCBreak('TakeDownDialogBox, but none up', 0); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDbgABC} ${$S SgABCdbg} $PROCEDURE {TWindow.}ToggleFlag{(VAR flag: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(1);{$ENDC} (flag := NOT flag; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$ENDC} ${$S SgABCcld} $PROCEDURE {TWindow.}UndoLast; $VAR lastCmd: TCommand; (str: S255; (cmdPhase: TCmdPhase; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF SELF <> currentWindow THEN ,currentWindow.UndoLast (ELSE ,BEGIN ,lastCmd := SELF.lastCmd; ,IF lastCmd = NIL THEN 0process.Stop(phNoCommand) ,ELSE ,IF NOT lastCmd.undoable THEN 0BEGIN 0IF NOT menuBar.GetCmdName(lastCmd.cmdNumber, @str) THEN 4BEGIN 4{$IFC fDbgABC} ABCbreak('TCommand.cmdNumber not in menu', lastCmd.cmdNumber); {$ENDC} 4str := 'Last Command'; 4END; 0process.ArgAlert(1, str); 0process.Stop(phCantUndo); 0END ,ELSE ,IF lastCmd.doing THEN 0SELF.PerformLast(undoPhase) ,ELSE 0SELF.PerformLast(redoPhase); ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S sStartup} $PROCEDURE {TWindow.}Update{(doHilite: BOOLEAN)}; (VAR pWindow: WindowPtr; ,updateRgn: RgnHandle; ,highTransit: THighTransit; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (PushFocus; (SELF.Focus; (pWindow := POINTER(SELF.wmgrID); (BeginUpdate(pWindow); (updateRgn := pWindow^.visRgn; (IF NOT EmptyRgn(updateRgn) THEN ,BEGIN ,IF doHilite THEN 0highTransit := highLevel[SELF.isActive] ,ELSE 0highTransit := hNone; ,FillRgn(updateRgn, white); ,SELF.Refresh([rFrame, rBackground, rDraw], highTransit); ,END; (EndUpdate(pWindow); (PopFocus; ({$IFC fTrace}EP;{$ENDC} $END; {$S SgABCres} ${$S sStartup} $FUNCTION {TWindow.}WantMenu{(menuID: INTEGER; inClipboard: BOOLEAN): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (IF inClipboard THEN ,WantMenu := menuID = mnuClipFilePrint (ELSE ,WantMenu := (menuID < mBuzzword); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} {$S SgABCini} END; {$S SgABCres} METHODS OF TDialogBox; ${$S SgABCcld} $FUNCTION {TDialogBox.}CREATE{(object: TObject; heap: THeap; itsResizability: BOOLEAN; itsHeight: INTEGER; CitsKeyResponse, itsMenuResponse, CitsDownInMainWindowResponse: TDiResponse): TDialogBox}; (VAR diBxRect: Rect; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TDialogBox(TWindow.CREATE(object, heap, ORD(dialogFolder), itsResizability)); (WITH SELF DO ,BEGIN ,keyResponse := itsKeyResponse; ,menuResponse := itsMenuResponse; ,downInMainWindowResponse := itsDownInMainWindowResponse; ,freeOnDismissal := FALSE; {+SW+} ,END; (SELF.GetPrinterMetrics; {mostly just so that these won't be total garbage in debug output} (SetRect(diBxRect, 0, 0, screenBits.bounds.right, itsHeight); (SELF.SetInnerRect(diBxRect); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$IFC fDebugMethods} ${$S SgABCdbg} $PROCEDURE {TDialogBox.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TWindow.Fields(Field); (Field('keyResponse: Byte'); (Field('menuResponse: Byte'); (Field('downInMainWindowResponse: Byte'); (Field('freeOnDismissal: BOOLEAN'); {+SW+} (Field(''); $END; ${$S SgABCres} ${$ENDC} ${$S SgABCcld} $PROCEDURE {TDialogBox.}Appear; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (DialogHeight(LengthRect(SELF.innerRect, v), TRUE); (SELF.outerRect.bottom := SELF.outerRect.top; {force Resize to recalculate everything} (SELF.Resize(FALSE); ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TDialogBox.}BeDismissed; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (currentWindow.TakeDownDialogBox; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TDialogBox.}Disappear; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (DialogHeight(0, FALSE); (SELF.believeWmgr := FALSE; {the window's innerRect is known to NOT match the size of the dialog box} ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCcld} $PROCEDURE {TDialogBox.}GetMinExtent{(VAR minExtent: Point; windowIsResizingIt: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (SUPERSELF.GetMinExtent(minExtent, windowIsResizingIt); (minExtent.h := screenBits.bounds.right; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} ${$S SgABCcld} $FUNCTION {TDialogBox.}IsVisible{: BOOLEAN}; (VAR info: WindowInfo; $BEGIN ({$IFC fTrace}BP(3);{$ENDC} (IF SUPERSELF.IsVisible THEN ,IsVisible := currentWindow.dialogBox = SELF (ELSE ,IsVisible := FALSE; ({$IFC fTrace}EP;{$ENDC} $END; ${$S SgABCres} {$S SgABCini} END; {$S SgABCres} {SUBROUTINES OF TMenuBar} ${$S sRes} PROCEDURE InAllMenusDo{(iffLoaded: BOOLEAN; theCommand: TCmdNumber; 8PROCEDURE doProc(VAR menu: MenuInfo; itemIndex: INTEGER))}; $VAR i: INTEGER; (lowIDX: INTEGER; (highIDX: INTEGER; (mapHandle: TMapHandle; (fFound: BOOLEAN; BEGIN $fFound := FALSE; $mapHandle := TMapHandle(menuBar.mapping); $lowIDX := 1; $highIDX := menuBar.numCommands; $WHILE NOT fFound AND (lowIdx <= highIdx) DO (BEGIN (i := (lowIDX+highIDX) DIV 2; $$$$$$$$$$ $ $ $ $ $$$$$$$$$$$$$ O 9999  e f g h i j k l m n o p q r s t  u! v" w!NOMPNQORPSQTRUSVT WU XV YW ZX [Y\Z][^\_]`^a_b`cadbecfdgehfigjhkiljmk nl!om"pn#qo$rp%sq&tr'us(vt)wu*xv+yw,zx-{y.|z/}{0~|1}2~3456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~     O       !" #!$"%#&$'%(&)'*(+),*-+.,/- 0.!1/"20#31$42%53&64'75(86)97*:8+;9,<:-=;.></?=0@>1A?2B@3CA4DB5EC6FD7GE8HF9IG:JH;KINL?OM@PNAQOBRPCSQDTREUSFVTGWUHXVIYWJZXK[YL\ZM][N^\O_]P`^Qa_Rb`ScaTdbUecVfdWehigjhkiljmknlompn qo rp sq tr usvtwuxvywzx{y|z}{~|}~ !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~               ! " #! $" %# &$ '% (& )' *( +) ,* -+ ., /- 0. 1/ 20 31 42 53 64 75 86 97 :8 ;9 <: =; >< !?= "@> #A? $B@ %CA &DB 'EC (FD )GE *HF +IG ,JH -KI .LJ /MK 0NL 1OM 2PN 3QO 4RP 5SQ 6TR 7US 8VT 9WU :XV ;YW \Z ?][ @^\ A_] B`^ Ca_ Db` Eca Fdb Gec Hfd Ige Jhf Kig Ljh Mki Nlj Omk Pnl Qom Rpn Sqo Trp Usq Vtr Wus Xvt Ywu Zxv [yw \zx ]{y ^|z _}{ `~| a} b~ c d e f g h i j k l m n o p q r s t u v w x y z { | } ~                                     ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d