/components/synedit/syneditfoldedview.pp
Pascal | 4499 lines | 3659 code | 462 blank | 378 comment | 515 complexity | da30c3dc6ba5171c1b39893b06da585f MD5 | raw file
Large files files are truncated, but you can click here to view the full file
1{------------------------------------------------------------------------------- 2The contents of this file are subject to the Mozilla Public License 3Version 1.1 (the "License"); you may not use this file except in compliance 4with the License. You may obtain a copy of the License at 5http://www.mozilla.org/MPL/ 6 7Software distributed under the License is distributed on an "AS IS" basis, 8WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 9the specific language governing rights and limitations under the License. 10 11Alternatively, the contents of this file may be used under the terms of the 12GNU General Public License Version 2 or later (the "GPL"), in which case 13the provisions of the GPL are applicable instead of those above. 14If you wish to allow use of your version of this file only under the terms 15of the GPL and not to allow others to use your version of this file 16under the MPL, indicate your decision by deleting the provisions above and 17replace them with the notice and other provisions required by the GPL. 18If you do not delete the provisions above, a recipient may use your version 19of this file under either the MPL or the GPL. 20 21-------------------------------------------------------------------------------} 22(* some parts (AdjustBalance...) of this unit are based on the AVLTree unit *) 23(* TODO: Implement node.eof / node.bof *) 24unit SynEditFoldedView; 25 26{$mode objfpc}{$H+} 27{$coperators on} 28{$IFDEF CPUPOWERPC} {$INLINE OFF} {$ENDIF} (* Workaround for bug 12576 (fpc) see bugs.freepascal.org/view.php?id=12576 *) 29 30{$IFOPT C+} 31 {$DEFINE SynAssertFold} 32{$ENDIF} 33{$IFDEF SynAssert} 34 {$DEFINE SynAssertFold} 35{$ENDIF} 36 37{$IFDEF SynFoldDebug} 38 {$DEFINE SynDebug} 39 {$DEFINE SynFoldSaveDebug} 40{$ENDIF} 41{$IFDEF SynFoldSaveDebug} 42 {$DEFINE SynDebug} 43{$ENDIF} 44 45interface 46 47uses 48 LCLProc, LazLoggerBase, LazClasses, Graphics, 49 Classes, SysUtils, LazSynEditText, SynEditTypes, SynEditMiscClasses, 50 SynEditMiscProcs, SynEditPointClasses, 51 SynEditHighlighter, SynEditHighlighterFoldBase; 52 53type 54 55 TFoldNodeClassification = (fncInvalid, fncHighlighter, fncHighlighterEx, fncBlockSelection); 56 TFoldNodeClassifications = set of TFoldNodeClassification; 57 58 { TSynTextFoldAVLNodeData } 59 60 TSynTextFoldAVLNodeData = class(TSynSizedDifferentialAVLNode) 61 protected 62 function Left: TSynTextFoldAVLNodeData; 63 function Parent: TSynTextFoldAVLNodeData; 64 function Right: TSynTextFoldAVLNodeData; 65 procedure FreeAllChildrenAndNested; 66 public (* Position / Size *) 67 (* FullCount: Amount of lines in source for this fold only 68 (excluding overlaps) *) 69 FullCount : Integer; 70 (* LineOffset: Line-Number Offset to parent node 71 All line numbers are stored as offsets, 72 for faster updates if lines are inserted/deleted *) 73 property LineOffset: Integer read FPositionOffset write FPositionOffset; 74 (* LeftCount: Lines folded in left tree. 75 Used to calculate how many lines are folded up to a specified line *) 76 property LeftCount: Integer read FLeftSizeSum write FLeftSizeSum; 77 (* MergedLineCount: Amount of lines folded away by this fold, 78 FullCount + Lines covered by overlaps *) 79 property MergedLineCount: Integer read FSize write FSize; 80 public 81 (* Sub-Tree *) 82 Nested : TSynTextFoldAVLNodeData; (* Nested folds (folds within this fold) do not need to be part of the searchable tree 83 They will be restored, if the outer fold (this fold) is unfolded 84 Nested points to a standalone tree, the root node in the nested tree, does *not* point back to this node *) 85 86 87 (* Source Info *) 88 FoldIndex: Integer; (* Index of fold in line; if a line has more than one fold starting *) 89 FoldColumn, FoldColumnLen: Integer; (* The column (1-based) and len of the keywordm which starts this fold *) 90 FoldTypeCompatible: Pointer; (* help identifying in FixFolding *) 91 Classification: TFoldNodeClassification; 92 VisibleLines: Integer; (* Visible Source lines, containing the "fold keyword" 93 0: Hiden block (the fold-keyword is inside the fold) 94 1: Normal fold (There is *1* visible line with the fold-keyword) 95 *) 96 97 98 function RecursiveFoldCount : Integer; (* Amount of lines covered by this and all child nodes *) 99 function Precessor : TSynTextFoldAVLNodeData; reintroduce; 100 function Successor : TSynTextFoldAVLNodeData; reintroduce; 101 function Precessor(var aStartPosition, aSizesBeforeSum : Integer) : TSynTextFoldAVLNodeData; reintroduce; 102 function Successor(var aStartPosition, aSizesBeforeSum : Integer) : TSynTextFoldAVLNodeData; reintroduce; 103 end; 104 105 { TSynTextFoldAVLNode } 106 107 TSynTextFoldAVLNode = object 108 private 109 function GetClassification: TFoldNodeClassification; 110 function GetFoldColumn: Integer; 111 function GetFoldColumnLen: Integer; 112 function GetFoldIndex: Integer; 113 function GetMergedLineCount : Integer; 114 function GetFullCount : Integer; 115 function GetSourceLine: integer; 116 function GetSourceLineOffset: integer; 117 procedure SetFoldColumn(const AValue: Integer); 118 protected 119 fData : TSynTextFoldAVLNodeData; // nil if unfolded 120 fStartLine : Integer; // start of folded 121 fFoldedBefore : Integer; 122 public 123 procedure Init(aData : TSynTextFoldAVLNodeData; aStartLine, aFoldedBefore: Integer); 124 function IsInFold : Boolean; 125 function Next : TSynTextFoldAVLNode; 126 function Prev : TSynTextFoldAVLNode; 127 128 property MergedLineCount: Integer read GetMergedLineCount; // Zero, if Not in a fold 129 property FullCount: Integer read GetFullCount; // Zero, if Not in a fold 130 property StartLine: Integer read fStartLine; // 1st Line of Current Fold 131 property FoldedBefore: Integer read fFoldedBefore; // Count of Lines folded before Startline 132 133 function IsHide: Boolean; 134 property FoldIndex: Integer read GetFoldIndex; 135 property FoldColumn: Integer read GetFoldColumn write SetFoldColumn; 136 property FoldColumnLen: Integer read GetFoldColumnLen; 137 property SourceLine: integer read GetSourceLine; // The SourceLine with the fold-keyword 138 property SourceLineOffset: integer read GetSourceLineOffset; // The SourceLine with the fold-keyword 139 property Classification: TFoldNodeClassification read GetClassification; 140 end; 141 142 { TSynTextFoldAVLNodeNestedIterator: 143 Iterates included nested nodes 144 FoldedBefore is not valid in nested nodes 145 } 146 147 TSynTextFoldAVLNodeNestedIterator = class 148 private 149 FCurrentNode: TSynTextFoldAVLNode; 150 FOuterNodes: Array of TSynTextFoldAVLNode; 151 public 152 constructor Create(ANode: TSynTextFoldAVLNode); 153 destructor Destroy; override; 154 function Next: TSynTextFoldAVLNode; 155 function Prev: TSynTextFoldAVLNode; 156 function EOF: Boolean; 157 function BOF: Boolean; 158 function IsInFold: Boolean; 159 property Node: TSynTextFoldAVLNode read FCurrentNode; 160 end; 161 162 { TSynTextFoldAVLTree 163 - Nodes in the tree cover the folded lines only. 164 The (visible) cfCollapsed line at the start of a fold, is *not* part of a node. 165 - In the public methods "ALine" indicates the first invisible/hidden line 166 - TSynEditFoldedView uses this with 1-based lines (ToDo: make 0-based) 167 } 168 169 TSynTextFoldAVLTree = class(TSynSizedDifferentialAVLTree) 170 protected 171 fNestParent: TSynTextFoldAVLNodeData; 172 fNestedNodesTree: TSynTextFoldAVLTree; // FlyWeight Tree used for any nested subtree. 173 174 function NewNode : TSynTextFoldAVLNodeData; inline; 175 Function RemoveFoldForNodeAtLine(ANode: TSynTextFoldAVLNode; 176 ALine : Integer) : Integer; overload; // Line is for Nested Nodes 177 178 // SetRoot, does not obbey fRootOffset => use SetRoot(node, -fRootOffset) 179 procedure SetRoot(ANode : TSynSizedDifferentialAVLNode); overload; override; 180 procedure SetRoot(ANode : TSynSizedDifferentialAVLNode; anAdjustChildLineOffset : Integer); overload; override; 181 182 Function InsertNode(ANode : TSynTextFoldAVLNodeData) : Integer; reintroduce; // returns FoldedBefore // ANode may not have children 183 function TreeForNestedNode(ANode: TSynTextFoldAVLNodeData; aOffset : Integer) : TSynTextFoldAVLTree; 184 public 185 constructor Create; 186 destructor Destroy; override; 187 procedure Clear; override; 188 189 (* Find Fold by Line in Real Text *) 190 Function FindFoldForLine(ALine : Integer; FindNextNode : Boolean = False) : TSynTextFoldAVLNode; 191 (* Find Fold by Line in Folded Text // always returns unfolded, unless next=true *) 192 Function FindFoldForFoldedLine(ALine : Integer; FindNextNode: Boolean = False) : TSynTextFoldAVLNode; 193 Function InsertNewFold(ALine, AFoldIndex, AColumn, AColumnLen, ACount, AVisibleLines: Integer; 194 AClassification: TFoldNodeClassification; 195 AFoldTypeCompatible: Pointer 196 ) : TSynTextFoldAVLNode; 197 (* This will unfold the block which either contains tALine, or has Aline as its cgColapsed line 198 If IgnoreFirst, the cfCollapsed will *not* unfold => Hint: IgnoreFirst = Make folded visible 199 Returns the pos(1-based) of the cfCollapsed Line that was expanded; or ALine, if nothing was done 200 *) 201 Function RemoveFoldForLine(ALine : Integer; OnlyCol: Integer = -1) : Integer; overload; 202 Procedure AdjustForLinesInserted(AStartLine, ALineCount, ABytePos: Integer); 203 Procedure AdjustForLinesDeleted(AStartLine, ALineCount, ABytePos: Integer); 204 procedure AdjustColumn(ALine, ABytePos, ACount: Integer; InLineBreak: boolean = False); 205 Function FindLastFold : TSynTextFoldAVLNode; 206 Function FindFirstFold : TSynTextFoldAVLNode; 207 Function LastFoldedLine : integer; // The actual line; LastNode.StartLine + LastNode.LineCount - 1 208 {$IFDEF SynDebug} 209 procedure Debug; reintroduce; 210 {$ENDIF} 211 end; 212 213 { TSynFoldNodeInfoHelper } 214 215 TSynFoldNodeInfoHelper = class 216 FCurInfo: TSynFoldNodeInfo; 217 FActions: TSynFoldActions; 218 FHighlighter: TSynCustomFoldHighlighter; 219 protected 220 procedure Invalidate; 221 public 222 constructor Create(AHighlighter: TSynCustomFoldHighlighter); 223 224 function FirstOpen: TSynFoldNodeInfo; 225 function Next: TSynFoldNodeInfo; 226 function Prev: TSynFoldNodeInfo; 227 function FindClose: TSynFoldNodeInfo; 228 function GotoOpenPos(aLineIdx, aNodeIdx: integer): TSynFoldNodeInfo; 229 function GotoOpenAtChar(aLineIdx, aXPos: integer): TSynFoldNodeInfo; 230 function GotoNodeOpenPos(ANode : TSynTextFoldAVLNode): TSynFoldNodeInfo; 231 function GotoNodeClosePos(ANode : TSynTextFoldAVLNode): TSynFoldNodeInfo; 232 function IsAtNodeOpenPos(ANode : TSynTextFoldAVLNode): Boolean; 233 function IsValid: Boolean; 234 function Equals(AnInfo: TSynFoldNodeInfo): Boolean; 235 function Equals(AHelper: TSynFoldNodeInfoHelper): Boolean; 236 237 property Info: TSynFoldNodeInfo read FCurInfo write FCurInfo; 238 property Actions: TSynFoldActions read FActions write FActions; 239 end; 240 241 TFoldChangedEvent = procedure(aLine: Integer) of object; 242 TInvalidateLineProc = procedure(FirstLine, LastLine: integer) of object; 243 244 TFoldViewNodeInfo = record 245 HNode: TSynFoldNodeInfo; // Highlighter Node 246 FNode: TSynTextFoldAVLNode; // AvlFoldNode 247 Text, Keyword: String; 248 LineNum, ColIndex: Integer; 249 OpenCount: Integer; // Highlighter-Nodes opening on this line (limited to the FoldGroup requested) 250 end; 251 252 TSynEditFoldLineCapability = ( 253 // Capabilities of Line 254 cfFoldStart, cfHideStart, 255 cfFoldBody, 256 cfFoldEnd, 257 // State indicators 258 cfCollapsedFold, 259 cfCollapsedHide, // lines hidden, after this line 260 // Special flags 261 cfSingleLineHide, 262 cfNone 263 ); 264 TSynEditFoldLineCapabilities = set of TSynEditFoldLineCapability; 265 TSynEditFoldType = (scftOpen, scftFold, scftHide, scftAll, scftInvalid); 266 267 TSynEditFoldLineMapInfo = record 268 Capability: TSynEditFoldLineCapabilities; 269 Classifications :TFoldNodeClassifications; 270 end; 271 272 {$IFDEF SynFoldSaveDebug} 273const 274 SynEditFoldTypeNames: Array [TSynEditFoldType] of string = 275 ('scftOpen', 'scftFold', 'scftHide', 'scftAll', 'scftInvalid'); 276type 277 {$ENDIF} 278 279 { TSynEditFoldProvider } 280 TSynEditFoldProviderNodeInfo = record 281 LineCount: Integer; 282 Column, ColumnLen: Integer; 283 DefaultCollapsed: Boolean; 284 FoldTypeCompatible: Pointer; // eg begin, var, procedure 285 FoldGroup: Integer; // eg.: pas, region, ifdef 286 Classification: TFoldNodeClassification; 287 end; 288 289 TSynEditFoldProviderNodeInfoList = array of TSynEditFoldProviderNodeInfo; 290 TSynEditFoldProvider = class; 291 292 TSynEditFoldProvider = class 293 private 294 FHighlighter: TSynCustomFoldHighlighter; 295 FLines : TSynEditStrings; 296 FSelection: TSynEditSelection; 297 FFoldTree : TSynTextFoldAVLTree; 298 FNestedFoldsList: TLazSynEditNestedFoldsList; 299 function GetFoldsAvailable: Boolean; 300 function GetHighLighterWithLines: TSynCustomFoldHighlighter; 301 function GetLineCapabilities(ALineIdx: Integer): TSynEditFoldLineCapabilities; 302 function GetLineClassification(ALineIdx: Integer): TFoldNodeClassifications; 303 function GetNestedFoldsList: TLazSynEditNestedFoldsList; 304 procedure SetHighLighter(const AValue: TSynCustomFoldHighlighter); 305 procedure SetLines(AValue: TSynEditStrings); 306 protected 307 property HighLighterWithLines: TSynCustomFoldHighlighter read GetHighLighterWithLines; 308 public 309 constructor Create(aTextView : TSynEditStrings; AFoldTree : TSynTextFoldAVLTree); 310 destructor Destroy; override; 311 312 // Info about Folds opening on ALineIdx 313 function FoldOpenCount(ALineIdx: Integer; AType: Integer = 0): Integer; 314 function FoldOpenInfo(ALineIdx, AFoldIdx: Integer; AType: Integer = 0): TSynFoldNodeInfo; 315 //property FoldOpenInfo[ALineIdx, AColumnIdx: Integer]: Integer read GetFoldOpenInfo; 316 317 function FoldLineLength(ALine, AFoldIndex: Integer): integer; 318 function InfoForFoldAtTextIndex(ALine, AFoldIndex : Integer; 319 HideLen: Boolean = False; 320 NeedLen: Boolean = True): TSynEditFoldProviderNodeInfo; 321 function InfoListForFoldsAtTextIndex(ALine: Integer; NeedLen: Boolean = False): TSynEditFoldProviderNodeInfoList; 322 323 property LineCapabilities[ALineIdx: Integer]: TSynEditFoldLineCapabilities 324 read GetLineCapabilities; 325 property LineClassification[ALineIdx: Integer]: TFoldNodeClassifications 326 read GetLineClassification; 327 property Lines: TSynEditStrings read FLines write SetLines; 328 property HighLighter: TSynCustomFoldHighlighter read FHighlighter write SetHighLighter; 329 property FoldsAvailable: Boolean read GetFoldsAvailable; 330 property NestedFoldsList: TLazSynEditNestedFoldsList read GetNestedFoldsList; 331 end; 332 333 { TFoldChangedHandlerList } 334 335 TFoldChangedHandlerList = class(TMethodList) 336 public 337 procedure CallFoldChangedEvents(AnIndex: Integer); 338 end; 339 340 TSynEditFoldedView = class; 341 342 { TLazSynDisplayFold } 343 344 TLazSynDisplayFold = class(TLazSynDisplayViewEx) 345 private 346 FFoldView: TSynEditFoldedView; 347 FLineState: integer; 348 FTokenAttr: TSynHighlighterAttributesModifier; 349 FMarkupLine: TSynSelectedColorMergeResult; 350 FLineFlags, FLineFlags2: TSynEditFoldLineCapabilities; 351 public 352 constructor Create(AFoldView: TSynEditFoldedView); 353 destructor Destroy; override; 354 procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx); override; 355 function GetNextHighlighterToken(out ATokenInfo: TLazSynDisplayTokenInfo): Boolean; override; 356 function GetLinesCount: Integer; override; 357 358 function TextToViewIndex(AIndex: TLineIdx): TLineRange; override; 359 function ViewToTextIndex(AIndex: TLineIdx): TLineIdx; override; 360 end; 361 362 { TSynTextFoldedView 363 *Line = Line (0-based) on Screen (except TopLine which should be TopViewPos) 364 *ViewPos = Line (1-based) in the array of viewable/visible lines 365 *TextIndex = Line (0-based) in the complete text(folded and unfolded) 366 } 367 368 TSynEditFoldedViewFlag = (fvfNeedCaretCheck, fvfNeedCalcMaps); 369 TSynEditFoldedViewFlags = set of TSynEditFoldedViewFlag; 370 371 { TSynEditFoldedView } 372 373 TSynEditFoldedView = class 374 private 375 fCaret: TSynEditCaret; 376 FBlockSelection: TSynEditSelection; 377 FFoldProvider: TSynEditFoldProvider; 378 fLines : TSynEditStrings; 379 fFoldTree : TSynTextFoldAVLTree; // Folds are stored 1-based (the 1st line is 1) 380 FMarkupInfoFoldedCode: TSynSelectedColor; 381 FMarkupInfoFoldedCodeLine: TSynSelectedColor; 382 FMarkupInfoHiddenCodeLine: TSynSelectedColor; 383 FOnLineInvalidate: TInvalidateLineProc; 384 fTopLine : Integer; 385 fLinesInWindow : Integer; // there may be an additional part visible line 386 fTextIndexList : Array of integer; (* Map each Screen line into a line in textbuffer *) 387 fFoldTypeList : Array of TSynEditFoldLineMapInfo; 388 fOnFoldChanged : TFoldChangedEvent; 389 fLockCount : Integer; 390 fNeedFixFrom, fNeedFixMinEnd : Integer; 391 FFlags: TSynEditFoldedViewFlags; 392 FInTopLineChanged: Boolean; 393 FDisplayView: TLazSynDisplayFold; 394 FFoldChangedHandlerList: TFoldChangedHandlerList; 395 396 function GetCount : integer; 397 function GetDisplayView: TLazSynDisplayView; 398 function GetFoldClasifications(index : Integer): TFoldNodeClassifications; 399 function GetHighLighter: TSynCustomHighlighter; 400 function GetLines(index : Integer) : String; 401 function GetDisplayNumber(index : Integer) : Integer; 402 function GetTextIndex(index : Integer) : Integer; 403 function GetFoldType(index : Integer) : TSynEditFoldLineCapabilities; 404 function IsFolded(index : integer) : Boolean; // TextIndex 405 procedure SetBlockSelection(const AValue: TSynEditSelection); 406 procedure SetHighLighter(AValue: TSynCustomHighlighter); 407 procedure SetTopLine(const ALine : integer); 408 function GetTopTextIndex : integer; 409 procedure SetTopTextIndex(const AIndex : integer); 410 procedure SetLinesInWindow(const AValue : integer); 411 procedure DoFoldChanged(AnIndex: Integer); 412 protected 413 procedure DoBlockSelChanged(Sender: TObject); 414 Procedure CalculateMaps; 415 function FoldNodeAtTextIndex(AStartIndex, ColIndex: Integer): TSynTextFoldAVLNode; (* Returns xth Fold at nth TextIndex (all lines in buffer) / 1-based *) 416 function FixFolding(AStart : Integer; AMinEnd : Integer; aFoldTree : TSynTextFoldAVLTree) : Boolean; 417 418 procedure DoCaretChanged(Sender : TObject); 419 Procedure LineCountChanged(Sender: TSynEditStrings; AIndex, ACount : Integer); 420 Procedure LinesCleared(Sender: TObject); 421 Procedure LineEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount, 422 aLineBrkCnt: Integer; aText: String); 423 Procedure LinesInsertedAtTextIndex(AStartIndex, ALineCount, ABytePos: Integer; 424 SkipFixFolding : Boolean = False); 425 //Procedure LinesInsertedAtViewPos(AStartPos, ALineCount : Integer; 426 // SkipFixFolding : Boolean = False); 427 Procedure LinesDeletedAtTextIndex(AStartIndex, ALineCount, ABytePos: Integer; 428 SkipFixFolding : Boolean = False); 429 //Procedure LinesDeletedAtViewPos(AStartPos, ALineCount : Integer; 430 // SkipFixFolding : Boolean = False); 431 property FoldTree: TSynTextFoldAVLTree read fFoldTree; 432 public 433 constructor Create(aTextView : TSynEditStrings; ACaret: TSynEditCaret); 434 destructor Destroy; override; 435 436 // Converting between Folded and Unfolded Lines/Indexes 437 function TextIndexToViewPos(aTextIndex : Integer) : Integer; (* Convert TextIndex (0-based) to ViewPos (1-based) *) 438 function TextIndexToScreenLine(aTextIndex : Integer) : Integer; (* Convert TextIndex (0-based) to Screen (0-based) *) 439 function ViewPosToTextIndex(aViewPos : Integer) : Integer; (* Convert ViewPos (1-based) to TextIndex (0-based) *) 440 function ScreenLineToTextIndex(aLine : Integer) : Integer; (* Convert Screen (0-based) to TextIndex (0-based) *) 441 442 function TextIndexAddLines(aTextIndex, LineOffset : Integer) : Integer; (* Add/Sub to/from TextIndex (0-based) skipping folded *) 443 function TextPosAddLines(aTextpos, LineOffset : Integer) : Integer; (* Add/Sub to/from TextPos (1-based) skipping folded *) 444 445 property BlockSelection: TSynEditSelection write SetBlockSelection; 446 // Attributes for Visible-Lines-On-screen 447 property Lines[index : Integer] : String (* Lines on screen / 0 = TopLine *) 448 read GetLines; default; 449 property DisplayNumber[index : Integer] : Integer (* LineNumber for display in Gutter / result is 1-based *) 450 read GetDisplayNumber; 451 property FoldType[index : Integer] : TSynEditFoldLineCapabilities (* FoldIcon / State *) 452 read GetFoldType; 453 property FoldClasifications[index : Integer] : TFoldNodeClassifications (* FoldIcon / State *) 454 read GetFoldClasifications; 455 property TextIndex[index : Integer] : Integer (* Position in SynTextBuffer / result is 0-based *) 456 read GetTextIndex; // maybe writable 457 458 // Define Visible Area 459 property TopLine : integer (* refers to visible (unfolded) lines / 1-based *) 460 read fTopLine write SetTopLine; 461 property TopTextIndex : integer (* refers to TextIndex (folded + unfolded lines) / 1-based *) 462 read GetTopTextIndex write SetTopTextIndex; 463 property LinesInWindow : integer (* Fully Visible lines in Window; There may be one half visible line *) 464 read fLinesInWindow write SetLinesInWindow; 465 466 property Count : integer read GetCount; (* refers to visible (unfolded) lines *) 467 468 property MarkupInfoFoldedCode: TSynSelectedColor read FMarkupInfoFoldedCode; 469 property MarkupInfoFoldedCodeLine: TSynSelectedColor read FMarkupInfoFoldedCodeLine; 470 property MarkupInfoHiddenCodeLine: TSynSelectedColor read FMarkupInfoHiddenCodeLine; 471 public 472 procedure Lock; 473 procedure UnLock; 474 {$IFDEF SynDebug} 475 procedure debug; 476 {$ENDIF} 477 (* Arguments for (Un)FoldAt* (Line, ViewPos, TextIndex): 478 - ColumnIndex (0-based) 479 Can be negative, to access the highest(-1) available, 2nd highest(-2) ... 480 If negative, count points downward 481 - ColCount = 0 => all 482 - Skip => Do not count nodes that are already in the desired state 483 (or can not archive the desired state: e.g. can not hide) 484 - AVisibleLines: 0 = Hide / 1 = Fold 485 *) 486 procedure FoldAtLine(AStartLine: Integer; ColIndex : Integer = -1; (* Folds at ScreenLine / 0-based *) 487 ColCount : Integer = 1; Skip: Boolean = False; 488 AVisibleLines: Integer = 1); 489 procedure FoldAtViewPos(AStartPos: Integer; ColIndex : Integer = -1; (* Folds at nth visible/unfolded Line / 1-based *) 490 ColCount : Integer = 1; Skip: Boolean = False; 491 AVisibleLines: Integer = 1); 492 procedure FoldAtTextIndex(AStartIndex: Integer; ColIndex : Integer = -1; (* Folds at nth TextIndex (all lines in buffer) / 1-based *) 493 ColCount : Integer = 1; Skip: Boolean = False; 494 AVisibleLines: Integer = 1); 495 procedure UnFoldAtLine(AStartLine: Integer; ColIndex : Integer = -1; (* UnFolds at ScreenLine / 0-based *) 496 ColCount : Integer = 0; Skip: Boolean = False; 497 AVisibleLines: Integer = 1); 498 procedure UnFoldAtViewPos(AStartPos: Integer; ColIndex : Integer = -1; (* UnFolds at nth visible/unfolded Line / 1-based *) 499 ColCount : Integer = 0; Skip: Boolean = False; 500 AVisibleLines: Integer = 1); 501 procedure UnFoldAtTextIndex(AStartIndex: Integer; ColIndex : Integer = -1; (* UnFolds at nth TextIndex (all lines in buffer) / 1-based *) 502 ColCount : Integer = 0; Skip: Boolean = False; 503 AVisibleLines: Integer = 1); 504 procedure UnFoldAtTextIndexCollapsed(AStartIndex: Integer); (* UnFolds only if Index is in the fold, ignores cfcollapsed line, if unfolded / 1-based *) 505 506 function LogicalPosToNodeIndex(AStartIndex: Integer; LogX: Integer; (* Returns the index of the node, at the logical char pos *) 507 Previous: Boolean = False): Integer; 508 509 procedure CollapseDefaultFolds; 510 // Load/Save folds to string 511 // AStartIndex, AEndIndex: (0 based) First/last line (EndIndex = -1 = open end) 512 // AStartCol, AEndCol: (1 based) Logical text pos in Line. (AEndCol = -1 = full line) 513 function GetFoldDescription(AStartIndex, AStartCol, AEndIndex, 514 AEndCol: Integer; AsText: Boolean = False; 515 Extended: Boolean = False) :String; 516 procedure ApplyFoldDescription(AStartIndex, AStartCol, AEndIndex, 517 AEndCol: Integer; FoldDesc: PChar; 518 FoldDescLen: Integer; IsText: Boolean = False); 519 520 procedure UnfoldAll; 521 procedure FoldAll(StartLevel : Integer = 0; IgnoreNested : Boolean = False); 522 procedure FixFoldingAtTextIndex(AStartIndex: Integer; AMinEndLine: Integer = 0); // Real/All lines 523 public 524 function OpenFoldCount(aStartIndex: Integer; AType: Integer = 0): Integer; 525 function OpenFoldInfo(aStartIndex, ColIndex: Integer; AType: Integer = 0): TFoldViewNodeInfo; 526 527 public 528 // Find the visible first line of the fold at ALine. Returns -1 if Aline is not folded 529 function CollapsedLineForFoldAtLine(ALine : Integer) : Integer; 530 function ExpandedLineForBlockAtLine(ALine : Integer; HalfExpanded: Boolean = True) : Integer; 531 532 procedure AddFoldChangedHandler(AHandler: TFoldChangedEvent); 533 procedure RemoveFoldChangedHandler(AHandler: TFoldChangedEvent); 534 535 function GetPhysicalCharWidths(Index: Integer): TPhysicalCharWidths; 536 537 function IsFoldedAtTextIndex(AStartIndex, ColIndex: Integer): Boolean; (* Checks xth Fold at nth TextIndex (all lines in buffer) / 1-based *) 538 property FoldedAtTextIndex [index : integer] : Boolean read IsFolded; 539 540 property OnFoldChanged: TFoldChangedEvent (* reports 1-based line *) {TODO: synedit expects 0 based } 541 read fOnFoldChanged write fOnFoldChanged; 542 property OnLineInvalidate: TInvalidateLineProc(* reports 1-based line *) {TODO: synedit expects 0 based } 543 read FOnLineInvalidate write FOnLineInvalidate; 544 property HighLighter: TSynCustomHighlighter read GetHighLighter 545 write SetHighLighter; 546 property FoldProvider: TSynEditFoldProvider read FFoldProvider; 547 548 property DisplayView: TLazSynDisplayView read GetDisplayView; 549 end; 550 551function dbgs(AClassification: TFoldNodeClassification): String; overload; 552 553implementation 554 555//var 556// SYN_FOLD_DEBUG: PLazLoggerLogGroup; 557 558type 559 TFoldExportEntry = Record 560 // Lines and Pos (o 1st line) are relative to Scan-Start 561 Line, LogX, LogX2: Integer; // StartLine and Pos 562 ELine, ELogX, ELogX2: Integer; // EndLine and pos 563 FType: Integer; // e.g ord(cfbtBeginEnd) 564 LinesFolded: Integer; // Lines Folded according to AVL-Node 565 end; 566 567 { TSynEditFoldExportStream } 568 569 TSynEditFoldExportStream = class 570 private 571 FData: String; 572 FLen, FPos: Integer; 573 FMem: PChar; 574 function GetLen: Integer; 575 procedure SetLen(const AValue: Integer); 576 function GetMem: PChar; 577 procedure SetMem(const AValue: PChar); 578 function GetText: String; 579 procedure SetText(const AValue: String); 580 protected 581 function GrowData(AppendSize: Integer): PChar; 582 function EncodeIntEx(Anum: Integer): String; // base 43, with leading continue bit 583 function EncodeIntEx2(Anum: Integer): String; // for numbers expected below 467; specially 0..80 584 function InternalReadNum(var APos: Integer): Integer; 585 function InternalReadNumEx(var APos: Integer): Integer; 586 public 587 constructor Create; 588 procedure Compress; 589 procedure Decompress; 590 591 procedure AddChecksum; 592 function VerifyChecksum: Boolean; 593 594 // see notes for Compression 595 Procedure AppendMem(AMem: Pointer; ALen: Integer); 596 Procedure AppendString(ATxt: String); 597 Procedure AppendNum(ANum: Integer); 598 Procedure AppendNumEx(ANum: Integer); 599 600 Procedure Reset; 601 Procedure Clear; 602 function ReadMem(AMem: Pointer; ALen: Integer): Boolean; 603 function PeakString(ALen: Integer): String; 604 function FindChar(AChar: Char): Integer; // 0 based 605 function ReadString(ALen: Integer): String; 606 function ReadNum: Integer; 607 function ReadNumEx: Integer; 608 function EOF: Boolean; 609 610 property Text: String read GetText write SetText; 611 property Mem: PChar read GetMem write SetMem; 612 property Len: Integer read GetLen write SetLen; 613 property Pos: Integer read FPos; 614 end; 615 616 TSynEditFoldExportCoderEntry = record 617 aX, aY, aLen: Integer; 618 aFoldType: TSynEditFoldType; 619 end; 620 TSynEditFoldExportCoderStates = 621 (sfecAtBegin, sfecAtPoint, sfecInRepeatCount, sfecInvalid, sfecAtEOF); 622 {$IFDEF SynFoldSaveDebug} 623const 624 SynEditFoldExportCoderStates: Array [TSynEditFoldExportCoderStates] of String = 625 ('sfecAtBegin', 'sfecAtPoint', 'sfecInRepeatCount', 'sfecInvalid', 'sfecAtEOF'); 626type 627 {$ENDIF} 628 629 { TSynEditFoldExportCoder } 630 631 TSynEditFoldExportCoder = class 632 private 633 FExportStream: TSynEditFoldExportStream; 634 FFoldType: Pointer; 635 636 FReadY, FReadLastY, FReadX, FReadSumLen, FReadCount: Integer; 637 FReadType: TSynEditFoldType; 638 FReadDefaultType: TSynEditFoldType; 639 FReadState: TSynEditFoldExportCoderStates; 640 641 FWriteCache: Array of TSynEditFoldExportCoderEntry; 642 FWriteCacheLen: Integer; 643 FWriteCacheTypes: set of TSynEditFoldType; 644 function GetReadIsValid: Boolean; 645 public 646 constructor Create(AFoldType: Pointer); 647 constructor Create(AStream: TSynEditFoldExportStream); 648 destructor Destroy; override; 649 650 procedure AddNode(aX, aY, aLen: Integer; aFoldType: TSynEditFoldType); 651 procedure Finish; 652 653 function ReadNode(aX, aY: Integer; aLen: Integer): TSynEditFoldType; 654 function EOF: Boolean; 655 procedure Reset; 656 property ReadIsValid: Boolean read GetReadIsValid; 657 658 property FoldType: Pointer read FFoldType; 659 property Stream: TSynEditFoldExportStream read FExportStream; 660 end; 661 662const 663 // use only xml encode-able ascii 664 // do not use [ or ], they are reserved for compression 665 // space can be used a special indicator 666 NumEncode86Chars: string[86] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-+;:,.@=*/\!?$%()''^{}~_#'; 667 668 NumEncodeAsOneMax = 80; // Maximum Value to encode as 1 char 669 NumEncodeAsTwoMax = 81 + 4*86 + 43; // = 467; Maximum Value to encode as 2 char 670 NumEncodeAsThreeMax = 81 + 4*86 + 43 * 43 - 1; // = 2273 Maximum Value to encode as 3 char 671 672 673 SEQMaxNodeCount = 75; // New Full entry at least every 75 folds 674 SEQMaxLineDistEach = 500; // New Full entry, if folds startlines are more than 500 appart 675 SEQMaxLineDistTotal = 2500; // New Full entry at least every 2500; check position 676 677var 678 NumEncode86Values: Array [Char] of integer; 679 680procedure InitNumEncodeValues; 681var 682 i: integer; 683 c : Char; 684begin 685 for c := low(Char) to high(Char) do begin 686 NumEncode86Values[c] := -1; 687 end; 688 for i := 1 to length(NumEncode86Chars) do 689 NumEncode86Values[NumEncode86Chars[i]] := i - 1; 690end; 691 692{ TFoldChangedHandlerList } 693 694procedure TFoldChangedHandlerList.CallFoldChangedEvents(AnIndex: Integer); 695var 696 i: LongInt; 697begin 698 i:=Count; 699 while NextDownIndex(i) do 700 TFoldChangedEvent(Items[i])(AnIndex); 701end; 702 703{ TLazSynDisplayFold } 704 705constructor TLazSynDisplayFold.Create(AFoldView: TSynEditFoldedView); 706begin 707 inherited Create; 708 FFoldView := AFoldView; 709 FTokenAttr := TSynHighlighterAttributesModifier.Create(nil); 710 FMarkupLine := TSynSelectedColorMergeResult.Create(nil); 711end; 712 713destructor TLazSynDisplayFold.Destroy; 714begin 715 FreeAndNil(FTokenAttr); 716 FreeAndNil(FMarkupLine); 717 inherited Destroy; 718end; 719 720procedure TLazSynDisplayFold.SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx); 721begin 722 FLineState := 0; 723 CurrentTokenLine := ALine; 724 FLineFlags := FFoldView.FoldType[CurrentTokenLine + 1 - FFoldView.TopLine] * [cfCollapsedFold, cfCollapsedHide]; 725 FLineFlags2 := FLineFlags; 726 727 if not FFoldView.MarkupInfoFoldedCodeLine.IsEnabled then 728 Exclude(FLineFlags2, cfCollapsedFold); 729 if not FFoldView.MarkupInfoHiddenCodeLine.IsEnabled then 730 Exclude(FLineFlags2, cfCollapsedHide); 731 732 if (FLineFlags2 <> []) then begin 733 FFoldView.MarkupInfoFoldedCodeLine.SetFrameBoundsLog(1, MaxInt, 0); 734 FFoldView.MarkupInfoHiddenCodeLine.SetFrameBoundsLog(1, MaxInt, 0); 735 end; 736 737 inherited SetHighlighterTokensLine(FFoldView.ViewPosToTextIndex(ALine + 1), ARealLine); 738end; 739 740function TLazSynDisplayFold.GetNextHighlighterToken(out ATokenInfo: TLazSynDisplayTokenInfo): Boolean; 741const 742 MarkSpaces: string = ' '; 743 MarkDots: string = '...'; 744 LSTATE_BOL = 0; // at BOL 745 LSTATE_TEXT = 1; // in text 746 LSTATE_BOL_GAP = 2; // BOL and in Gap (empty line) // must be LSTATE_BOL + 2 747 LSTATE_GAP = 3; // In Gap betwen txt and dots // must be LSTATE_TEXT + 2 748 LSTATE_DOTS = 4; // In Dots 749 LSTATE_EOL = 5; // at start of EOL 750var 751 EolAttr: TSynHighlighterAttributes; 752 MergeStartX, MergeEndX: TLazSynDisplayTokenBound; 753begin 754 case FLineState of 755 LSTATE_BOL, LSTATE_TEXT: begin 756 Result := inherited GetNextHighlighterToken(ATokenInfo); 757 if ( (not Result) or (ATokenInfo.TokenStart = nil)) and (FLineFlags <> []) 758 then begin 759 inc(FLineState, 2); // LSTATE_BOL_GAP(2), if was at bol // LSTATE_GAP(3) otherwise 760 ATokenInfo.TokenStart := PChar(MarkSpaces); 761 ATokenInfo.TokenLength := 3; 762 if Assigned(CurrentTokenHighlighter) 763 then EolAttr := CurrentTokenHighlighter.GetEndOfLineAttribute 764 else EolAttr := nil; 765 if EolAttr <> nil then begin 766 FTokenAttr.Assign(EolAttr); 767 ATokenInfo.TokenAttr := FTokenAttr; 768 end 769 else begin 770 ATokenInfo.TokenAttr := nil; 771 end; 772 Result := True; 773 end; 774 end; 775 LSTATE_GAP: begin 776 FLineState := LSTATE_DOTS; 777 FTokenAttr.Assign(FFoldView.MarkupInfoFoldedCode); 778 FTokenAttr.SetAllPriorities(MaxInt); 779 ATokenInfo.TokenStart := PChar(MarkDots); 780 ATokenInfo.TokenLength := 3; 781 ATokenInfo.TokenAttr := FTokenAttr; 782 Result := True; 783 end; 784 else begin 785 Result := inherited GetNextHighlighterToken(ATokenInfo); 786 end; 787 end; 788 789 if (FLineFlags2 <> []) then begin 790 FMarkupLine.Clear; 791 if ATokenInfo.TokenAttr = nil then begin 792 // Text Area does not expect StartX/Endx 793 // So we must merge, to eliminate unwanted borders 794 // if (cfCollapsedFold in FLineFlags2) 795 // then ATokenInfo.TokenAttr := FFoldView.MarkupInfoFoldedCodeLine 796 // else ATokenInfo.TokenAttr := FFoldView.MarkupInfoHiddenCodeLine; 797 // exit; 798 FMarkupLine.Clear; 799 end //; 800 else 801 FMarkupLine.Assign(ATokenInfo.TokenAttr); 802 803 MergeStartX.Physical := -1; 804 MergeStartX.Logical := -1; 805 MergeEndX.Physical := -1; 806 MergeEndX.Logical := -1; 807 if FLineState in [LSTATE_BOL, LSTATE_BOL_GAP] then 808 MergeStartX := FFoldView.MarkupInfoFoldedCodeLine.StartX; 809 if FLineState = LSTATE_EOL then // LSTATE_GAP; // or result := true 810 MergeEndX := FFoldView.MarkupInfoFoldedCodeLine.EndX; 811 812 // fully expand all frames 813 //FMarkupLine.SetFrameBoundsLog(0,0,0); 814 //FMarkupLine.CurrentStartX := FMarkupLine.StartX; 815 //FMarkupLine.CurrentEndX := FMarkupLine.EndX; 816 817 if (cfCollapsedFold in FLineFlags2) then 818 FMarkupLine.Merge(FFoldView.MarkupInfoFoldedCodeLine, MergeStartX, MergeEndX) 819 else 820 FMarkupLine.Merge(FFoldView.MarkupInfoHiddenCodeLine, MergeStartX, MergeEndX); 821 822 ATokenInfo.TokenAttr := FMarkupLine; 823 end; 824 825 if FLineState in [LSTATE_BOL, LSTATE_BOL_GAP, LSTATE_DOTS, LSTATE_EOL] then 826 inc(FLineState); 827end; 828 829function TLazSynDisplayFold.GetLinesCount: Integer; 830begin 831 Result := FFoldView.Count; 832end; 833 834function TLazSynDisplayFold.TextToViewIndex(AIndex: TLineIdx): TLineRange; 835begin 836 Result := inherited TextToViewIndex(AIndex); 837 if Result.Top = Result.Bottom then begin 838 Result.Top := FFoldView.TextIndexToViewPos(Result.Top) - 1; 839 Result.Bottom := Result.Top; 840 end 841 else begin; 842 Result.Top := FFoldView.TextIndexToViewPos(Result.Top) - 1; 843 Result.Bottom := FFoldView.TextIndexToViewPos(Result.Bottom) - 1; 844 end; 845end; 846 847function TLazSynDisplayFold.ViewToTextIndex(AIndex: TLineIdx): TLineIdx; 848begin 849 Result := FFoldView.ViewPosToTextIndex(inherited ViewToTextIndex(AIndex)+1); 850end; 851 852{ TSynEditFoldExportStream } 853 854constructor TSynEditFoldExportStream.Create; 855begin 856 inherited; 857 FPos := 0; 858 FLen := 0; 859 FMem := nil; 860end; 861 862 863function TSynEditFoldExportStream.GetLen: Integer; 864begin 865 Result := FLen; 866end; 867 868procedure TSynEditFoldExportStream.SetLen(const AValue: Integer); 869begin 870 FPos := 0; 871 FLen:= AValue; 872end; 873 874function TSynEditFoldExportStream.GetMem: PChar; 875begin 876 if FData <> '' then 877 Result := @FData[1] 878 else 879 Result := FMem; 880end; 881 882procedure TSynEditFoldExportStream.SetMem(const AValue: PChar); 883begin 884 FData := ''; 885 FMem := AValue; 886 FPos := 0; 887end; 888 889function TSynEditFoldExportStream.GetText: String; 890begin 891 // only valid for FData 892 SetLength(FData, FLen); 893 Result := FData; 894end; 895 896procedure TSynEditFoldExportStream.SetText(const AValue: String); 897begin 898 FData := AValue; 899 FMem := nil; 900 FPos := 0; 901end; 902 903function TSynEditFoldExportStream.GrowData(AppendSize: Integer): PChar; 904var 905 l: integer; 906begin 907 l := length(FData); 908 if l < FLen + AppendSize then 909 SetLength(FData, l + AppendSize + Max((l+AppendSize) div 4, 1024)); 910 Result := @FData[FLen + 1]; 911 inc(FLen, AppendSize); 912end; 913 914function TSynEditFoldExportStream.EncodeIntEx(Anum: Integer): String; 915var 916 n: integer; 917begin 918 // 0 - 42 => 1 byte 919 // 43 - 1848 => 2 byte 920 // 1849 - .... => 3 and more 921 Result := ''; 922 if ANum = 0 then Result := NumEncode86Chars[1]; 923 n := 0; 924 while ANum > 0 do begin 925 Result := NumEncode86Chars[1 + (Anum mod 43) + n] + Result; 926 ANum := ANum div 43; 927 n := 43; 928 end; 929end; 930 931function TSynEditFoldExportStream.EncodeIntEx2(Anum: Integer): String; 932var 933 n: Integer; 934begin 935 // 0 - 80 => 1 char 936 // 81 - 424 => 2 char (80 + 4 * 86) 937 // 425 - 467 => 2 char (len(EncodeIntEx) = 1) 938 // 468 - 2272 => 3 and more char 939 //2273 - .... => 4 and more char 940 Result := ''; 941 if Anum <= 80 then 942 Result := NumEncode86Chars[1 + Anum] 943 else 944 begin 945 n := (Anum-81) div 86; 946 if n <= 3 then 947 Result := NumEncode86Chars[1 + 81 + n] + NumEncode86Chars[1 + (Anum - 81) mod 86] 948 else 949 Result := NumEncode86Chars[1 + 85] + EncodeIntEx(Anum - 81 - 4*86); 950 end; 951end; 952 953function TSynEditFoldExportStream.InternalReadNum(var APos: Integer): Integer; 954var 955 n: Integer; 956begin 957 Result := 0; 958 while True do begin 959 if FPos >= FLen then exit(-1); 960 n := NumEncode86Values[(FMem + APos)^]; 961 if n < 43 then break; 962 dec(n, 43); 963 Result := Result * 43 + n; 964 inc(APos); 965 end; 966 Result := Result * 43 + n; 967 inc(APos); 968end; 969 970function TSynEditFoldExportStream.InternalReadNumEx(var APos: Integer): Integer; 971begin 972 if FPos >= FLen then exit(-1); 973 Result := NumEncode86Values[(FMem + APos)^]; 974 inc(APos); 975 if Result <= 80 then 976 exit; 977 if FPos >= FLen then exit(-1); 978 if Result < 85 then begin 979 Result := 81 + (Result-81)*86 + NumEncode86Values[(FMem + APos)^]; 980 inc(APos); 981 exit; 982 end; 983 Result := 81 + 4*86 + InternalReadNum(APos); 984end; 985 986procedure TSynEditFoldExportStream.Compress; 987(* Known Sequences: XX = Enc64Num (copy sequence from XX chars before) 988 NN = ENc22 Num / n = enc22digit (copy n bytes) 989 [XXn (up to 21 bytes, from up to 64*64 back) 990 [NNXX[ (more then 21 bytes, from up to 64*64 back) 991 ]X (3 bytes from max 64 back) 992 ]nx ( reocurring space,x times, ever n pos) 993const 994 max_single_len = 22 - 1; 995 *) 996var 997 CurPos, EndPos, SearchPos: Integer; 998 FndLen, FndPos, FndPos2: Integer; 999 BestLen, BestPos, BestPos2: Integer; 1000 s: string; 1001begin 1002 AppendString(#0); 1003 dec(FLen); 1004 1005 EndPos := FLen; 1006 CurPos := FLen - 3; 1007 while CurPos >= 4 do begin 1008 SearchPos := CurPos - 3; 1009 BestLen := 0; 1010 while (SearchPos >= 1) do begin 1011 if CompareMem(@FData[CurPos], @FData[SearchPos], 3) then begin 1012 FndLen := 3; 1013 FndPos := SearchPos; 1014 FndPos2 := CurPos; 1015 while (SearchPos + FndLen < FndPos2) and 1016 (FndPos2 + FndLen < EndPos - 1) and 1017 (FData[SearchPos + FndLen] = FData[CurPos + FndLen]) 1018 do 1019 inc(FndLen); 1020 while (FndPos > 1) and (FndPos + FndLen < FndPos2) and 1021 (FData[FndPos - 1] = FData[FndPos2 - 1]) do 1022 begin 1023 dec(FndPos); 1024 dec(FndPos2); 1025 inc(FndLen); 1026 end; 1027 1028 if (FndLen > BestLen) and 1029 ((FndPos2 - FndPos <= NumEncodeAsOneMax) or (FndLen >= 4)) and 1030 ((FndPos2 - FndPos <= NumEncodeAsTwoMax) or (FndLen >= 5)) and 1031 ((FndPos2 - FndPos <= NumEncodeAsThreeMax) or (FndLen >= 6)) 1032 then begin 1033 BestLen := FndLen; 1034 BestPos := FndPos; 1035 BestPos2 := FndPos2; 1036 end; 1037 end; 1038 dec(SearchPos); 1039 end; 1040 1041 s := ''; 1042 if (BestLen >= 4) then 1043 s := '[' + EncodeIntEx2(BestPos2 - BestPos) + EncodeIntEx2(BestLen) 1044 else 1045 if (BestLen = 3) and (BestPos2 - BestPos <= NumEncodeAsOneMax) then 1046 s := ']' + EncodeIntEx2(BestPos2 - BestPos); 1047 if (s<>'') and (length(s) < BestLen) then begin 1048 System.Move(s[1], FData[BestPos2], length(s)); 1049 System.Move(FData[BestPos2 + BestLen], FData[BestPos2 + length(s)], FLen + 1 - (BestPos2 + BestLen)); 1050 dec(FLen, BestLen - length(s)); 1051 EndPos := BestPos; 1052 CurPos := BestPos2 - 3; 1053 end 1054 else 1055 dec(CurPos); 1056 end; 1057end; 1058 1059procedure TSynEditFoldExportStream.Decompress; 1060var 1061 i, j, n: Integer; 1062 p, p2: PChar; 1063 NewLen: Integer; 1064begin 1065 // curently assumes that FMem points NOT at FData 1066 if FLen = 0 then 1067 exit; 1068 NewLen := 0; 1069 i := 0; 1070 while i < Flen do begin 1071 case (FMem+i)^ of 1072 '[' : 1073 begin 1074 inc(i); 1075 j := InternalReadNumEx(i); 1076 n := InternalReadNumEx(i); 1077 if (j < n) or (j > NewLen) then raise ESynEditError.Create('fold format error'); 1078 inc(NewLen, n); 1079 end; 1080 ']' : 1081 begin 1082 inc(i, 1); 1083 j := InternalReadNumEx(i); 1084 if (j < 3) or (j > NewLen) then raise ESynEditError.Create('fold format error'); 1085 inc(NewLen, 3); 1086 end; 1087 else 1088 begin 1089 inc(NewLen); 1090 inc(i); 1091 end; 1092 end; 1093 end; 1094 SetLength(FData, NewLen); 1095 1096 i := 0; 1097 p := PChar(FData); 1098 while i < Flen do begin 1099 case (FMem+i)^ of 1100 '[' : 1101 begin 1102 inc(i); 1103 j := InternalReadNumEx(i); 1104 n := InternalReadNumEx(i); 1105 p2 := p; 1106 while n > 0 do begin 1107 p^ := (p2 - j)^; 1108 inc(p); 1109 dec(j); 1110 dec(n); 1111 end; 1112 end; 1113 ']' : 1114 begin 1115 inc(i); 1116 j := InternalReadNumEx(i); 1117 p2 := p; 1118 for n := 0 to 2 do begin 1119 p^ := (p2 - j)^; 1120 inc(p); 1121 dec(j); 1122 end; 1123 end; 1124 else 1125 begin 1126 p^ := (FMem + i)^; 1127 inc(p); 1128 inc(i); 1129 end; 1130 end; 1131 end; 1132 1133 FLen := NewLen; 1134 FMem := PChar(FData); 1135 FPos := 0; 1136end; 1137 1138procedure TSynEditFoldExportStream.AddChecksum; 1139var 1140 i, c: Integer; 1141begin 1142 if FLen = 0 then 1143 exit; 1144 if FMem = nil then 1145 FMem := @FData[1]; 1146 c := 0; 1147 for i := 0 to FLen - 1 do 1148 c := c xor (ord((FMem + i)^) * (i+1)); 1149 c := (c mod 256) xor ((c div 256) mod 256) xor ((c div 65536) mod 256); 1150 AppendString(NumEncode86Chars[1 + (c mod 86)]); 1151end; 1152 1153function TSynEditFoldExportStream.VerifyChecksum: Boolean; 1154var 1155 i, c: Integer; 1156begin 1157 if FLen = 0 then 1158 exit(True); 1159 if FMem = nil then 1160 FMem := @FData[1]; 1161 dec(Flen); 1162 c := 0; 1163 for i := 0 to FLen - 1 do 1164 c := c xor (ord((FMem + i)^) * (i+1)); 1165 c := (c mod 256) xor ((c div 256) mod 256) xor ((c div 65536) mod 256); 1166 Result := (FMem + FLen)^ = NumEncode86Chars[1 + (c mod 86)]; 1167end; 1168 1169procedure TSynEditFoldExportStream.AppendMem(AMem: Pointer; ALen: Integer); 1170begin 1171 {$IFDEF SynFoldSaveDebug} 1172 DebugLn(['TSynEditFoldExportStream.AppendMem len=', ALen]); 1173 {$ENDIF} 1174 FMem := nil; 1175 if ALen > 0 then 1176 System.Move(AMem^, GrowData(ALen)^, ALen); 1177end; 1178 1179procedure TSynEditFoldExportStream.AppendString(ATxt: String); 1180var 1181 l: Integer; 1182begin 1183 {$IFDEF SynFoldSaveDebug} 1184 DebugLn(['TSynEditFoldExportStream.AppendString ', ATxt]); 1185 {$ENDIF} 1186 FMem := nil; 1187 l := length(ATxt); 1188 if l > 0 then 1189 System.Move(ATxt[1], GrowData(l)^, l); 1190end; 1191 1192procedure TSynEditFoldExportStream.AppendNum(ANum: Integer); 1193begin 1194 {$IFDEF SynFoldSaveDebug} 1195 DebugLn(['TSynEditFoldExportStream.AppendNum ', ANum]); 1196 {$ENDIF} 1197 FMem := nil; 1198 AppendString(EncodeIntEx(ANum)); 1199end; 1200 1201procedure TSynEditFoldExportStream.AppendNumEx(ANum: Integer); 1202begin 1203 {$IFDEF SynFoldSaveDebug} 1204 DebugLn(['TSynEditFoldExportStream.AppendNumEx ', ANum]); 1205 {$ENDIF} 1206 FMem := nil; 1207 AppendString(EncodeIntEx2(ANum)); 1208end; 1209 1210procedure TSynEditFoldExportStream.Reset; 1211begin 1212 FPos := 0; 1213 if (FMem = nil) and (FData <> '') then 1214 FMem := @FData[1]; 1215end; 1216 1217procedure TSynEditFoldExportStream.Clear; 1218begin 1219 FLen := 0; 1220 FMem := nil; 1221 FPos := 0; 1222 SetLength(FData, 0); 1223end; 1224 1225function TSynEditFoldExportStream.ReadMem(AMem: Pointer; ALen: Integer): Boolean; 1226begin 1227 Result := FPos+ ALen <= FLen; 1228 If not Result then 1229 exit; 1230 System.Move((FMem + FPos)^, AMem^, ALen); 1231 inc(FPos, ALen); 1232end; 1233 1234function TSynEditFoldExportStream.PeakString(ALen: Integer): String; 1235begin 1236 If not(FPos+ ALen <= FLen) then 1237 exit(''); 1238 SetLength(Result, ALen); 1239 if ALen > 0 then 1240 System.Move((FMem + FPos)^, Result[1], ALen); 1241end; 1242 1243function TSynEditFoldExportStream.FindChar(AChar: Char): Integer; 1244begin 1245 Result := 0; 1246 While (FPos + Result < FLen) and ((FMem + FPos + Result)^ <> AChar) do 1247 inc(Result); 1248 if FPos + Result = FLen then 1249 Result := -1; 1250end; 1251 1252function TSynEditFoldExportStream.ReadString(ALen: Integer): String; 1253begin 1254 If not(FPos+ ALen <= FLen) then 1255 exit(''); 1256 SetLength(Result, ALen); 1257 if ALen > 0 then 1258 System.Move((FMem + FPos)^, Result[1], ALen); 1259 inc(FPos, ALen); 1260end; 1261 1262function TSynEditFoldExportStream.ReadNum: Integer; 1263begin 1264 Result := InternalReadNum(FPos); 1265 {$IFDEF SynFoldSaveDebug} 1266 DebugLn(['TSynEditFoldExportStream.ReadNum ', Result]); 1267 {$ENDIF} 1268end; 1269 1270function TSynEditFoldExportStream.ReadNumEx: Integer; 1271begin 1272 Result := InternalReadNumEx(FPos); 1273 {$IFDEF SynFoldSaveDebug} 1274 DebugLn(['TSynEditFoldExportStream.ReadNumEx ', Result]); 1275 {$ENDIF} 1276end; 1277 1278function TSynEditFoldExportStream.EOF: Boolean; 1279begin 1280 Result := FPos >= FLen; 1281end; 1282 1283{ TSynEditFoldExportCoder } 1284 1285function TSynEditFoldExportCoder.GetReadIsValid: Boolean; 1286begin 1287 Result := FReadState <> sfecInvalid; 1288end; 1289 1290constructor TSynEditFoldExportCoder.Create(AFoldType: Pointer); 1291begin 1292 inherited Create; 1293 FExportStream := TSynEditFoldExportStream.Create; 1294 FExportStream.AppendString(' T'); // Type Marker 1295 FExportStream.AppendNum(PtrUInt(AFoldType)); 1296 FFoldType := AFoldType; 1297 FWriteCacheLen := 0; 1298 FWriteCache := nil; 1299 FWriteCacheTypes := []; 1300end; 1301 1302constructor TSynEditFoldExportCoder.Create(AStream: TSynEditFoldExportStream); 1303var 1304 i: Integer; 1305begin 1306 inherited Create; 1307 FExportStream := TSynEditFoldExportStream.Create; 1308 FReadState := sfecInvalid; 1309 if AStream.PeakString(2) <> ' T' then exit; 1310 1311 AStream.ReadString(2); 1312 1313 FFoldType := Pointer(PtrUInt(AStream.ReadNum)); 1314 while(true) do begin 1315 i := AStream.FindChar(' '); 1316 if i < 0 then i := AStream.Len - AStream.Pos; 1317 FExportStream.AppendString(AStream.ReadString(i)); 1318 if AStream.EOF or (AStream.PeakString(2) = ' T') then 1319 break; 1320 FExportStream.AppendString(AStream.ReadString(2)); 1321 end; 1322 {$IFDEF SynFoldSaveDebug} 1323 DebugLn(['TSynEditFoldExportCoder.Create(<from input-stream> FType=', dbgs(FFoldType), ' txtLen=', FExportStream.Len, ' Txt="', FExportStream.Text, '"']); 1324 {$ENDIF} 1325 Reset; 1326end; 1327 1328destructor TSynEditFoldExportCoder.Destroy; 1329begin 1330 FreeAndNil(FExportStream); 1331 Inherited; 1332end; 1333 1334procedure TSynEditFoldExportCoder.AddNode(aX, aY, aLen: Integer; aFoldType: TSynEditFoldType); 1335(* Format: [Num] <NumEX> 1336 ' T' [type] [yo] <X> <len> ( <c>* ' p' [sum] [yo] <X> <len> )* <c>* (' P' [sum] [yo] <X> <len>)? 1337 1338 ////////////////////////// 1339 // Version info 1340 V1 - no entries 1341 V2 July 2010 0.9.29 1342 - added fold-hide <HideInfo> 1343 1344 ////////////////////////// 1345 1346 <Stream> = { <TypeStream> }; 1347 1348 <TypeStream> = " T" <TypeId> <TypeData>; [* Stores all folds for the given type (eg cfbtBeginEnd) *] 1349 1350 <TypeId> = ord(cfbtBeginEnd) or similar 1351 <TypeData> = [<HideInfo>], 1352 <NodePos>, 1353 [ [<FoldList>,] [{ <FoldListEndCont>, <NodePos>, [<FoldList>] }] ], 1354 [ <FoldListEnd> ]; 1355 1356 1357 <FoldList> = [{ <ConsecutiveFoldedCount>, <ConsecutiveUnFoldedCount> }], 1358 <ConsecutiveFoldedCount>, 1359 ; 1360 [* NodePos: is the position of a folded node (of the type matching the current stream) 1361 ConsecutiveFoldedCount: more folded nodes of the same type, without any 1362 unfolded node (of this type) inbetween. 1363 ConsecutiveUnFoldedCount: amount of unfolded nodes (of this type) before the next folded node. 1364 *] 1365 1366 <NodePos> = <YOffset> <XPos> <len>; 1367 <YOffset> …
Large files files are truncated, but you can click here to view the full file