PageRenderTime 212ms CodeModel.GetById 30ms app.highlight 163ms RepoModel.GetById 1ms app.codeStats 1ms

/components/synedit/syneditfoldedview.pp

http://github.com/graemeg/lazarus
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