home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-10-25 | 50.0 KB | 1,853 lines | [TEXT/MPS ] |
- {$P}
- {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
- { UTEView.TTEView.p }
- { Copyright © 1984-1990 Apple Computer Inc. All rights reserved. }
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEOpen}
-
- PROCEDURE TTEView.ITEView(itsDocument: TDocument;
- itsSuperView: TView;
- itsLocation, itsSize: VPoint;
- itsHDeterminer, itsVDeterminer: SizeDeterminer;
- itsInset: Rect;
- itsTextStyle: TextStyle;
- itsJustification: INTEGER;
- itsStyleType, itsAutoWrap: BOOLEAN);
-
- BEGIN
- {$IFC qDebug}
- IF NOT gUTEViewInitialized THEN
- BEGIN
- ProgramBreak('InitUTEView must be called before creating a TE View.');
- Failure(noErr, 0);
- END;
- {$ENDC}
-
- {$IFC qDebug}
- pTEIntenseDebugging := FALSE;
- {$ENDC}
-
- fHTE := NIL;
- fText := NIL;
- fSavedTEHandle := NIL;
- fInset := itsInset;
- fKeyCmdNumber := cTyping;
- fMaxChars := kUnlimited;
- fLastHeight := 0;
- fLastWidth := 0;
- fTypingCommand := NIL;
- fTextStyle := itsTextStyle;
- fJustification := itsJustification;
-
- fAcceptsChanges := TRUE; { Stuff to FALSE if you don't want to allow
- Cut, Paste, or Typing }
- {!!! put these in the template after 2.0 !!!}
- fControlChars := [chLeft, chRight, chUp, chDown, chBackspace, chReturn];
- fMinAhead := kMinAhead;
-
- fStyleType := (qNeedsStyleTextEdit | gConfiguration.hasStyleTextedit) & itsStyleType;
- fAutoWrap := itsAutoWrap;
- fFreeText := FALSE;
- fSpecsChanged := FALSE;
-
- fLastPageBreak := 0;
- fLastLine := 0;
-
- IView(itsDocument, itsSuperView, itsLocation, itsSize, itsHDeterminer, itsVDeterminer);
-
- MakeTERecord;
-
- SetClikLoop(@ClickLoopForTTEView, fHTE); { fHTE^^.clikLoop := @ClickLoopForTTEView; }
- { ??? Things don't work well if fText is non-NIL. Is this the way to solve it? }
- fText := fHTE^^.hText;
-
- SetIdleFreq(0); { Idle ASAP }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEOpen}
-
- PROCEDURE TTEView.IRes(itsDocument: TDocument;
- itsSuperView: TView;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- aTextStyle: TextStyle;
-
- BEGIN
- {$IFC qDebug}
- IF NOT gUTEViewInitialized THEN
- BEGIN
- ProgramBreak('InitUTEView must be called before creating a TE View.');
- Failure(noErr, 0);
- END;
- {$ENDC}
-
- {$IFC qDebug}
- pTEIntenseDebugging := FALSE;
- {$ENDC}
-
- fHTE := NIL; { In case of emergency. }
- fText := NIL;
- fSavedTEHandle := NIL;
- fLastPageBreak := 0;
- fLastLine := 0;
-
- {!!! put these in the template after 2.0 !!!}
- fControlChars := [chLeft, chRight, chUp, chDown, chBackspace, chReturn];
- fMinAhead := kMinAhead;
-
- INHERITED IRes(itsDocument, itsSuperView, itsParams);
-
- WITH TEViewTemplatePtr(itsParams)^ DO
- BEGIN
- fTypingCommand := NIL;
- fLastHeight := 0;
- fLastWidth := 0;
- fSpecsChanged := FALSE;
-
- fInset := itsInset;
- fKeyCmdNumber := itsKeyCmdNumber;
- fMaxChars := itsMaxChars;
- SetTextStyle(aTextStyle, GetFontNum(itsFontName), itsTextFace, itsTextSize, itsTextColor);
- fTextStyle := aTextStyle;
- fJustification := itsJustification;
- fAcceptsChanges := itsAcceptsChanges;
- fStyleType := (qNeedsStyleTextEdit | gConfiguration.hasStyleTextedit) & itsStyleType;
- fAutoWrap := itsAutoWrap;
- fFreeText := itsFreesText;
-
- MakeTERecord;
-
- SetClikLoop(@ClickLoopForTTEView, fHTE); { fHTE^^.clikLoop := @ClickLoopForTTEView; }
- fText := fHTE^^.hText;
-
- SetIdleFreq(0); { Idle ASAP }
- END;
-
- OffsetPtrWStr(itsParams, SIZEOF(TEViewTemplate));
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteRes}
-
- PROCEDURE TTEView.WRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- theFont: Str255;
- ttPtr: TEViewTemplatePtr;
-
- BEGIN
- INHERITED WRes(theResource, itsParams);
-
- GetFontName(fTextStyle.tsFont, theFont);
-
- ttPtr := TEViewTemplatePtr(ExpandPtrWStr(theResource, itsParams, SIZEOF(TEViewTemplate),
- LENGTH(theFont)));
-
- WITH ttPtr^ DO
- BEGIN
- itsStyleType := fStyleType;
- itsAutoWrap := fAutoWrap;
- itsAcceptsChanges := fAcceptsChanges;
- itsFreesText := fFreeText;
- itsKeyCmdNumber := fKeyCmdNumber;
- itsMaxChars := fMaxChars;
- itsInset := fInset;
- itsJustification := fJustification;
- WITH fTextStyle DO
- BEGIN
- itsTextFace := tsFace;
- itsTextSize := tsSize;
- itsTextColor := tsColor;
- END;
- { itsFontName := theFont; }
- CopyStr255(theFont, PRStr(itsFontName));
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAWriteRes}
-
- PROCEDURE TTEView.WriteRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- BEGIN
- gWResSignature := 'tevw'; gWResType := 'TTEView';
- WRes(theResource, itsParams);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEClose}
-
- PROCEDURE TTEView.Free; OVERRIDE;
-
- BEGIN
- IF fHTE <> NIL THEN
- BEGIN
- IF fSavedTEHandle <> NIL THEN
- WITH fHTE^^ DO
- BEGIN { Worry about fText separately. Put back }
- hText := fSavedTEHandle; { …the handle which TE allocated }
- {$Push} {$H-}
- teLength := { This is here because it only makes }
- GetHandleSize(hText);
- IF fFreeText THEN { …sense if fSavedTEHandle is not NIL. }
- fText := DisposeIfHandle(fText);
- fText := NIL; { Always drop my reference }
- {$Pop}
- END;
- TEDispose(fHTE);
- fHTE := NIL;
-
- fSavedTEHandle := NIL;
- END;
-
- INHERITED Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- FUNCTION TTEView.ClikLoop: BOOLEAN;
-
- VAR
- msePt: Point;
- viewPt: VPoint;
- visRect: Rect;
- delta: VPoint;
- vhs: VHSelect;
- lead: INTEGER;
- trail: INTEGER;
- scroller: TScroller;
-
- BEGIN
- IF StillDown THEN
- BEGIN
- scroller := GetScroller(FALSE);
- IF (scroller <> NIL) & scroller.Focus THEN
- BEGIN
- GetMouse(msePt);
- scroller.QDToViewPt(msePt, viewPt);
- scroller.AutoScroll(viewPt, delta); { find how much should scroll }
- IF Focus THEN
- BEGIN
- GetVisibleRect(visRect);
-
- FOR vhs := v TO h DO
- BEGIN
- lead := fLocation.vh[vhs] - visRect.topLeft.vh[vhs];
- trail := fLocation.vh[vhs] + fSize.vh[vhs] - visRect.botRight.vh[vhs];
-
- IF delta.vh[vhs] < 0 THEN
- delta.vh[vhs] := Min(MAX(delta.vh[vhs], lead), 0)
- ELSE
- delta.vh[vhs] := MAX(Min(delta.vh[vhs], trail), 0);
- END;
- { The intent of the above is not to do autoscrolling that would scroll
- beyond the subview boundary in any direction }
-
- IF (delta.v <> 0) | (delta.h <> 0) THEN
- BEGIN
- scroller.ScrollBy(delta.h, delta.v, kRedraw);
- Update; { make sure the scrolling was visible }
- END;
- END;
- END;
-
- {!!! need an IsCursorRgnValid method }
- IF EmptyRgn(gCursorRgn) & gApplication.TrackCursor THEN;
-
- { Focus may have changed, which could change lots of things, thus
- requiring us, tiresomely, to take some or all of the following
- restorative precautions b/c clikloop expects us to be clipped to the
- destrect. }
- IF Focus THEN
- ClipFurtherTo(fHTE^^.destRect, 0, 0);
- END;
- ClikLoop := TRUE; { Still consider the mouse to be down }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.AutoScrolling(doScrolling: BOOLEAN);
-
- BEGIN
- IF qNeedsROM128K | gConfiguration.hasROM128K THEN
- IF fHTE <> NIL THEN
- TEAutoView(doScrolling, fHTE);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.BeInPort(itsPort: GrafPtr); OVERRIDE;
-
- BEGIN
-
- IF fHTE <> NIL THEN
- BEGIN
- WITH fHTE^^ DO
- IF itsPort = NIL THEN
- inPort := gWorkPort
- ELSE
- inPort := itsPort;
-
- IF itsPort = NIL THEN
- BEGIN
- DoneTyping;
- fSpecsChanged := TRUE;
- END;
- END;
-
- INHERITED BeInPort(itsPort);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.BeInScroller(itsScroller: TScroller); OVERRIDE;
-
- VAR
- vertScrollUnit: INTEGER;
-
- BEGIN
- IF (fHTE <> NIL) & (itsScroller <> NIL) THEN
- BEGIN
- IF fHTE^^.lineHeight > 0 THEN { This works for both old & new TextEdit }
- vertScrollUnit := fHTE^^.lineHeight
- ELSE IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN { Ask for system default
- size }
- vertScrollUnit := GetDefFontSize
- ELSE
- vertScrollUnit := kStdScrollUnit;
-
- itsScroller.SetScrollParameters(kStdScrollUnit, vertScrollUnit, FALSE, TRUE);
- END;
-
- INHERITED BeInScroller(itsScroller);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.CalcMinSize(VAR minSize: VPoint); OVERRIDE;
-
- BEGIN
- { Note that we omit the margins here, so that if TView.ComputeExtent rounds up to a
- page multiple, the margins will get tacked on after. Also, insure we don't run off
- the end of the coordinate system if there are many lines of text. }
-
- SetVPt(minSize, fSize.h - fInset.left - fInset.right, Min(kMaxCoord, CalcRealHeight));
-
- IF (fSizeDeterminer[h] = sizeVariable) & NOT fStyleType & NOT fAutoWrap THEN
- SetVPt(minSize, fLastWidth, minSize.v);
-
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.CalcRealHeight: LONGINT;
-
- VAR
- lastIsCR: BOOLEAN;
- theMode: INTEGER;
- theHeight: LONGINT;
- theStyle: TextStyle;
- theFontInfo: FontInfo;
-
- BEGIN
- {$Push} {$R-}
- WITH fHTE^^ DO
- lastIsCR := (teLength <= 0) | (CharsHandle(hText)^^[PRED(teLength)] = chReturn);
- {$Pop}
-
- IF fStyleType = kWithStyle THEN
- BEGIN
- theHeight := 0;
- IF fHTE^^.nLines > 0 THEN
- theHeight := TEGetHeight(MAXINT, 0, fHTE);
-
- IF lastIsCR THEN { then can't use TEGetHeight so we }
- BEGIN { …have to figure it out ourselves. }
- theMode := doAll;
- lastIsCR := ContinuousStyle(MAXINT, MAXINT, theMode, theStyle);
-
- GetTextStyleFontInfo(theStyle, theFontInfo);
-
- WITH theFontInfo DO
- theHeight := theHeight + ascent + descent + leading;
- END;
- END
- ELSE
- BEGIN
- theHeight := fHTE^^.nLines + ORD(lastIsCR);
- theHeight := theHeight * fHTE^^.lineHeight;
- END;
-
- CalcRealHeight := theHeight;
- {$IFC qDebug}
- IF gIntenseDebugging THEN
- WRITELN('CalcRealHeight=', theHeight: 0);
- {$ENDC}
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.CalcRealWidth: LONGINT;
-
- VAR
- index: INTEGER;
- wasLocked: BOOLEAN;
- fromChar: INTEGER;
- toChar: INTEGER;
- aWidth: INTEGER;
- theStyle: TextStyle;
-
- BEGIN
- { !!! it would be nice to compute this for styled TE but TEGetPoint only returns the bottom
- left of the character box so it can't be used to find the width including last character
- in a line. And since some characters can change width based on context we can't just
- measure the last character and add it in. Maybe we can makeup an formula based on
- style runs or something eventually. }
- CalcRealWidth := 0; { Initialize the function result }
- IF NOT fStyleType THEN
- BEGIN
- IF Focus THEN
- BEGIN
- theStyle := fTextStyle;
- SetPortTextStyle(theStyle);
-
- aWidth := 0;
- fromChar := fHTE^^.lineStarts[0];
-
- wasLocked := IsHandleLocked(fHTE^^.hText);
- HLock(Handle(fHTE^^.hText)); {??? Better to LockHandleHigh? }
-
- FOR index := 1 TO fHTE^^.nLines DO
- BEGIN
- toChar := fHTE^^.lineStarts[index] - 1;
- aWidth := Max(aWidth, TextWidth(fHTE^^.hText^, fromChar, (toChar - fromChar) + 1));
- fromChar := toChar + 1;
- END;
-
- IF NOT wasLocked THEN
- HUnlock(Handle(fHTE^^.hText));
-
- CalcRealWidth := aWidth;
- END
- END
- ELSE IF qDebug THEN
- ProgramBreak('IN TTEView.CalcRealWidth: called for a styled TE Record');
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.ChangeWrap(newAutoWrap, redraw: BOOLEAN);
-
- BEGIN
- fAutoWrap := newAutoWrap;
- WITH fHTE^^ DO
- IF newAutoWrap THEN
- crOnly := 0
- ELSE
- crOnly := - 1;
- IF redraw THEN
- BEGIN
- RecalcText;
- SynchView(kRedraw);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.ComputeSize(VAR newSize: VPoint); OVERRIDE;
-
- FUNCTION NeedAdjust(vhs: VHSelect): BOOLEAN;
-
- BEGIN
- NeedAdjust := NOT (fSizeDeterminer[vhs] IN [sizeFixed, sizeSuperView, sizeRelSuperView]);
- END;
-
- BEGIN { TTEView.ComputeSize }
- INHERITED ComputeSize(newSize);
-
- IF NeedAdjust(h) THEN { If necessary, tack on the margins }
- newSize.h := Min(kMaxCoord, ORD4(newSize.h) + fInset.left + fInset.right);
- IF NeedAdjust(v) THEN
- newSize.v := Min(kMaxCoord, ORD4(newSize.v) + fInset.top + fInset.bottom);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.CalcSelLoc(VAR selectionRect: Rect);
-
- CONST
- kSlopToAllow = 36;
-
- VAR
- handleToText: CharsHandle;
- startOfSelection: INTEGER;
- endOfSelection: INTEGER;
- startOfCurrentLine: INTEGER;
- startOfNextLine: INTEGER;
- charCount: INTEGER;
- selLine: INTEGER;
- upToSelWidth: INTEGER;
- restWidth: INTEGER;
- lineHeight: INTEGER;
- fontAscent: INTEGER;
- theStyle: TextStyle;
- keyDirection: SignedByte;
- selectionIsTheLastReturn: BOOLEAN;
- theMode: INTEGER;
- theFontInfo: FontInfo;
- just: INTEGER;
-
- BEGIN
- WITH fHTE^^ DO
- BEGIN
- charCount := teLength;
- startOfSelection := selStart;
- endOfSelection := selEnd;
- handleToText := CharsHandle(hText);
-
- IF (selEnd - selStart = 0) & (fIdleFreq = kMaxIdleTime) THEN
- SetIdleFreq(0); { Idle ASAP }
- END;
-
- {$Push} {$R-}
- selectionIsTheLastReturn := (startOfSelection = charCount) & (charCount > 0) &
- (handleToText^^[charCount - 1] = chReturn);
- {$Pop}
-
- IF qNeedsStyleTextEdit | gConfiguration.hasStyleTextedit THEN
- BEGIN
- selectionRect.topLeft := TEGetPoint(startOfSelection, fHTE);
-
- { TEGetPoint returns the baseline point. Correct for the lineheight }
- TEGetStyle(startOfSelection, theStyle, lineHeight, fontAscent, fHTE);
- selectionRect.top := selectionRect.top - lineHeight;
-
- selectionRect.botRight := TEGetPoint(endOfSelection, fHTE); { Darn! wish we could know where
- the point to the bottom right
- of an offset is!!! This way we
- can't ever return the "real"
- rectangle that encloses the
- selection. }
-
- IF charCount = 0 THEN { In System 6 TE TEGetPoint returns bogus
- numbers when the character count is 0. }
- WITH selectionRect DO
- BEGIN
- top := 0;
- bottom := lineHeight;
- END;
-
- IF selectionIsTheLastReturn THEN
- BEGIN
- theMode := doAll;
-
- { Get the style so we know how tall to make the selection when its just the last return }
- IF ContinuousStyle(MAXINT, MAXINT, theMode, theStyle) THEN; { discard result }
-
- GetTextStyleFontInfo(theStyle, theFontInfo);
-
- selectionRect.top := selectionRect.bottom;
- WITH theFontInfo DO
- selectionRect.bottom := selectionRect.top + ascent + descent + leading;
- END
- ELSE
- BEGIN
- { Correct errors by CalcSelLoc. If there is no selection then the "selection" consists of
- the bits enclosed by the insertion bar. }
- WITH fHTE^^ DO
- BEGIN
- IF (selEnd - selStart = 0) THEN
- selectionRect.left := selectionRect.right - 1;
- END;
-
- END
- END
- ELSE { Non-styled, ugh! do all the measuring
- ourselves }
- BEGIN
-
- WITH fHTE^^ DO { for lineStarts and nLines }
- BEGIN
- selLine := 1;
- WHILE (selLine < nLines) & (startOfSelection >= lineStarts[selLine]) DO
- selLine := selLine + 1;
- selLine := selLine - 1;
-
- IF selectionIsTheLastReturn | (fJustification <> teJustLeft) & (startOfSelection =
- lineStarts[SUCC(selLine)]) THEN
- selLine := SUCC(selLine);
-
- selectionRect.top := (lineHeight * selLine) + fInset.top;
- startOfCurrentLine := lineStarts[selLine];
- IF selLine < nLines THEN
- startOfNextLine := lineStarts[SUCC(selLine)]
- ELSE
- startOfNextLine := charCount;
- END;
-
- { We could move the handle high first, but this routine is called frequently and
- fragmentation shouldn't be a problem for the TextWidth call--the worst that will
- happen is the Font Manager will have to substitute a font & we'll be off slightly.}
- { ??? The following Text calls may be unnecessary, since this may only get done
- after TextEdit has run and set the font already. This appears not to be the case
- for the Select All command, however, and is not true in general. }
- TextFont(fHTE^^.txFont);
- TextFace(fHTE^^.txFace);
- TextSize(fHTE^^.txSize);
- HLock(Handle(handleToText));
-
- { Figure out where on the line the selection is. If the Script Manager is
- installed, use it. Otherwise, try and figure it out ourselves. }
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
- BEGIN
- { Unfortunately, we must get this every time, as the user can change script
- directions at a moment's notice. }
- IF startOfSelection = endOfSelection THEN
- keyDirection := GetScript(GetEnvirons(smKeyScript), smScriptRight)
- ELSE
- keyDirection := smHilite;
-
- upToSelWidth := Char2Pixel(Ptr(ORD(handleToText^) + startOfCurrentLine),
- startOfNextLine - startOfCurrentLine, 0, startOfSelection -
- startOfCurrentLine, keyDirection);
- restWidth := TextWidth(QDPtr(handleToText^), startOfCurrentLine, startOfNextLine -
- startOfCurrentLine) - upToSelWidth;
- END
- ELSE
- BEGIN
- upToSelWidth := TextWidth(QDPtr(handleToText^), startOfCurrentLine, startOfSelection -
- startOfCurrentLine);
- restWidth := TextWidth(QDPtr(handleToText^), startOfSelection, startOfNextLine -
- startOfSelection);
- END;
-
- HUnlock(Handle(handleToText));
-
- just := fJustification;
-
- {!!!### come back and fix this or just stop supporting systems without style TE }
- CASE just OF
- teJustLeft:
- selectionRect.left := fInset.left + upToSelWidth;
- teJustRight:
- selectionRect.left := fSize.h - fInset.right - restWidth;
- { Following looks somewhat baroque, but avoids integer overflow }
- teJustCenter:
- selectionRect.left := fSize.h DIV 2 - restWidth DIV 2 + upToSelWidth DIV 2;
- END;
-
- WITH selectionRect DO
- BEGIN
- left := MAX(left - 2, 0);
- IF left <= kSlopToAllow THEN
- left := 0; { show start of line if close; gets around }
- { …potential annoyance assoc w/typeahead }
- right := Min(left + 8, fSize.h);
- bottom := Min(top + fHTE^^.lineHeight, fSize.v);
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.ContinuousStyle(firstChar, lastChar: INTEGER;
- VAR mode: INTEGER;
- VAR aStyle: TextStyle): BOOLEAN;
-
- VAR
- oldSelStart, oldSelEnd: INTEGER;
-
- BEGIN
- WITH fHTE^^ DO
- BEGIN
- oldSelStart := selStart;
- oldSelEnd := selEnd;
- END;
- SetSelect(firstChar, lastChar, fHTE); { Use SetSelect so this is invisible }
- ContinuousStyle := TEContinuousStyle(mode, aStyle, fHTE);
- SetSelect(oldSelStart, oldSelEnd, fHTE);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.ContainsClipType(aType: ResType): BOOLEAN; OVERRIDE;
-
- BEGIN
- ContainsClipType := (aType = 'TEXT');
- END;
-
- {--------------------------------------------------------------------------------------------------}
- { Put in resident segment since this gets called while typing }
- {$S TERes}
-
- FUNCTION TTEView.DoBreakFollowing(vhs: VHSelect;
- prevBreak: VCoordinate;
- VAR automatic: BOOLEAN): VCoordinate; OVERRIDE;
-
- VAR
- orthoVhs: VHSelect;
- possibleLoc: INTEGER;
- theStyles: TEStyleHandle;
- lhTab: LHHandle;
- height, lineHeight: INTEGER;
- lineNo: INTEGER;
-
- BEGIN
- orthoVhs := gOrthogonal[vhs];
- automatic := TRUE;
-
- possibleLoc := Min(kMaxCoord, ORD4(prevBreak) + fPrintHandler.fViewPerPage.vh[orthoVhs]);
-
- { We want to get rid of the on-screen margin represented by fMargin when printing, so
- adjust things so that the portion of the view occupied by the screen margin doesn't
- get printed. }
- IF prevBreak = 0 THEN
- possibleLoc := possibleLoc + fInset.topLeft.vh[orthoVhs];
-
- IF (fStyleType = kWithStyle) & (vhs = h) THEN
- BEGIN
- IF (fLastPageBreak = prevBreak) THEN
- BEGIN
- height := fLastPageBreak;
- lineNo := fLastLine;
- END
- ELSE
- BEGIN
- height := fInset.topLeft.vh[orthoVhs];
- lineNo := 0;
- END;
-
- theStyles := GetStylHandle(fHTE);
- lhTab := theStyles^^.lhTab;
- WHILE lineNo < fHTE^^.nLines DO
- BEGIN
- lineHeight := lhTab^^[lineNo].lhHeight;
- IF height + lineHeight <= possibleLoc THEN
- height := height + lineHeight
- ELSE
- LEAVE;
- lineNo := lineNo + 1;
- END;
- IF lineNo >= fHTE^^.nLines THEN
- possibleLoc := MAX(possibleLoc, height)
- ELSE
- possibleLoc := height;
- fLastPageBreak := possibleLoc;
- fLastLine := lineNo;
- END;
-
- IF ORD4(possibleLoc + fInset.topLeft.vh[orthoVhs]) >= fSize.vh[orthoVhs] THEN
- DoBreakFollowing := fSize.vh[orthoVhs]
- ELSE
- DoBreakFollowing := possibleLoc;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.DoCalcViewPerPage(VAR viewPerPage: VPoint); OVERRIDE;
-
- VAR
- vhs: VHSelect;
-
- BEGIN
- INHERITED DoCalcViewPerPage(viewPerPage); { Get max amount allowed given margins }
-
- {$IFC qDebug}
- IF gDebugPrinting THEN
- BEGIN
- WRITE('TTEView: incoming generic viewPerPage:');
- WriteVPt(viewPerPage);
- WRITELN;
- END;
- {$ENDC}
-
- IF (fStyleType <> kWithStyle) & (fHTE <> NIL) THEN { Adjust for integral # of lines per page }
- WITH fHTE^^ DO
- viewPerPage.v := lineHeight * (viewPerPage.v DIV lineHeight);
-
- {$IFC qDebug}
- IF gDebugPrinting THEN
- BEGIN
- WRITE('TTEView: computed viewPerPage:');
- WriteVPt(viewPerPage);
- WRITELN;
- END;
- {$ENDC}
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.DoIdle(phase: IdlePhase): BOOLEAN; OVERRIDE;
-
- VAR
- aRect: Rect;
-
- BEGIN
- DoIdle := FALSE; { Didn't free myself }
-
- IF (fHTE <> NIL) & (fHTE^^.selEnd - fHTE^^.selStart = 0) & fViewEnabled THEN
- BEGIN
- IF Focus & IsVisible & fAcceptsChanges THEN
- TEIdle(fHTE);
- SetIdleFreq(MAX(GetCaretTime DIV 2, 1)); { Reset idle frequency in case user changed
- it}
- END
- ELSE
- SetIdleFreq(kMaxIdleTime); { No need to bother anyone. }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.DoKeyCommand(ch: Char;
- aKeyCode: INTEGER;
- VAR info: EventInfo): TCommand; OVERRIDE;
- { The Tab character has no width in some fonts, and so can cause confusing screen feedback.
- It is filtered out by default. If you want to include it in your text union it into fControlChars. }
-
- VAR
- aTypingCommand: TTETypingCommand;
- needNewCommand: BOOLEAN;
- handledCharacter: BOOLEAN;
-
- BEGIN
- DoKeyCommand := NIL;
- handledCharacter := FALSE;
-
- IF IsViewEnabled THEN { if view is not enabled then we don't take
- ANY keystrokes }
- BEGIN
- IF (ch >= ' ') | (ch IN fControlChars) THEN { Check that the character should be
- accepted }
- BEGIN
- IF (ch IN [chLeft, chRight, chUp, chDown]) & Focus THEN { check for pure movement keys }
- BEGIN
- DoneTyping; { Like mousedown, further typing = new cmd }
- fSpecsChanged := TRUE;
- TEKey(ch, fHTE);
- ScrollSelectionIntoView;
- handledCharacter := TRUE;
- END
- ELSE IF fAcceptsChanges & Focus THEN
- BEGIN
- { Check max size for text, and that we're not running out of memory }
- IF (ch <> chBackspace) & (ch <> chFwdDelete) & (fHTE^^.selStart =
- fHTE^^.selEnd) THEN
- IF ((fMaxChars - GetHandleSize(fText)) < 1) | MemSpaceIsLow THEN
- BEGIN
- StdAlert(phTooManyChars);
- EXIT(DoKeyCommand); { Flush further keystrokes }
- END;
-
- { Pass the character to the typing command, creating a new one if necessary }
-
- needNewCommand := (fTypingCommand = NIL);
- IF NOT needNewCommand THEN
- needNewCommand := fTypingCommand.fCompleted;
-
- IF needNewCommand THEN
- BEGIN
- aTypingCommand := DoMakeTypingCommand(ch);
- fTypingCommand := aTypingCommand;
- DoKeyCommand := aTypingCommand;
- END
- ELSE
- BEGIN
- fTypingCommand.AddCharacter(ch);
- { Once you're typing (first character already processed) collecting subsequent
- characters really shouldn't affect the menus unless you're keeping a character
- count in them or something that depends on the aggregate of the characters you've
- typed. The TextStyle for the first character would certainly apply to subsequent
- characters. So, this is one ideal place to say that the event _DOES NOT_ affect
- the menus. If the menus are already invalid they will stay so, but if they are
- valid then there is no need to invalidate them in the character collection process.
- When the user terminates the addition of characters with another event, the menus
- will be setup from that event. If you really feel you must, then you can always
- override, call inherited and then set info.affectMenus back to true. (Rhymes with
- rue) }
- info.affectsMenus := FALSE;
- END;
- handledCharacter := TRUE;
- END
-
- END;
- IF fIdleFreq = kMaxIdleTime THEN
- SetIdleFreq(0); { Idle ASAP, since someone may somehow set
- an insertion point and want it to flash.
- (the idle time will be reset to match the
- caret time in doidle.)}
- END;
-
- IF NOT handledCharacter THEN
- DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TESelCommand}
-
- FUNCTION TTEView.DoMakeEditCommand(aCmdNumber: CmdNumber): TTECommand;
-
- VAR
- aCutCopyCommand: TTECutCopyCommand;
- aPasteCommand: TTEPasteCommand;
- aClearCommand: TTECommand;
-
- BEGIN
- CASE aCmdNumber OF
- cCut, cCopy:
- BEGIN
- New(aCutCopyCommand);
- FailNIL(aCutCopyCommand);
- aCutCopyCommand.ITECutCopyCommand(SELF, aCmdNumber);
- DoMakeEditCommand := aCutCopyCommand;
- END;
-
- cPaste:
- BEGIN
- New(aPasteCommand);
- FailNIL(aPasteCommand);
- aPasteCommand.ITEPasteCommand(SELF);
- DoMakeEditCommand := aPasteCommand;
- END;
-
- cClear:
- BEGIN
- New(aClearCommand);
- FailNIL(aClearCommand);
- aClearCommand.ITECommand(SELF, aCmdNumber, TRUE);
- DoMakeEditCommand := aClearCommand;
- END;
-
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.DoMakeStyleCommand(aStyle: TextStyle;
- itsCmdNumber: CmdNumber;
- itsMode: INTEGER): TTEStyleCommand;
-
- VAR
- aTEStyleCommand: TTEStyleCommand;
-
- BEGIN
- New(aTEStyleCommand);
- FailNIL(aTEStyleCommand);
- aTEStyleCommand.ITEStyleCommand(SELF, aStyle, itsCmdNumber, itsMode);
- DoMakeStyleCommand := aTEStyleCommand;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.DoMakeTypingCommand(ch: Char): TTETypingCommand;
-
- VAR
- aTypingCommand: TTETypingCommand;
-
- BEGIN
- New(aTypingCommand);
- FailNIL(aTypingCommand);
- aTypingCommand.ITETypingCommand(SELF, ch);
- DoMakeTypingCommand := aTypingCommand;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TESelCommand}
-
- FUNCTION TTEView.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; OVERRIDE;
-
- VAR
- command: TCommand;
- aCutCopyCommand: TTECutCopyCommand;
- aPasteCommand: TTEPasteCommand;
- nChars: LONGINT;
- dataType: ResType;
-
- BEGIN
- DoMenuCommand := NIL;
- CASE aCmdNumber OF
- cCut, cCopy, cClear:
- DoMenuCommand := DoMakeEditCommand(aCmdNumber);
-
- cPaste:
- BEGIN
- nChars := gApplication.GetDataToPaste(NIL, dataType);
- IF nChars < 0 THEN
- {$IFC qDebug}
- ProgramBreak('Couldn''t get data to paste') { ??? }
- {$ENDC}
- ELSE
- BEGIN
- IF nChars - (fHTE^^.selEnd - fHTE^^.selStart) >
- fMaxChars - GetHandleSize(fText) THEN
- StdAlert(phTooManyChars)
- ELSE
- DoMenuCommand := DoMakeEditCommand(aCmdNumber);
- END;
- END;
-
- cSelectAll:
- BEGIN
- IF Focus THEN
- BEGIN
- TESetSelect(0, fHTE^^.teLength, fHTE);
- DoneTyping;
- fSpecsChanged := TRUE;
- ScrollSelectionIntoView;
- END;
- END;
-
- OTHERWISE
- DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber);
-
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.DoMouseCommand(VAR theMouse: Point;
- VAR info: EventInfo;
- VAR hysteresis: Point): TCommand; OVERRIDE;
-
- BEGIN
- IF Focus & IsVisible THEN
- BEGIN
- pCurrTEView := SELF; { So the global clikLoop routine can forward
- }
- DoneTyping; { Mousedown terminates the Typing command }
- fSpecsChanged := TRUE;
- TEClick(theMouse, info.theShiftKey, fHTE);
-
- { …force a re-focus b/c the focusing in ClikLoop clips down to the destrect. }
- IF IsFocused THEN
- InvalidateFocus;
-
- IF fIdleFreq = kMaxIdleTime THEN
- SetIdleFreq(0); { Idle ASAP }
- END;
- DoMouseCommand := NIL;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.DoneTyping;
-
- BEGIN
- IF fTypingCommand <> NIL THEN
- fTypingCommand.CompleteTyping;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- FUNCTION TTEView.DoSetCursor(localPoint: Point;
- cursorRgn: RgnHandle): BOOLEAN; OVERRIDE;
-
- VAR
- qdExtent: Rect;
-
- BEGIN
- GetDefaultCursorRgn(localPoint,cursorRgn);
- UseROMMap(TRUE);
- SetCursor(GetCursor(iBeamCursor)^^);
- DoSetCursor := TRUE;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEPrint}
-
- PROCEDURE TTEView.DoSetPageOffset(coord: VPoint); OVERRIDE;
-
- VAR
- vhs: VHSelect;
-
- BEGIN
- INHERITED DoSetPageOffset(coord);
- FOR vhs := v TO h DO
- IF coord.vh[vhs] = 0 THEN
- gPageOffset.vh[vhs] := gPageOffset.vh[vhs] + fInset.topLeft.vh[vhs];
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.DoSetupMenus; OVERRIDE;
-
- VAR
- manyChars: BOOLEAN;
-
- BEGIN
- INHERITED DoSetupMenus;
-
- WITH fHTE^^ DO
- manyChars := selStart < selEnd;
- IF NOT MemSpaceIsLow THEN
- BEGIN
- IF fAcceptsChanges THEN { One way or another, we can paste text }
- CanPaste('TEXT'); { If styles exist, all the better }
-
- Enable(cCopy, manyChars);
- END;
- Enable(cSelectAll, (fHTE^^.teLength > 0));
-
- { We enable Cut even if space is low, since it's nice to be able to rescue some of
- the stuff you have to delete even if space is low. Note that it is possible to
- get into the "can't do any commands" situation as a result. You should be able
- to close and save the big document, then save the rescued text elsewhere, however. }
-
- Enable(cCut, manyChars & fAcceptsChanges);
- Enable(cClear, manyChars & fAcceptsChanges);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.Draw(area: Rect); OVERRIDE;
-
- VAR
- hideSelection: BOOLEAN;
-
-
- BEGIN
- hideSelection := (gPrinting | gDrawingPictScrap) & BOOLEAN(fHTE^^.active);
- IF hideSelection THEN
- BEGIN { …prevent selection from being drawn. }
- {$IFC qDebug}
- UseTempRgn('TTEView.Draw');
- {$ENDC}
- GetClip(gTempRgn);
- ClipRect(gZeroRect);
- TEDeactivate(fHTE);
- SetClip(gTempRgn);
- END;
-
-
- TEUpdate(area, fHTE); { normal screen update handled by TextEdit directly }
-
- IF hideSelection THEN
- BEGIN
- GetClip(gTempRgn);
- ClipRect(gZeroRect);
- TEActivate(fHTE);
- SetClip(gTempRgn);
- {$IFC qDebug}
- DoneWithTempRgn;
- {$ENDC}
- END;
-
-
- INHERITED Draw(area);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.ExtractStyles(VAR theStyles: TEStyleHandle;
- VAR theElements: STHandle);
-
- BEGIN
- theStyles := GetStylHandle(fHTE);
- theElements := theStyles^^.styleTab;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- FUNCTION TTEView.ExtractText: Handle;
-
- BEGIN
- ExtractText := fText;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.GetPrintExtent(VAR printExtent: VRect); OVERRIDE;
-
- BEGIN
- INHERITED GetPrintExtent(printExtent);
- WITH fInset DO
- BEGIN
- printExtent.top := printExtent.top + top;
- printExtent.left := printExtent.left + left;
- printExtent.bottom := printExtent.bottom - bottom;
- printExtent.right := printExtent.right - right;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEClipboard}
-
- FUNCTION TTEView.GivePasteData(aDataHandle: Handle;
- dataType: ResType): LONGINT; OVERRIDE;
-
- VAR
- oldStart: INTEGER;
- oldEnd: INTEGER;
- aSize: LONGINT;
- aHandle: Handle;
- err: OSErr;
- savedPerm: BOOLEAN;
- fi: FailInfo;
-
- {--------------------------------------------------------------------------------------------------}
-
- PROCEDURE HdlGivePasteFailed(error: OSErr;
- message: LONGINT);
-
- BEGIN
- aHandle := DisposeIfHandle(aHandle);
- END;
-
- BEGIN
- savedPerm := FALSE;
- aSize := 0; { Assume the worst }
- aHandle := NIL;
- CatchFailures(fi, HdlGivePasteFailed);
-
- IF dataType = 'TEXT' THEN
- BEGIN
- aSize := GetHandleSize(fText);
- IF aDataHandle <> NIL THEN
- BEGIN
- SetPermHandleSize(aDataHandle, aSize); { Don't forget. This can fail }
- BlockMove(fText^, aDataHandle^, aSize);
- END;
- END
- ELSE IF dataType = 'styl' THEN
- BEGIN
- IF fStyleType = kWithStyle THEN
- IF NOT SpaceForStyles(0, MAXINT) THEN
- Failure(noErr, 0) { We'll accept this error in worst case }
- ELSE
- BEGIN
- WITH fHTE^^ DO
- BEGIN
- oldStart := selStart;
- oldEnd := selEnd;
- END;
- SetSelect(0, MAXINT, fHTE);
- aHandle := Handle(GetStylScrap(fHTE));
- SetSelect(oldStart, oldEnd, fHTE);
-
- IF aHandle <> NIL THEN
- BEGIN
- aSize := GetHandleSize(aHandle);
- IF aDataHandle <> NIL THEN
- BEGIN
- savedPerm := PermAllocation(TRUE);
- LockHandleHigh(aHandle); { Try to prevent fragmentation, in case
- Can't move while we're copying it! }
-
- err := PtrToXHand(aHandle^, { Copy styles into user-supplied handle }
- aDataHandle, aSize);
- HUnlock(aHandle); { Okay for it to move again }
- savedPerm := PermAllocation(savedPerm);
- IF err <> noErr THEN { Maybe enough for one copy, but not two! }
- Failure(phStylesTooBig, phStylesTooBig + msgAlert);
- END;
- aHandle := DisposeIfHandle(aHandle);
- END
- ELSE IF aDataHandle <> NIL THEN { Hmm. There _was_ enough memory, but the }
- Failure(phStylesTooBig, phStylesTooBig + msgAlert); { …heap is probably pretty
- fragmented }
-
- END;
- END
- ELSE
- Failure(noTypeErr, 0);
-
- FailSpaceIsLow;
- Success(fi);
- GivePasteData := aSize;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.InstallSelection(wasActive, beActive: BOOLEAN); OVERRIDE;
-
- VAR
- aDiscard: INTEGER;
-
- BEGIN
- IF fHTE <> NIL THEN { fHTE is set to NIL by TTEView.Free …since
- InstallSelection is then …called by
- INHERITED Free. }
- BEGIN
- IF beActive THEN
- BEGIN
- IF fIdleFreq = kMaxIdleTime THEN
- SetIdleFreq(0); { Idle ASAP }
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN
- aDiscard := SetKeyScript(Font2Script(fTextStyle.tsFont));
- IF Focus THEN { Try to focus because TEActivate may draw }
- TEActivate(fHTE);
- pCurrTEView := SELF; { So the global clikLoop routine can forward
- }
- END
- ELSE
- BEGIN
- IF Focus THEN { Try to focus because TEDeactivate may draw
- }
- TEDeactivate(fHTE);
- DoneTyping;
- fSpecsChanged := TRUE;
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEOpen}
-
- PROCEDURE TTEView.MakeTERecord;
-
- VAR
- anHTE: TEHandle;
- dest: Rect;
- oldPort: GrafPtr;
- fi: FailInfo;
- aTextStyle: TextStyle;
-
- PROCEDURE HdlMakeFailed(error: OSErr;
- message: LONGINT);
-
- BEGIN
- Free;
- END;
-
- BEGIN
- GetPort(oldPort);
- SetPort(gWorkPort);
- aTextStyle := fTextStyle;
- SetPortTextStyle(aTextStyle);
-
- dest.topLeft := fInset.topLeft;
- dest.right := fSize.h - fInset.right;
- dest.bottom := fSize.v - fInset.bottom;
-
- IF fStyleType = kWithStyle THEN
- anHTE := TEStylNew(dest, dest) { Open a styled record if requested }
- ELSE
- anHTE := TENew(dest, dest); { …otherwise, do it the old way }
-
- SetPort(oldPort);
-
- CatchFailures(fi, HdlMakeFailed); { In case we couldn't create the TEHandle. }
- FailNIL(anHTE); { Make sure we actually created one }
- fHTE := anHTE; { We did, so save off TE handle }
- gDefClikLoopProc := anHTE^^.ClikLoop; { Just in case we want to restore it… }
- { Note that the system call SetClikLoop }
- { _cannot_ be used to set the clikProc of }
- { the TERecord. This is because the default }
- { clikproc does not follow the Pascal Parameter }
- { passing conventions that this procedure expects. }
-
- SetJustification(fJustification, kDontRedraw); { Set justification to requested value }
- ChangeWrap(fAutoWrap, FALSE); { Install auto wrap (or CR only) }
- FailNoReserve; { Got to have some reserve tank }
- Success(fi);
-
- BeInPort(GetGrafPort); { Associate with real port }
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.RecalcText;
-
- BEGIN
- TECalText(fHTE);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.Resize(width, height: VCoordinate;
- invalidate: BOOLEAN); OVERRIDE;
-
- VAR
- needCalText: BOOLEAN;
- r: Rect;
- oldSize: VPoint;
- actualJust: INTEGER;
-
- BEGIN
- oldSize := fSize;
- INHERITED Resize(width, height, invalidate);
- IF fHTE <> NIL THEN
- BEGIN
- r.topLeft := fInset.topLeft;
- r.right := fSize.h - fInset.right;
- r.bottom := fSize.v - fInset.bottom;
-
- needCalText := (r.right <> fHTE^^.destRect.right);
- StuffTERects(r);
- IF needCalText THEN
- BEGIN
- RecalcText;
- SynchView(kDontRedraw);
- actualJust := GetActualJustification(fJustification);
- IF invalidate & ((fAutoWrap & ((fSize.h <> oldSize.h) | (fSize.v <> oldSize.v)))
- { All bets are off }
- | ((actualJust = teJustRight) | (actualJust = teJustCenter))) THEN
- ForceRedraw;
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.ScrollSelectionIntoView;
-
- VAR
- vhs: VHSelect;
- newLoc: Point;
- newSelLoc: Point;
- selectionRect: Rect;
- minToSee: Point;
- visRect: Rect;
- vSelectionRect: VRect;
-
- BEGIN
- { ??? should we have an option to walk the superviews, scrolling as many scrollers as necessary
- to reveal the selection? }
- IF (GetScroller(FALSE) <> NIL) & Focus THEN { Can't scroll selection if we don't have }
- BEGIN { … a scroller! }
- IF fIdleFreq = kMaxIdleTime THEN
- SetIdleFreq(0); { Idle ASAP }
- GetVisibleRect(visRect);
- CalcSelLoc(selectionRect);
-
- {$IFC qDebug}
- IF gIntenseDebugging THEN
- BEGIN
- WRITE('Visible Rect was: '); WriteRect(visRect);
- WRITE('; Sel Rect was: '); WriteRect(selectionRect); WRITELN;
- END;
- {$ENDC}
-
- IF NOT RectsNest(visRect, selectionRect) THEN
- BEGIN
- { Scroll the selection into view. accounting for the user's preference for how much to
- jump at a time with fMinAhead. }
- SetPt(minToSee, Min(fMinAhead, fSize.h - selectionRect.left), LengthRect(selectionRect,
- v));
- {$IFC qDebug}
- IF gIntenseDebugging THEN
- BEGIN
- WrLblRect('RevealRect: r', selectionRect);
- WrLblPt(', minToSee', minToSee);
- WRITELN;
- END;
- {$ENDC}
- QDToViewRect(selectionRect, vSelectionRect);
- RevealRect(vSelectionRect, minToSee, kRedraw);
- IF Focus THEN; { Refocus in newly-scrolled position. Why???
- does our caller have a dependency on this?
- }
- END;
- END
- ELSE IF qNeedsROM128K | gConfiguration.hasROM128K THEN
- IF NOT fAutoWrap & (fHTE <> NIL) THEN
- TESelView(fHTE);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.SetJustification(newJust: INTEGER;
- redraw: BOOLEAN);
-
- BEGIN
- TESetJust(newJust, fHTE);
- fJustification := newJust;
- IF redraw THEN
- ForceRedraw;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.SetOneStyle(theStart, theEnd, theMode: INTEGER;
- theStyle: TextStyle;
- redraw: BOOLEAN);
-
- VAR
- saveStart: INTEGER;
- saveEnd: INTEGER;
- fInfo: FontInfo;
- newStyle: TextStyle;
-
- BEGIN
- InvalidateFocus; { ??? THIS SHOULDN'T BE NECESSARY! ??? }
- IF Focus THEN;
- IF fStyleType = kWithStyle THEN
- BEGIN
- WITH fHTE^^ DO
- BEGIN
- saveStart := selStart;
- saveEnd := selEnd;
- END;
- SetSelect(theStart, theEnd, fHTE);
- TESetStyle(theMode, theStyle, redraw, fHTE);
- SetSelect(saveStart, saveEnd, fHTE);
- END
- ELSE
- BEGIN
- IF theMode = doAll THEN
- newStyle := theStyle
- ELSE
- BEGIN
- newStyle := fTextStyle;
- IF BAND(theMode, doFont) <> 0 THEN
- BEGIN
- newStyle.tsFont := theStyle.tsFont;
-
- IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN { …if Script Mgr is
- installed, change }
- KeyScript(Font2Script(newStyle.tsFont)); { …keybd input system to match new font
- }
- END;
- IF BAND(theMode, doFace) <> 0 THEN
- newStyle.tsFace := theStyle.tsFace;
- IF BAND(theMode, doColor) <> 0 THEN
- newStyle.tsColor := theStyle.tsColor;
- IF BAND(theMode, addSize) <> 0 THEN
- newStyle.tsSize := newStyle.tsSize + theStyle.tsSize
- ELSE IF BAND(theMode, doSize) <> 0 THEN
- newStyle.tsSize := theStyle.tsSize;
- END;
-
- GetTextStyleFontInfo(newStyle, fInfo); { Need to get font's height and ascent. }
-
- WITH fHTE^^, newStyle, fInfo DO
- BEGIN
- txSize := tsSize;
- txFont := tsFont;
- txFace := tsFace;
- fontAscent := ascent;
- lineHeight := ascent + descent + leading;
- SetIfColor(tsColor);
- END;
- fTextStyle := newStyle;
- END;
-
- IF TRUE { (fStyleType = kWithoutStyle) | (theStart
- <> theEnd) } THEN
- BEGIN
- RecalcText;
- SynchView(redraw & (fStyleType = kWithStyle));
- IF redraw & (fStyleType = kWithoutStyle) THEN
- ForceRedraw;
- END;
- fSpecsChanged := TRUE;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.SetText(theText: Str255);
-
- VAR
- theTextHandle: Handle;
-
- BEGIN
- IF fHTE <> NIL THEN { If we're replacing text, styles are kaput
- }
- BEGIN
- FailOSErr(PtrToHand(@theText[1], theTextHandle, LENGTH(theText)));
- StuffText(theTextHandle);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.ShowReverted; OVERRIDE;
-
- BEGIN
- RecalcText;
- fLastHeight := 0;
- fLastWidth := 0;
- INHERITED ShowReverted;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- FUNCTION TTEView.SpaceForStyles(rangeStart, rangeEnd: LONGINT): BOOLEAN;
-
- VAR
- h: Handle;
-
- BEGIN
- h := NewPermHandle(TENumStyles(rangeStart, rangeEnd, fHTE) * SIZEOF(ScrpSTElement) + 2);
- IF (h = NIL) THEN
- BEGIN
- StdAlert(phStylesTooBig);
- SpaceForStyles := FALSE;
- END
- ELSE
- BEGIN
- h := DisposeIfHandle(h); { Release memory back to the system }
- SpaceForStyles := TRUE;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.StuffStyles(theStyles: TEStyleHandle;
- theElements: STHandle);
-
- VAR
- oldStyles: TEStyleHandle;
- oldElements: STHandle;
- oldLineHeights: LHHandle;
- theNullStyles: nullSTHandle;
- theScrpHandle: STScrpHandle;
- err: OSErr;
-
- BEGIN
- IF (fStyleType = kWithStyle) & (fHTE <> NIL) THEN
- BEGIN
- oldStyles := GetStylHandle(fHTE);
-
- WITH oldStyles^^ DO
- BEGIN
- oldElements := styleTab;
- oldLineHeights := lhTab;
- theNullStyles := nullStyle;
- theScrpHandle := nullStyle^^.nullScrap;
- END;
-
- DisposIfHandle(oldElements);
-
- WITH theStyles^^ DO
- BEGIN
- styleTab := theElements; { Replace STElements handle }
- lhTab := oldLineHeights; { Replace line heights table handle }
- nullStyle := theNullStyles; { Replace null style handle }
- nullStyle^^.nullScrap := theScrpHandle;
- teRefCon := LONGINT(SELF); { store ourselves as the refcon reference }
- END;
-
- { NOTE!! SetStylHandle will dispose of oldStyles for us! }
- SetStylHandle(theStyles, fHTE);
-
- RecalcText;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.StuffText(theText: Handle);
-
- VAR
- styles: TEStyleHandle;
- textLength: LONGINT;
-
- BEGIN
- IF fHTE <> NIL THEN { If we're replacing text, styles are kaput
- }
- BEGIN
- textLength := GetHandleSize(theText); { Check size of new text }
- IF textLength > fMaxChars THEN
- BEGIN
- {$IFC qDebug}
- ProgramBreak('Text size exceeds maximum for this view');
- {$ENDC}
- Failure(minErr, 0); { ??? Assign a message }
- END;
-
- IF fSavedTEHandle <> theText THEN
- BEGIN
- fSavedTEHandle := DisposeIfHandle(fSavedTEHandle); { …we have no choice but to dispose
- it }
- fSavedTEHandle := fHTE^^.hText; { Save existing handle }
- END;
- WITH fHTE^^ DO
- BEGIN
- hText := theText; { Install new handle }
- fText := theText; { Make a local copy, too }
- teLength := textLength; { Tell TE how long we are }
- END;
-
- IF fStyleType = kWithStyle THEN { Fix for styled TE. Yuk. }
- BEGIN
- styles := GetStylHandle(fHTE);
- styles^^.runs[1].startChar := SUCC(fHTE^^.teLength);
- styles^^.nRuns := 1;
- styles^^.nStyles := 1;
- { Thanks to map }
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.StuffTERects(newTERect: Rect);
-
- VAR
- aFontInfo: FontInfo;
-
- BEGIN
-
- GetFontInfo(aFontInfo);
- WITH newTERect DO
- right := MAX(right, left + aFontInfo.widMax);
- WITH fHTE^^ DO
- BEGIN
- destRect := newTERect;
- viewRect := newTERect;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.SynchView(redraw: BOOLEAN);
- CONST
- kInsertionBarWidth = 1; { We all _KNOW_ an insertion bar is one
- pixel wide right? }
-
- VAR
- aRect: Rect;
- theHeight: LONGINT;
- theWidth: LONGINT;
- doRealWidth: BOOLEAN;
-
- BEGIN
- theHeight := CalcRealHeight;
-
- doRealWidth := (fSizeDeterminer[h] = sizeVariable) & NOT fStyleType & NOT fAutoWrap;
- IF doRealWidth THEN
- theWidth := CalcRealWidth + kInsertionBarWidth * 2;
-
- IF (fLastHeight <> theHeight) | (doRealWidth & (fLastWidth <> theWidth)) THEN
- BEGIN
- IF doRealWidth THEN
- fLastWidth := theWidth; { Width is expensive to calculate. Cache for CalcMinSize }
-
- AdjustSize; { may need to grow view }
- fLastHeight := theHeight; { Remember new height value }
- END;
-
- IF redraw & Focus THEN
- { First, make sure selection is visible (this conveniently focuses). Then,
- repair any extra feedback which TextEdit may have mashed. }
- BEGIN
- ScrollSelectionIntoView;
- DoHighlightSelection(hlOff, fHLDesired);
- IF fPrintHandler <> NIL THEN
- BEGIN
- GetVisibleRect(aRect);
- DoDrawPrintFeedback(aRect);
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TENonRes}
-
- PROCEDURE TTEView.WriteToDeskScrap; OVERRIDE;
-
- VAR
- aHandle: Handle;
-
- BEGIN
- FailOSErr(PutDeskScrapData('TEXT', fText));
-
- IF (fStyleType = kWithStyle) & SpaceForStyles(0, MAXINT) THEN
- BEGIN
- SetSelect(0, MAXINT, fHTE);
- aHandle := Handle(GetStylScrap(fHTE));
- FailNIL(aHandle);
- FailOSErr(PutDeskScrapData('styl', aHandle));
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TERes}
-
- PROCEDURE TTEView.ViewEnable(state, redraw: BOOLEAN);
-
- BEGIN
- IF state & (fIdleFreq = kMaxIdleTime) THEN
- SetIdleFreq(0); { Get correct idle set ASAP }
-
- INHERITED ViewEnable(state, redraw);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEDebug}
-
- PROCEDURE TTEView.IdentifySoftware; OVERRIDE;
-
- BEGIN
- WRITELN('UTEView of 14 Feb 90 (Valentine''s Day), Compiled on ', COMPDATE, ' @ ', COMPTIME);
- INHERITED IdentifySoftware;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S TEFields}
-
- PROCEDURE TTEView.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TTEView', NIL, bClass);
- DoToField('fHTE', @fHTE, bTEHandle);
- DoToField('fText', @fText, bHandle);
- DoToField('fSavedTEHandle', @fSavedTEHandle, bHandle);
- DoToField('fInset', @fInset, bRect);
- DoToField('fKeyCmdNumber', @fKeyCmdNumber, bCmdNumber);
- DoToField('fMaxChars', @fMaxChars, bInteger);
- DoToField('fLastHeight', @fLastHeight, bLongInt);
- DoToField('fLastWidth', @fLastWidth, bLongInt);
- DoToField('fTypingCommand', @fTypingCommand, bObject);
- {$Push} {$H-}
- TextStyleFields('fTextStyle', fTextStyle, DoToField);
- {$Pop}
- DoToField('fJustification', @fJustification, bInteger);
- DoToField('fAcceptsChanges', @fAcceptsChanges, bBoolean);
- DoToField('fStyleType', @fStyleType, bBoolean);
- DoToField('fAutoWrap', @fAutoWrap, bBoolean);
- DoToField('fFreeText', @fFreeText, bBoolean);
- DoToField('fSpecsChanged', @fSpecsChanged, bBoolean);
- DoToField('fLastLine', @fLastLine, bInteger);
- DoToField('fLastPageBreak', @fLastPageBreak, bInteger);
- DoToField('fControlChars', @fControlChars, bHexLongInt);
- DoToField('fMinAhead', @fMinAhead, bInteger);
-
- INHERITED Fields(DoToField);
- END;
-