ADDED .fossil-settings/binary-glob Index: .fossil-settings/binary-glob ================================================================== --- /dev/null +++ .fossil-settings/binary-glob @@ -0,0 +1,8 @@ +*.png +*.jpg +*.jpeg +*.gif +*.bmp +*.ico +*.xcf +*.res ADDED .fossil-settings/binary-glob.no-warn Index: .fossil-settings/binary-glob.no-warn ================================================================== --- /dev/null +++ .fossil-settings/binary-glob.no-warn ADDED .fossil-settings/ignore-glob Index: .fossil-settings/ignore-glob ================================================================== --- /dev/null +++ .fossil-settings/ignore-glob @@ -0,0 +1,8 @@ +out/ +*.bak +*.lps +*/__history/ +*/backup/ +GPATH +GTAGS +GRTAGS ADDED .fossil-settings/ignore-glob.no-warn Index: .fossil-settings/ignore-glob.no-warn ================================================================== --- /dev/null +++ .fossil-settings/ignore-glob.no-warn ADDED notes/fossil-help-commit.txt Index: notes/fossil-help-commit.txt ================================================================== --- /dev/null +++ notes/fossil-help-commit.txt @@ -0,0 +1,81 @@ +Usage: f commit ?OPTIONS? ?FILE...? + +Create a new version containing all of the changes in the current +checkout. You will be prompted to enter a check-in comment unless +the comment has been specified on the command-line using "-m" or a +file containing the comment using -M. The editor defined in the +"editor" fossil option (see f help set) will be used, or from +the "VISUAL" or "EDITOR" environment variables (in that order) if +no editor is set. + +All files that have changed will be committed unless some subset of +files is specified on the command line. + +The --branch option followed by a branch name causes the new +check-in to be placed in a newly-created branch with the name +passed to the --branch option. + +Use the --branchcolor option followed by a color name (ex: +'#ffc0c0') to specify the background color of entries in the new +branch when shown in the web timeline interface. The use of +the --branchcolor option is not recommend. Instead, let Fossil +choose the branch color automatically. + +The --bgcolor option works like --branchcolor but only sets the +background color for a single check-in. Subsequent check-ins revert +to the default color. + +A check-in is not permitted to fork unless the --allow-fork option +appears. An empty check-in (i.e. with nothing changed) is not +allowed unless the --allow-empty option appears. A check-in may not +be older than its ancestor unless the --allow-older option appears. +If any of files in the check-in appear to contain unresolved merge +conflicts, the check-in will not be allowed unless the +--allow-conflict option is present. In addition, the entire +check-in process may be aborted if a file contains content that +appears to be binary, Unicode text, or text with CR/NL line endings +unless the interactive user chooses to proceed. If there is no +interactive user or these warnings should be skipped for some other +reason, the --no-warnings option may be used. A check-in is not +allowed against a closed leaf. + +If a commit message is blank, you will be prompted: +("continue (y/N)?") to confirm you really want to commit with a +blank commit message. The default value is "N", do not commit. + +The --private option creates a private check-in that is never synced. +Children of private check-ins are automatically private. + +The --tag option applies the symbolic tag name to the check-in. + +The --sha1sum option detects edited files by computing each file's +SHA1 hash rather than just checking for changes to its size or mtime. + +Options: + --allow-conflict allow unresolved merge conflicts + --allow-empty allow a commit with no changes + --allow-fork allow the commit to fork + --allow-older allow a commit older than its ancestor + --baseline use a baseline manifest in the commit process + --bgcolor COLOR apply COLOR to this one check-in only + --branch NEW-BRANCH-NAME check in to this new branch + --branchcolor COLOR apply given COLOR to the branch + --close close the branch being committed + --delta use a delta manifest in the commit process + --integrate close all merged-in branches + -m|--comment COMMENT-TEXT use COMMENT-TEXT as commit comment + -M|--message-file FILE read the commit comment from given file + --mimetype MIMETYPE mimetype of check-in comment + -n|--dry-run If given, display instead of run actions + --no-warnings omit all warnings about file contents + --nosign do not attempt to sign this commit with gpg + --private do not sync changes and their descendants + --sha1sum verify file status using SHA1 hashing rather + than relying on file mtimes + --tag TAG-NAME assign given tag TAG-NAME to the checkin + +See also: branch, changes, checkout, extras, sync + + +^ +-(([a-z0-9])\|-)?(-([a-z0-9-]+))( ([A-Z0-9-]+))* +(.*) +short: '\2'; long: '\4'; param: '\6'; help: '\7' ADDED notes/utf-8 support.md Index: notes/utf-8 support.md ================================================================== --- /dev/null +++ notes/utf-8 support.md @@ -0,0 +1,24 @@ +# UTF-8 support in the Wide Diff view + +## Steps + +1. ✔ Make `FColDefs` a fixed-size array. Populate this as far as possible with the default values during construction. +2. ✔ Include both char and text indices (start, length) in `TSHColDef`. +3. ✔ In `SetLine`, when processing the header '=', adjust the char positions and lengths. +4. ✔ In `SetLine`, when processing a diff line ' ': + * ✔ Scan the entire text line, keeping track of both byte and char indices. (This means we won't have + to keep scanning for positions in text). + * ✔ Populate the entire array of **FColDefs** as we go, only don't differentiate between the three content columns yet. + * ✔ Put aside both left and right content. + * In the case of a '|' modified line: + * ✔ Define three subcolumns each for both left and right content. + * ✔ `TSHSubColDef` contains the regular `TSHColDef` fields, ~~plus `Text: string`~~. _(not necessary)_ + * ✔ Compare the left and right content, and split both up in 3 same/diff/same subcols. +5. ✔ In `Next`, step through the **FColDef**s. + * ✔ Only in the case of a '|' modified line, when in either content column, navigate the appropriate subcolumns instead. + +## Performance + +* ~~Our current implementation of CharLength, CopyChars etc. is quite slow. + The steps outlined above ought to reduce the need for these functions, but once we know which ones we'll need, + we should reimplement them. Probably using `PChar` and `Inc()`, while guarding for buffer overruns.~~ _We only need to scan every line once, in SetLine. This only requires `ByteType` function, and its performance is adequate._ ADDED src/a_commitmessage.lfm Index: src/a_commitmessage.lfm ================================================================== --- /dev/null +++ src/a_commitmessage.lfm @@ -0,0 +1,696 @@ +object frameCommitMessage: TframeCommitMessage + Left = 0 + Height = 240 + Top = 0 + Width = 631 + ClientHeight = 240 + ClientWidth = 631 + TabOrder = 0 + DesignLeft = 671 + DesignTop = 450 + object pnlOptions: TPanel + Left = 0 + Height = 50 + Top = 0 + Width = 631 + Align = alTop + BevelOuter = bvNone + ClientHeight = 50 + ClientWidth = 631 + TabOrder = 0 + object tbrMessage: TToolBar + Left = 0 + Height = 27 + Top = 0 + Width = 631 + Caption = 'tbrMessage' + EdgeBorders = [] + Images = modMain.imlMain + ShowCaptions = True + TabOrder = 2 + object btnBranch: TToolButton + Left = 1 + Top = 0 + AutoSize = True + Caption = 'Branch' + OnClick = btnBranchClick + end + object btnOptions: TToolButton + AnchorSideRight.Control = tbrMessage + AnchorSideRight.Side = asrBottom + Left = 54 + Top = 0 + Caption = 'Options' + DropdownMenu = pumOptions + OnClick = btnOptionsClick + Style = tbsDropDown + end + object btnMessage: TToolButton + Left = 126 + Top = 0 + Caption = 'Message' + DropdownMenu = pumMessages + OnClick = btnOptionsClick + ParentShowHint = False + ShowHint = True + Style = tbsDropDown + end + object btnTags: TToolButton + Left = 204 + Top = 0 + Caption = 'Tags' + DropdownMenu = pumTags + OnClick = btnTagsClick + Style = tbsDropDown + end + object btnBGColor: TColorButton + Left = 279 + Height = 22 + Hint = 'Background color' + Top = 0 + Width = 75 + BorderWidth = 2 + ButtonColorSize = 16 + ButtonColor = clNone + ColorDialog = dlgColor + Caption = 'BG' + Flat = True + Layout = blGlyphRight + OnColorChanged = btnBGColorColorChanged + end + object chkBGColor: TCheckBox + Left = 255 + Height = 23 + Top = 0 + Width = 24 + TabOrder = 0 + end + end + object btnCommit: TButton + Left = 555 + Height = 25 + Top = 1 + Width = 75 + Anchors = [akTop, akRight] + Caption = 'Commit' + Enabled = False + OnClick = btnCommitClick + TabOrder = 0 + end + object lblSelectedOptions: TLabel + Left = 9 + Height = 20 + Top = 31 + Width = 114 + Caption = 'Selected options:' + ParentColor = False + ShowAccelChar = False + end + object btnStash: TButton + Left = 471 + Height = 25 + Top = 1 + Width = 75 + Anchors = [akTop, akRight] + Caption = 'Stash' + OnClick = btnStashClick + TabOrder = 1 + end + end + object sbrMessage: TStatusBar + Left = 0 + Height = 29 + Top = 211 + Width = 631 + Panels = <> + end + inline synMessage: TSynEdit + Left = 0 + Height = 161 + Top = 50 + Width = 631 + Align = alClient + Font.Height = 15 + Font.Name = 'Monaco' + Font.Pitch = fpFixed + Font.Quality = fqCleartype + ParentColor = False + ParentFont = False + TabOrder = 2 + OnKeyDown = synMessageKeyDown + OnClickLink = synMessageClickLink + OnMouseWheel = synMessageMouseWheel + Gutter.Width = 10 + Gutter.MouseActions = <> + RightGutter.Width = 0 + RightGutter.MouseActions = <> + Keystrokes = < + item + Command = ecUp + ShortCut = 38 + end + item + Command = ecSelUp + ShortCut = 8230 + end + item + Command = ecScrollUp + ShortCut = 16422 + end + item + Command = ecDown + ShortCut = 40 + end + item + Command = ecSelDown + ShortCut = 8232 + end + item + Command = ecScrollDown + ShortCut = 16424 + end + item + Command = ecLeft + ShortCut = 37 + end + item + Command = ecSelLeft + ShortCut = 8229 + end + item + Command = ecWordLeft + ShortCut = 16421 + end + item + Command = ecSelWordLeft + ShortCut = 24613 + end + item + Command = ecRight + ShortCut = 39 + end + item + Command = ecSelRight + ShortCut = 8231 + end + item + Command = ecWordRight + ShortCut = 16423 + end + item + Command = ecSelWordRight + ShortCut = 24615 + end + item + Command = ecPageDown + ShortCut = 34 + end + item + Command = ecSelPageDown + ShortCut = 8226 + end + item + Command = ecPageBottom + ShortCut = 16418 + end + item + Command = ecSelPageBottom + ShortCut = 24610 + end + item + Command = ecPageUp + ShortCut = 33 + end + item + Command = ecSelPageUp + ShortCut = 8225 + end + item + Command = ecPageTop + ShortCut = 16417 + end + item + Command = ecSelPageTop + ShortCut = 24609 + end + item + Command = ecLineStart + ShortCut = 36 + end + item + Command = ecSelLineStart + ShortCut = 8228 + end + item + Command = ecEditorTop + ShortCut = 16420 + end + item + Command = ecSelEditorTop + ShortCut = 24612 + end + item + Command = ecLineEnd + ShortCut = 35 + end + item + Command = ecSelLineEnd + ShortCut = 8227 + end + item + Command = ecEditorBottom + ShortCut = 16419 + end + item + Command = ecSelEditorBottom + ShortCut = 24611 + end + item + Command = ecToggleMode + ShortCut = 45 + end + item + Command = ecCopy + ShortCut = 16429 + end + item + Command = ecPaste + ShortCut = 8237 + end + item + Command = ecDeleteChar + ShortCut = 46 + end + item + Command = ecCut + ShortCut = 8238 + end + item + Command = ecDeleteLastChar + ShortCut = 8 + end + item + Command = ecDeleteLastChar + ShortCut = 8200 + end + item + Command = ecDeleteLastWord + ShortCut = 16392 + end + item + Command = ecUndo + ShortCut = 32776 + ShortCut2 = 16474 + end + item + Command = ecRedo + ShortCut = 40968 + ShortCut2 = 24666 + end + item + Command = ecLineBreak + ShortCut = 13 + end + item + Command = ecSelectAll + ShortCut = 16449 + end + item + Command = ecCopy + ShortCut = 16451 + end + item + Command = ecBlockIndent + ShortCut = 24649 + end + item + Command = ecLineBreak + ShortCut = 16461 + end + item + Command = ecInsertLine + ShortCut = 16462 + end + item + Command = ecDeleteWord + ShortCut = 16468 + end + item + Command = ecBlockUnindent + ShortCut = 24661 + end + item + Command = ecPaste + ShortCut = 16470 + end + item + Command = ecCut + ShortCut = 16472 + end + item + Command = ecDeleteLine + ShortCut = 16473 + end + item + Command = ecDeleteEOL + ShortCut = 24665 + end + item + Command = ecUndo + ShortCut = 16474 + end + item + Command = ecRedo + ShortCut = 24666 + end + item + Command = ecGotoMarker0 + ShortCut = 16432 + end + item + Command = ecGotoMarker1 + ShortCut = 16433 + end + item + Command = ecGotoMarker2 + ShortCut = 16434 + end + item + Command = ecGotoMarker3 + ShortCut = 16435 + end + item + Command = ecGotoMarker4 + ShortCut = 16436 + end + item + Command = ecGotoMarker5 + ShortCut = 16437 + end + item + Command = ecGotoMarker6 + ShortCut = 16438 + end + item + Command = ecGotoMarker7 + ShortCut = 16439 + end + item + Command = ecGotoMarker8 + ShortCut = 16440 + end + item + Command = ecGotoMarker9 + ShortCut = 16441 + end + item + Command = ecSetMarker0 + ShortCut = 24624 + end + item + Command = ecSetMarker1 + ShortCut = 24625 + end + item + Command = ecSetMarker2 + ShortCut = 24626 + end + item + Command = ecSetMarker3 + ShortCut = 24627 + end + item + Command = ecSetMarker4 + ShortCut = 24628 + end + item + Command = ecSetMarker5 + ShortCut = 24629 + end + item + Command = ecSetMarker6 + ShortCut = 24630 + end + item + Command = ecSetMarker7 + ShortCut = 24631 + end + item + Command = ecSetMarker8 + ShortCut = 24632 + end + item + Command = ecSetMarker9 + ShortCut = 24633 + end + item + Command = EcFoldLevel1 + ShortCut = 41009 + end + item + Command = EcFoldLevel2 + ShortCut = 41010 + end + item + Command = EcFoldLevel1 + ShortCut = 41011 + end + item + Command = EcFoldLevel1 + ShortCut = 41012 + end + item + Command = EcFoldLevel1 + ShortCut = 41013 + end + item + Command = EcFoldLevel6 + ShortCut = 41014 + end + item + Command = EcFoldLevel7 + ShortCut = 41015 + end + item + Command = EcFoldLevel8 + ShortCut = 41016 + end + item + Command = EcFoldLevel9 + ShortCut = 41017 + end + item + Command = EcFoldLevel0 + ShortCut = 41008 + end + item + Command = EcFoldCurrent + ShortCut = 41005 + end + item + Command = EcUnFoldCurrent + ShortCut = 41003 + end + item + Command = EcToggleMarkupWord + ShortCut = 32845 + end + item + Command = ecNormalSelect + ShortCut = 24654 + end + item + Command = ecColumnSelect + ShortCut = 24643 + end + item + Command = ecLineSelect + ShortCut = 24652 + end + item + Command = ecTab + ShortCut = 9 + end + item + Command = ecShiftTab + ShortCut = 8201 + end + item + Command = ecMatchBracket + ShortCut = 24642 + end + item + Command = ecColSelUp + ShortCut = 40998 + end + item + Command = ecColSelDown + ShortCut = 41000 + end + item + Command = ecColSelLeft + ShortCut = 40997 + end + item + Command = ecColSelRight + ShortCut = 40999 + end + item + Command = ecColSelPageDown + ShortCut = 40994 + end + item + Command = ecColSelPageBottom + ShortCut = 57378 + end + item + Command = ecColSelPageUp + ShortCut = 40993 + end + item + Command = ecColSelPageTop + ShortCut = 57377 + end + item + Command = ecColSelLineStart + ShortCut = 40996 + end + item + Command = ecColSelLineEnd + ShortCut = 40995 + end + item + Command = ecColSelEditorTop + ShortCut = 57380 + end + item + Command = ecColSelEditorBottom + ShortCut = 57379 + end + item + Command = ecCopy + ShortCut = 4163 + end + item + Command = ecCut + ShortCut = 4184 + end + item + Command = ecPaste + ShortCut = 4182 + end> + MouseActions = <> + MouseTextActions = <> + MouseSelActions = <> + Options = [eoAutoIndent, eoBracketHighlight, eoGroupUndo, eoKeepCaretX, eoScrollByOneLess, eoSmartTabs, eoTabIndent, eoTrimTrailingSpaces, eoAltSetsColumnMode, eoDragDropEditing] + Options2 = [eoCaretSkipTab, eoEnhanceEndKey, eoOverwriteBlock, eoAutoHideCursor] + MouseOptions = [emAltSetsColumnMode, emDragDropEditing] + VisibleSpecialChars = [vscSpace, vscTabAtLast] + SelectedColor.BackPriority = 50 + SelectedColor.ForePriority = 50 + SelectedColor.FramePriority = 50 + SelectedColor.BoldPriority = 50 + SelectedColor.ItalicPriority = 50 + SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 + BracketHighlightStyle = sbhsBoth + BracketMatchColor.Background = clNone + BracketMatchColor.Foreground = clNone + BracketMatchColor.Style = [fsBold] + FoldedCodeColor.Background = clNone + FoldedCodeColor.Foreground = clGray + FoldedCodeColor.FrameColor = clGray + MouseLinkColor.Background = clNone + MouseLinkColor.Foreground = clBlue + LineHighlightColor.Background = clNone + LineHighlightColor.Foreground = clNone + TabWidth = 4 + WantTabs = False + OnChange = synMessageChange + inline SynLeftGutterPartList1: TSynGutterPartList + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 15 + Visible = False + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + MouseActions = <> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = <> + MouseActionsCollapsed = <> + end + end + end + object pumOptions: TPopupMenu + left = 88 + top = 72 + end + object pumTags: TPopupMenu + left = 216 + top = 72 + object miNoTags: TMenuItem + Caption = '(no tags)' + Enabled = False + end + end + object pumMessages: TPopupMenu + OnPopup = pumMessagesPopup + left = 152 + top = 112 + object miNoMessages: TMenuItem + Caption = '(no previous messages)' + Enabled = False + end + end + object dlgColor: TColorDialog + Title = 'Select background color' + Color = clNone + CustomColors.Strings = ( + 'ColorA=dcdcf2' + 'ColorB=d6e5bd' + 'ColorC=a0a0a0' + 'ColorD=b0b0b0' + 'ColorE=c0c0c0' + 'ColorF=d0d0d0' + 'ColorG=e0e0e0' + 'ColorH=f0ffc0' + 'ColorG=fff0c0' + 'ColorI=ffc0d0' + 'ColorJ=ffc0ff' + 'ColorK=d0c0ff' + 'ColorL=c0f0ff' + 'ColorM=c0fff0' + 'ColorN=c0ffc0' + 'ColorO=c0d3a8' + 'ColorP=d3c7a8' + 'ColorQ=d3a8aa' + 'ColorR=d3a8cb' + 'ColorS=bca8d3' + ) + left = 288 + top = 112 + end + object scUUIDs: TSynCompletion + Position = 0 + LinesInWindow = 16 + SelectedColor = clHighlight + CaseSensitive = False + Width = 262 + ShowSizeDrag = True + AutoUseSingleIdent = True + ShortCut = 16416 + EndOfTokenChr = '])., ' + OnCodeCompletion = scUUIDsCodeCompletion + ExecCommandID = ecSynCompletionExecute + Editor = synMessage + left = 345 + top = 71 + end +end ADDED src/a_commitmessage.pas Index: src/a_commitmessage.pas ================================================================== --- /dev/null +++ src/a_commitmessage.pas @@ -0,0 +1,650 @@ +unit A_CommitMessage; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, SynEdit, SynCompletion, Forms, Controls, + ExtCtrls, ComCtrls, StdCtrls, Menus, Dialogs, types, M_Main, U_Fossil, LCLType; + +type + + TNotifyGetFilesEvent = procedure(Sender: TObject; const AFiles: TFossilFileList) of object; + + { TframeCommitMessage } + + TframeCommitMessage = class(TFrame) + btnCommit: TButton; + btnBGColor: TColorButton; + btnStash: TButton; + chkBGColor: TCheckBox; + dlgColor: TColorDialog; + lblSelectedOptions: TLabel; + miNoTags: TMenuItem; + miNoMessages: TMenuItem; + pnlOptions: TPanel; + pumMessages: TPopupMenu; + pumTags: TPopupMenu; + pumOptions: TPopupMenu; + sbrMessage: TStatusBar; + scUUIDs: TSynCompletion; + synMessage: TSynEdit; + tbrMessage: TToolBar; + btnBranch: TToolButton; + btnOptions: TToolButton; + btnMessage: TToolButton; + btnTags: TToolButton; + procedure btnBGColorColorChanged(Sender: TObject); + procedure btnBranchClick(Sender: TObject); + procedure btnCommitClick(Sender: TObject); + procedure btnOptionsClick(Sender: TObject); + procedure btnStashClick(Sender: Tobject); + procedure btnTagsClick(Sender: TObject); + procedure miMessageClick(Sender: TObject); + procedure miOptionClick(Sender: TObject); + procedure pumMessagesPopup(Sender: TObject); + procedure scUUIDsCodeCompletion(var Value: string; SourceValue: string; + var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char; Shift: TShiftState + ); + procedure synMessageChange(Sender: TObject); + procedure synMessageClickLink(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure synMessageKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure synMessageMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + private + FWorkdir: TFossilWorkdir; + FOptions: TCommitOptions; + FOnGetFiles: TNotifyGetFilesEvent; + FOnRefreshNeeded: TNotifyEvent; + + procedure PopulateCompletionFromTickets; + procedure FillCommitOptions(var Options: TCommitOptions); + procedure PopulateMessages; + + procedure SetWorkdir(AValue: TFossilWorkdir); + { private declarations } + public + { public declarations } + constructor Create(AOwner: TComponent); override; + + property WorkDir: TFossilWorkdir read FWorkdir write SetWorkdir; + + property OnGetFiles: TNotifyGetFilesEvent read FOnGetFiles write FOnGetFiles; + property OnRefreshNeeded: TNotifyEvent read FOnRefreshNeeded write FOnRefreshNeeded; + end; + +implementation +uses + TypInfo, Graphics, StrUtils, Math, + f_newbranch; + +{$R *.lfm} + +{ TframeCommitMessage } + +function ProperCaseFromFlag(const Flag: TCommitFlag): string; +var + Caps, Symbol: Boolean; + i: Integer; +begin + Result := Copy(GetEnumName(TypeInfo(TCommitFlag), Ord(Flag)), 3, 50); + Caps := False; + Symbol := False; + for i := Length(Result) downto 2 do begin + case Result[i] of + 'A'..'Z': begin + if (Caps = False) and not Symbol then begin + Result[i] := LowerCase(Result[i]); + Insert(' ', Result, i); + end; + Caps := True; + Symbol := False; + end; + 'a'..'z': begin + Caps := False; + Symbol := False; + end; + else begin + Caps := False; + Symbol := True; + end; + end; + end; +end; + +constructor TframeCommitMessage.Create(AOwner: TComponent); +var + s: string; + cf: TCommitFlag; + mi: TMenuItem; +begin + inherited Create(AOwner); + + for s in cEditorFontNames do begin + if Screen.Fonts.IndexOf(s) > -1 then begin + synMessage.Font.Name := s; + Break; + end; + end; + + FOptions := cDefaultCommitOptions; + + for cf in TCommitFlag do begin + mi := TMenuItem.Create(pumOptions); + mi.Caption := ProperCaseFromFlag(cf); + mi.Tag := Ord(cf); + mi.Checked := (cf in FOptions.Flags); + mi.AutoCheck := True; + mi.Visible := True; + mi.OnClick := @miOptionClick; + pumOptions.Items.Add(mi); + end; + miOptionClick(nil); +end {TframeCommitMessage.Create}; + +procedure TframeCommitMessage.SetWorkdir(AValue: TFossilWorkdir); +begin + if FWorkdir = AValue then Exit; + FWorkdir := AValue; + + FOptions.BranchName := FWorkdir.Branch; + // TODO: figure out how to set the 'None' color. + // TODO: try to determine if user has set a custom background color for this branch, and select that if relevant. + btnBGColor.ButtonColor := FWorkdir.Checkout.Util.GetDefaultColor(FOptions.BranchName); + chkBGColor.Checked := FOptions.BranchColor <> clNone; + + // Display current branch name + sbrMessage.SimpleText := 'Current branch: ' + FWorkdir.Branch; + btnBranch.Caption := 'Branch: ' + FWorkdir.Branch; + + PopulateMessages; + + scUUIDs.ItemList.BeginUpdate; + try + scUUIDs.ItemList.Clear; + // fill the scUUIDs with open ticket-IDs + PopulateCompletionFromTickets; + + scUUIDs.LinesInWindow := Min(16, scUUIDs.ItemList.Count); + finally + scUUIDs.ItemList.EndUpdate; + end; +end; + +procedure TframeCommitMessage.synMessageChange(Sender: TObject); +begin + btnCommit.Enabled := Length(TrimRight(synMessage.Text)) > 0; +end; + +procedure TframeCommitMessage.synMessageClickLink(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // TODO: get the target of the link, and some something appropriate with it +end; + +procedure TframeCommitMessage.synMessageKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if (Key = VK_RETURN) and (Shift * [ssCtrl, ssMeta] <> []) then begin + btnCommit.Click; // TODO: use an action for that + Key := 0; + end; +end; + +procedure TframeCommitMessage.synMessageMouseWheel(Sender: TObject; + Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +var + SizeOffset: Integer; +begin + if ssCtrl in Shift then begin + // TODO: test this with user-set font sizes as well; both on Mac and Windows + if WheelDelta > 0 then + SizeOffset := -1 + else + SizeOffset := 1; + synMessage.BeginUpdate(False); + try + synMessage.Font.Size := synMessage.Font.Size + SizeOffset; + finally + synMessage.EndUpdate; + end; + Handled := True; + end; +end; + +procedure TframeCommitMessage.PopulateCompletionFromTickets; +var + TicketClosedSQL: string = 'status=''Closed'''; + Tickets, Fields: TStringList; + i: Integer; + FieldUUID, FieldTitle: Integer; + UUID, Title: string; +begin + modMain.SetBusy(True); + Tickets := TStringList.Create; + try + // TODO: retrieve the definition of 'closed' from the repo + // echo "SELECT value FROM config WHERE name='ticket-closed-expr';" | f sql + // (probably best to access the repo directly as an SQLite DB) + // TODO: since we'll be accessing the repo DB directly anyway, we might as well read the + // ticket IDs and titles directly as well. + Tickets.Text := FWorkdir.Checkout.Exe.Run('ticket show 0 "NOT (' + TicketClosedSQL + ')"'); + if Tickets.Count = 0 then + Exit; + + Fields := TStringList.Create; + try + Fields.Delimiter := #9; + Fields.StrictDelimiter := True; + + // read the first lines and extract the field names + Fields.DelimitedText := Tickets[0]; + FieldUUID := Fields.IndexOf('tkt_uuid'); + FieldTitle := Fields.IndexOf('title'); + + if (FieldUUID = -1) then + Exit; + + // read each ticket, and extract the 'tkt_uuid' and the 'title'. + for i := 1 to Tickets.Count - 1 do begin + Fields.DelimitedText := Tickets[i]; + UUID := Copy(Fields[FieldUUID], 1, 10); + if FieldTitle <> -1 then + Title := Fields[FieldTitle] + else + Title := ''; + if Title <> '' then + scUUIDs.ItemList.Add('[' + UUID + '|' + Title + ']') + else + scUUIDs.ItemList.Add('[' + UUID + ']'); + end; + finally + Fields.Free; + end; + finally + Tickets.Free; + modMain.SetBusy(False); + end; +end {TframeCommitMessage.PopulateCompletionFromTickets}; + +procedure TframeCommitMessage.FillCommitOptions(var Options: TCommitOptions); +var + i: Integer; +begin + if (Options.BranchName <> '') and (Options.BranchName <> FWorkdir.Branch) then begin + Options.RevColor := clNone; + if chkBGColor.Checked then + Options.BranchColor := btnBGColor.ButtonColor; + end else if chkBGColor.Checked then begin + Options.RevColor := btnBGColor.ButtonColor; + end; + + // TODO + //if Huppeldepup.Integrate then begin + // Options^.Integrate := True; + //end; + + for i := 0 to pumOptions.Items.Count - 1 do begin + if pumOptions.Items[i].Checked then + Include(Options.Flags, TCommitFlag(pumOptions.Items[i].Tag)) + else + Exclude(Options.Flags, TCommitFlag(pumOptions.Items[i].Tag)); + end; + + Options.Message := synMessage.Text; + //Options.ContentType := ''; // TODO: provide dropdown to choose format + // TODO (later): facilitate rich text editing? +end {TframeCommitMessage.FillCommitOptions}; + +procedure TframeCommitMessage.PopulateMessages; +const + Limit: Integer = 20; +var + miMessage: TMenuItem; + i: Integer; + Revision: TFossilRevision; +begin + // TODO: this just loads the most recent commit entries. Shouldn't we be storing the messages + // after they've been committed in this editor? + miMessage := miNoMessages.Parent; + for i := miMessage.Count - 1 downto 0 do begin + if miMessage.Items[i] <> miNoMessages then + miMessage.Delete(i); + end; + i := 0; + try + FWorkdir.Checkout.LoadRevisions(Limit); + for Revision in FWorkdir.Checkout.Revisions do begin + miMessage := TMenuItem.Create(pumMessages); + miMessage.Caption := Revision.Message.Substring(0, 99); + if Revision.Message.Length > 99 then + miMessage.Caption := miMessage.Caption + '…'; + miMessage.Hint := Revision.Message; + miMessage.OnClick := @miMessageClick; + miMessage.Visible := True; + pumMessages.Items.Add(miMessage); + i += 1; + if i >= Limit then Break; + end; + finally + miNoMessages.Visible := i = 0; + end; +end; + +procedure TframeCommitMessage.btnCommitClick(Sender: TObject); +var + i: Integer; + Tags: TStringList; + Files: TFossilFileList; + QFile: TFileVersion; + QFiles: TStringList; + Summary: string; + Lines: TStringList; +begin + if not btnCommit.Enabled then + Exit; + + // Initialize the commit options + FillCommitOptions({var}FOptions); + + // assemble tags + Tags := TStringList.Create; + try + for i := 0 to pumTags.Items.Count - 1 do begin + if pumTags.Items[i].Visible and pumTags.Items[i].Checked then begin + Tags.Add(pumTags.Items[i].Caption); + end; + end; + + // assemble list of files + Files := TFossilFileList.Create(False); + try + if Assigned(FOnGetFiles) then begin + modMain.SetBusy(True); + try + FOnGetFiles(Self, Files); + finally + modMain.SetBusy(False); + end; + + // Check if there's any NEW files, and ask if they really need + // to be added. + QFiles := TStringList.Create; + try + for QFile in Files do begin + if fsUntracked in QFile.Statuses then + QFiles.Add(QFile.FullName); + end; + if QFiles.Count > 0 then begin + case MessageDlg('Commit new files?', + 'Are you sure you want to add the following untracked files?' + LineEnding + + LineEnding + + QFiles.Text, + mtConfirmation, + mbYesNoCancel, + 'CommitNewFiles') of + mrNo: begin + // remove all new files from the list of files to commit + for i := Files.Count - 1 downto 0 do begin + if fsUntracked in Files[i].Statuses then + Files.Delete(i); + end; + end; + mrYes: begin + // add all new files to the repository + QFiles.QuoteChar := '"'; + QFiles.Delimiter := ' '; + QFiles.StrictDelimiter := False; + WorkDir.Checkout.Exe.Run('add --force ' + QFiles.DelimitedText); + end {mrYes}; + mrCancel: begin + Exit; + end {mrCancel}; + end {case}; + end {if}; + finally + QFiles.Free; + end {finally}; + + // Check if there's any MISSING files, and ask if they need to be removed. + QFiles := TStringList.Create; + try + for QFile in Files do begin + if fsMissing in QFile.Statuses then + QFiles.Add(QFile.FullName); + end; + if QFiles.Count > 0 then begin + case MessageDlg('Remove missing files?', + 'Do you want to remove these missing files?' + LineEnding + + LineEnding + + QFiles.Text, + mtConfirmation, + mbYesNoCancel, + 'RemoveMissingFiles') of + mrNo: begin + // remove all missing files from the list of files to commit + for i := Files.Count - 1 downto 0 do begin + if fsMissing in Files[i].Statuses then + Files.Delete(i); + end; + end; + mrYes: begin + // marks all missing files as removed from the repository + QFiles.QuoteChar := '"'; + QFiles.Delimiter := ' '; + QFiles.StrictDelimiter := False; + WorkDir.Checkout.Exe.Run('forget ' + QFiles.DelimitedText); + end {mrYes}; + mrCancel: begin + Exit; + end {mrCancel}; + end {case}; + end {if}; + finally + QFiles.Free; + end {finally}; + + if Files.Count = 0 then begin + case MessageDlg('Empty commit', + 'There are no files to commit!' + LineEnding + + LineEnding + + 'Do you want to continue anyway?', + mtConfirmation, + mbYesNo, 0 { TODO: help context id for empty commit }, mbNo) of + mrNo: begin + Exit; + end; + end {case}; + end; + end {if}; + + // TODO: get the command-line options, and show those instead + i := MessageBoxFunction(PChar('To be done:'+LineEnding + FWorkdir.GetCommitOptions(FOptions)), 'Not implemented', MB_ICONQUESTION + MB_OKCANCEL + MB_DEFBUTTON2); + if i = 1 then begin + // if OK then perform the actual commit + modMain.SetBusy(True); + Summary := FWorkdir.Commit(@FOptions, Tags, Files); + Lines := TStringList.Create; + try + Lines.Text := Summary; + for i := Lines.Count - 2 downto 0 do begin + if Lines[i].StartsWith('Round-trips', true) and Lines[i + 1].StartsWith('Round-trips', true) then + Lines.Delete(i); + end; + Summary := Lines.Text.Trim(); + finally + Lines.Free; + end; + MessageBoxFunction(PChar(Summary), 'Commit', IfThen(Summary.StartsWith('Warning:', True), MB_ICONWARNING, MB_ICONINFORMATION)); + synMessage.BeginUpdate(True); + try + synMessage.Lines.Clear; + finally + synMessage.EndUpdate; + end; + PopulateMessages; + end; + + finally + Files.Free; + end; + + if Assigned(FOnRefreshNeeded) then begin + FOnRefreshNeeded(Self); + end; + finally + Tags.Free; + modMain.SetBusy(False); + end; +end; + +procedure TframeCommitMessage.btnBranchClick(Sender: TObject); +var + frm: TfrmNewBranch; + Lines: TStringList; + Line, TagName, HexColor: string; + CharPos: Integer; +begin + // TODO: do this via a TAction + frm := TfrmNewBranch.Create(Self); + try + frm.Initialize(FWorkdir.Branch, FOptions); + + if frm.ShowModal = mrOK then begin + FOptions.CloseBranch := frm.CloseBranch; + if frm.BranchName <> FOptions.BranchName then begin // The choice has changed + FOptions.BranchName := frm.BranchName; + btnBranch.Caption := 'Branch: ' + FOptions.BranchName; + + // Disable the explicit branch color + if (FOptions.BranchName <> FWorkdir.Branch) or not chkBGColor.Checked then begin + btnBGColor.ButtonColor := FWorkdir.Checkout.Util.GetDefaultColor(FOptions.BranchName); + chkBGColor.Checked := False; + end; + end; + end; + finally + frm.Free; + end; +end; + +procedure TframeCommitMessage.btnBGColorColorChanged(Sender: TObject); +begin + chkBGColor.Checked := (btnBGColor.ButtonColor <> clNone); +end; + +procedure TframeCommitMessage.btnOptionsClick(Sender: TObject); +var + Button: TToolButton; + MenuPos: TPoint; +begin + Button := Sender as TToolButton; + MenuPos := Button.Parent.ClientToScreen(Point(Button.Left, Button.Top + Button.Height)); + Button.DropdownMenu.PopUp(MenuPos.X, MenuPos.Y); +end; + +procedure TframeCommitMessage.btnStashClick(Sender: TObject); +var + Files: TFossilFileList; + Summary: string; +begin + // assemble list of files + Files := TFossilFileList.Create(False); + try + if Assigned(FOnGetFiles) then begin + modMain.SetBusy(True); + try + FOnGetFiles(Self, Files); + finally + modMain.SetBusy(False); + end; + end; + + // remove all unselected files from the list of files to commit + if Files.Count = 0 then begin + case MessageDlg('No files', + 'There are no files to stash!' + LineEnding + + LineEnding + + 'Do you want to continue anyway?', + mtConfirmation, + mbYesNo, 0 { TODO: help context id for no files to stash }, mbNo) of + mrNo: begin + Exit; + end; + end {case}; + end; + + modMain.SetBusy(True); + try + Summary := FWorkdir.MoveToStash(synMessage.Text, Files, False); + MessageBoxFunction(PChar(Summary), 'Stash', MB_ICONINFORMATION); + + synMessage.BeginUpdate(True); + try + synMessage.Lines.Clear; + finally + synMessage.EndUpdate; + end; + finally + modMain.SetBusy(False); + end; + finally + Files.Free; + end; + + if Assigned(FOnRefreshNeeded) then begin + FOnRefreshNeeded(Self); + end; +end; + +procedure TframeCommitMessage.btnTagsClick(Sender: TObject); +begin + // TODO: ask for new tag, then add it as a new menu item to pumTags + MessageBoxFunction(PChar('(o) Assign new tag: [_____]' + LineEnding + + '(o) Assign/remove existing tag(s):' + LineEnding + + ' [x] v1.00' + LineEnding + + ' [ ] test-release' + LineEnding + + ' <...>'), + 'Not Implemented', 64); +end; + +procedure TframeCommitMessage.miMessageClick(Sender: TObject); +begin + if synMessage.SelAvail then + synMessage.SelText := (Sender as TMenuItem).Hint + else + synMessage.Text := (Sender as TMenuItem).Hint; +end; + +procedure TframeCommitMessage.miOptionClick(Sender: TObject); +var + Options: TCommitOptions; +begin + Options := cDefaultCommitOptions; + FillCommitOptions(Options); + lblSelectedOptions.Caption := 'Selected options: ' + FWorkdir.GetCommitOptions(Options); +end; + +procedure TframeCommitMessage.pumMessagesPopup(Sender: TObject); +begin + if pumMessages.Items.Count <= 1 then + PopulateMessages; +end; + +procedure TframeCommitMessage.scUUIDsCodeCompletion(var Value: string; + SourceValue: string; var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char; + Shift: TShiftState); +begin + // Append instead of replacing + Value := SourceValue + Value; + + // TODO: add the relevant ticket-UUID to the list of tickets affected by this commit + // (by default, change its status to Fixed? ==> should be a setting) +end; + +end. + ADDED src/a_filelist.lfm Index: src/a_filelist.lfm ================================================================== --- /dev/null +++ src/a_filelist.lfm @@ -0,0 +1,194 @@ +object fraFileList: TfraFileList + Left = 0 + Height = 411 + Top = 0 + Width = 514 + ClientHeight = 411 + ClientWidth = 514 + LCLVersion = '1.6.4.0' + TabOrder = 0 + DesignLeft = 750 + DesignTop = 53 + object lvwFiles: TListView + Left = 0 + Height = 385 + Top = 26 + Width = 514 + Align = alClient + AutoWidthLastColumn = True + Checkboxes = True + Color = clWindow + Columns = < + item + Caption = 'Name' + MinWidth = 50 + Width = 150 + end + item + Caption = 'Path' + ImageIndex = 11 + Width = 150 + end + item + Caption = 'Status' + Width = 20 + end + item + Caption = 'Type' + Width = 192 + end> + HideSelection = False + Items.LazData = { + DA0000000300000009000000FFFFFFFFFFFFFFFF030000000C000000665F636F + 6D6D69742E6C666D050000007372632F61050000004558545241040000002E6C + 666D02000000FFFFFFFFFFFFFFFF030000000900000050616C656F2E6C706907 + 0000007372632F70726A06000000454449544544040000002E6C706909000000 + FFFFFFFFFFFFFFFF030000000C000000665F636F6D6D69742E70617305000000 + 7372632F7A050000004558545241040000002E706173FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + } + MultiSelect = True + ReadOnly = True + RowSelect = True + ScrollBars = ssAutoBoth + SmallImages = modMain.imlFileStatuses + SortColumn = 1 + SortType = stBoth + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = lvwFilesColumnClick + OnCompare = lvwFilesCompare + OnItemChecked = lvwFilesItemChecked + OnKeyPress = lvwFilesKeyPress + OnSelectItem = lvwFilesSelectItem + end + object tbrFiles: TToolBar + Left = 0 + Height = 26 + Top = 0 + Width = 514 + Caption = 'tbrFiles' + EdgeBorders = [] + EdgeInner = esNone + EdgeOuter = esNone + Images = modMain.imlMain + TabOrder = 1 + object chkAll: TCheckBox + Left = 1 + Height = 21 + Top = 0 + Width = 21 + OnChange = chkAllChange + State = cbGrayed + TabOrder = 0 + end + object btnSep1: TToolButton + Left = 22 + Height = 22 + Top = 0 + Width = 5 + Style = tbsDivider + end + object btnStatus: TToolButton + Left = 27 + Top = 0 + AllowAllUp = True + Caption = 'Status' + DropdownMenu = pumStatus + ImageIndex = 7 + OnClick = btnStatusClick + ShowCaption = False + Style = tbsDropDown + end + object btnSep3: TToolButton + Left = 220 + Height = 22 + Top = 0 + Width = 5 + Style = tbsDivider + end + object btnRefresh: TToolButton + Left = 225 + Hint = 'Refresh' + Top = 0 + Caption = 'Refresh' + ImageIndex = 6 + OnClick = btnRefreshClick + end + object edtFilter: TEdit + AnchorSideRight.Control = btnSep3 + Left = 67 + Height = 27 + Top = 0 + Width = 153 + OnChange = edtFilterChange + TabOrder = 1 + end + object btnSep2: TToolButton + Left = 62 + Height = 22 + Top = 0 + Width = 5 + Caption = 'btnSep2' + Style = tbsDivider + end + end + object pumStatus: TPopupMenu + Images = modMain.imlMain + left = 74 + top = 183 + object miUntracked: TMenuItem + AutoCheck = True + Caption = 'Untracked' + Checked = True + OnClick = miStatusClick + end + object miAdded: TMenuItem + AutoCheck = True + Caption = 'Added' + Checked = True + ShowAlwaysCheckable = True + OnClick = miStatusClick + end + object miModified: TMenuItem + AutoCheck = True + Caption = 'Modified' + Checked = True + OnClick = miStatusClick + end + object miDeleted: TMenuItem + AutoCheck = True + Caption = 'Deleted' + Checked = True + OnClick = miStatusClick + end + object miMissing: TMenuItem + AutoCheck = True + Caption = 'Missing' + Checked = True + OnClick = miStatusClick + end + object miMerged: TMenuItem + AutoCheck = True + Caption = 'Merged' + Checked = True + OnClick = miStatusClick + end + object miConflicted: TMenuItem + AutoCheck = True + Caption = 'Conflicted' + Checked = True + OnClick = miStatusClick + end + object miUnchanged: TMenuItem + AutoCheck = True + Caption = 'Unchanged' + OnClick = miStatusClick + end + object miIgnored: TMenuItem + AutoCheck = True + Caption = 'Ignored' + OnClick = miStatusClick + end + end +end ADDED src/a_filelist.pas Index: src/a_filelist.pas ================================================================== --- /dev/null +++ src/a_filelist.pas @@ -0,0 +1,498 @@ +unit A_FileList; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, ComCtrls, ExtCtrls, ActnList, + StdCtrls, Menus, M_Main, u_Fossil; + +type + TFileNameComparer = function(const FN1, FN2: TFileName): Integer; + + TFileSelectionEvent = procedure(Sender: TObject; AFile: TFileVersion; Selected: Boolean) of object; + + { TfraFileList } + + TfraFileList = class(TFrame) + btnSep3: TToolButton; + chkAll: TCheckBox; + edtFilter: TEdit; + lvwFiles: TListView; + miUnchanged: TMenuItem; + miIgnored: TMenuItem; + miConflicted: TMenuItem; + miMerged: TMenuItem; + miUntracked: TMenuItem; + miMissing: TMenuItem; + miDeleted: TMenuItem; + miAdded: TMenuItem; + miModified: TMenuItem; + pumStatus: TPopupMenu; + tbrFiles: TToolBar; + btnRefresh: TToolButton; + btnSep1: TToolButton; + btnStatus: TToolButton; + btnSep2: TToolButton; + procedure btnRefreshClick(Sender: TObject); + procedure btnStatusClick(Sender: TObject); + procedure chkAllChange(Sender: TObject); + procedure edtFilterChange(Sender: TObject); + procedure lvwFilesColumnClick(Sender: TObject; Column: TListColumn); + procedure lvwFilesCompare(Sender: TObject; Item1, Item2: TListItem; + Data: Integer; var Compare: Integer); + procedure lvwFilesItemChecked(Sender: TObject; Item: TListItem); + procedure lvwFilesKeyPress(Sender: TObject; var Key: char); + procedure lvwFilesSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure miStatusClick(Sender: TObject); + private + { private declarations } + FRevision: TFossilRevision; + //FRetrievedStatuses: TFileStatuses; + FDisplayStatuses: TFileStatuses; + FRequestStates: TFossilFileStates; + + FOnSelectionChanged: TFileSelectionEvent; + FCompareFileNames: TFileNameComparer; + + procedure SetRevision(AValue: TFossilRevision); + procedure DetermineDisplayStatuses; + procedure SetStatuses(AValue: TFileStatuses); + protected + function DoFilter(const oFile: TFileVersion): Boolean; virtual; + public + { public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure PopulateList(ForceReload: Boolean = False); + procedure LoadCheckedFiles(const Files: TFossilFileList); + + property DisplayStatuses: TFileStatuses read FDisplayStatuses write SetStatuses; + property Revision: TFossilRevision read FRevision write SetRevision; + published + property OnSelectionChanged: TFileSelectionEvent read FOnSelectionChanged write FOnSelectionChanged; + end; + + +implementation +uses + Graphics, Math, StrUtils; + +{$R *.lfm} + +const + cFileNameComparer: array[Boolean] of TFileNameComparer = (@CompareFilenamesIgnoreCase, + @CompareFilenames); + {$IFDEF DARWIN} + cSortAscending: string = '▼'; + cSortDescending: string = '▲'; + cSortDirection: array[TSortDirection] of string = ('▼', '▲'); + {$ELSE} + cSortAscending: string = '▾'; + cSortDescending: string = '▴'; + cSortDirection: array[TSortDirection] of string = ('▾', '▴'); + {$ENDIF} + + cColFilename = 0; + cColPath = 1; + cColStatus = 2; + cColType = 3; + +{ TfraFileList } + +constructor TfraFileList.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCompareFileNames := cFileNameComparer[FileNameCaseSensitive]; + DetermineDisplayStatuses; +end; + +destructor TfraFileList.Destroy; +begin + inherited Destroy; +end; + +procedure TfraFileList.PopulateList(ForceReload: Boolean = False); +const + {$IFDEF MSWINDOWS} + ResizableCols: set of Byte = [cColFilename,cColPath,cColType]; // don't resize the status column; that's an icon + {$ELSE} + ResizableCols: set of Byte = [cColFilename,cColPath,cColStatus, cColType]; // other platforms don't show the icon + {$ENDIF} +var + PrevStates: TFossilFileStates; + Item: TListItem; + FocusedFile: string; + FileType: string; + Checked, Unchecked: Boolean; + SelectedFiles: TStringList; + i, ci: Integer; + oFile: TFileVersion; + Bmp: TBitmap; + ColWidths: array of Integer; +begin + modMain.SetBusy(True); + Bmp := TBitmap.Create; + try + Bmp.Canvas.Font.Assign(lvwFiles.Font); + + SetLength(ColWidths, lvwFiles.ColumnCount); + for i := 0 to lvwFiles.ColumnCount - 1 do begin + ColWidths[i] := Bmp.Canvas.TextWidth(lvwFiles.Column[i].Caption); + end; + + // Remember the ItemFocused, the ItemIndex and the selected files, so we can restore all + // that after repopulating. + Item := lvwFiles.ItemFocused; + if Assigned(Item) then + FocusedFile := TFileVersion(Item.Data).FullName + else + FocusedFile := ''; + + Checked := False; + Unchecked := False; + SelectedFiles := TStringList.Create; + try + SelectedFiles.CaseSensitive := FRevision.Checkout.CaseSensitive; + for Item in lvwFiles.Items do begin + if Item.Selected then begin + SelectedFiles.Add(TFileVersion(Item.Data).FullName); + if Assigned(FOnSelectionChanged) then + FOnSelectionChanged(Self, TFileVersion(Item.Data), False); + end; + end; + + lvwFiles.Items.BeginUpdate; + try + lvwFiles.Items.Clear; + lvwFiles.SortType := stNone; + + // Check if we need to reload the list of files + if not ForceReload then begin + PrevStates := FRequestStates; + DetermineDisplayStatuses; + end; + if ForceReload or ((FRequestStates - PrevStates) <> []) then begin + FRevision.LoadFiles(FRequestStates, ForceReload); + end; + + // Repopulate the listview + for i := 0 to FRevision.Files.Count - 1 do begin + oFile := FRevision.Files[i]; + if DoFilter(oFile) then begin + Item := lvwFiles.Items.Add; + Item.Data := Pointer(oFile); + Item.Caption := oFile.Filename; + Item.SubItems.Add(oFile.Path); + Item.ImageIndex := modMain.ImageIndexFromStatuses(oFile.Statuses); + Item.SubItems.Add(oFile.Status); + // TODO: get type name from OS? + FileType := ExtractFileExt(oFile.Filename); + if (Length(FileType) > 0) and (FileType[1] = '.') then + FileType := Copy(FileType, 2, Length(FileType)); + {$IFDEF MSWINDOWS} + Item.SubItemImages[ + Item.SubItems.Add(FileType) + ] := modMain.ImageIndexFromType(ExtractFileExt(oFile.Filename)); + {$ELSE} + Item.SubItems.Add(FileType); + {$ENDIF} + + if SelectedFiles.IndexOf(oFile.FullName) > -1 then begin + Item.Selected := True; + // TODO: test if the event triggers or not, otherwise trigger it ourselves + end; + if oFile.Selected then begin + Item.Checked := True; + Checked := True; + end else begin + Unchecked := True; + end; + if SameFileName(oFile.FullName, FocusedFile) then + lvwFiles.ItemFocused := Item; + + ColWidths[0] := Max(ColWidths[0], Bmp.Canvas.TextWidth(Item.Caption)); + for ci := 1 to High(ColWidths) do begin + if Item.SubItems.Count > ci then + ColWidths[ci] := Max(ColWidths[ci], Bmp.Canvas.TextWidth(Item.SubItems[ci - 1])); + end; + end; + end {for}; + + for i := 0 to lvwFiles.ColumnCount - 1 do begin + if i in ResizableCols then begin + if i = 0 then // that column also harbours the icon and the checkbox + lvwFiles.Column[i].Width := ColWidths[i] + 20 + 20 + 6 + else + lvwFiles.Column[i].Width := ColWidths[i] + 6; + end; + end; + lvwFiles.SortType := stData; + + {$IFNDEF MSWINDOWS} + if (lvwFiles.SortColumn <> -1) and not (AnsiStartsStr(cSortAscending, lvwFiles.Column[lvwFiles.SortColumn].Caption) or AnsiStartsStr(cSortDescending, lvwFiles.Column[lvwFiles.SortColumn].Caption)) then + lvwFiles.Column[lvwFiles.SortColumn].Caption := cSortDirection[lvwFiles.SortDirection] + ' ' + lvwFiles.Column[lvwFiles.SortColumn].Caption; + {$ENDIF} + finally + lvwFiles.Items.EndUpdate; + end; + finally + SelectedFiles.Free; + end; + finally + Bmp.Free; + modMain.SetBusy(False); + end; + + if Checked and Unchecked then + chkAll.State := cbGrayed + else if Checked then + chkAll.State := cbChecked + else + chkAll.State := cbUnchecked; +end; + +procedure TfraFileList.LoadCheckedFiles(const Files: TFossilFileList); +var + Item: TListItem; +begin + for Item in lvwFiles.Items do begin + if Item.Checked then begin + Files.Add(TFileVersion(Item.Data)); + end; + end; +end; + +procedure TfraFileList.lvwFilesCompare(Sender: TObject; Item1, + Item2: TListItem; Data: Integer; var Compare: Integer); +var + File1, File2: TFileVersion; +begin + if Item1.Data = nil then begin + if Item2.Data = nil then + Compare := 0 + else + Compare := -1; + Exit; + end else if Item2.Data = nil then begin + Compare := 1; + Exit; + end; + File1 := TFileVersion(Item1.Data); + File2 := TFileVersion(Item2.Data); + case lvwFiles.SortColumn of + cColFilename: begin + Compare := FCompareFileNames(File1.Filename, File2.Filename); + end; + cColStatus: begin // file status + Compare := CompareStr(File1.Status, File2.Status); + end; + cColPath: begin // path (+ name) + Compare := FCompareFileNames(File1.Path, File2.Path); + if Compare = 0 then + Compare := FCompareFileNames(File1.Filename, File2.Filename); + end; + cColType: begin // extension, then name, then path + Compare := FCompareFileNames(ExtractFileExt(File1.Filename), ExtractFileExt(File2.Filename)); + if Compare = 0 then begin + Compare := FCompareFileNames(File1.Filename, File2.Filename); + if Compare = 0 then + Compare := FCompareFileNames(File1.Path, File2.Path); + end; + end; + end; + if lvwFiles.SortDirection = sdDescending then + Compare := -Compare; +end; + +procedure TfraFileList.lvwFilesItemChecked(Sender: TObject; Item: TListItem); +var + Checked, Unchecked: Boolean; + i: Integer; +begin + if Assigned(Item) then + TWorkFile(Item.Data).Selected := Item.Checked; + + Checked := False; + Unchecked := False; + for i := 0 to lvwFiles.Items.Count - 1 do begin + if lvwFiles.Items[i].Checked then + Checked := True + else + Unchecked := True; + end; + if Checked and Unchecked then + chkAll.State := cbGrayed + else if Checked then + chkAll.State := cbChecked + else + chkAll.State := cbUnchecked; +end; + +procedure TfraFileList.lvwFilesKeyPress(Sender: TObject; var Key: char); +var + Checked: Boolean; + i: Integer; +begin + case Key of + ' ': begin // space + lvwFiles.Items.BeginUpdate; + try + Checked := Assigned(lvwFiles.Selected) and not lvwFiles.Selected.Checked; + for i := 0 to lvwFiles.Items.Count - 1 do begin + if (lvwFiles.Items[i].Selected) or (lvwFiles.Items[i] = lvwFiles.Selected) then + lvwFiles.Items[i].Checked := Checked; + end; + lvwFilesItemChecked(Sender, nil); + finally + lvwFiles.Items.EndUpdate; + end; + lvwFiles.SetFocus; + Key := #0; + end; + end; +end; + +procedure TfraFileList.lvwFilesSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); +begin + if Assigned(FOnSelectionChanged) then + FOnSelectionChanged(Self, TFileVersion(Item.Data), Selected); +end; + +procedure TfraFileList.miStatusClick(Sender: TObject); +begin + // TODO: set up a timer (try 0.5 seconds) before we actually start reloading + // TODO: create a thread that actually starts reloading the data from Fossil; + // if there is already such a thread, tell it to terminate. + // If Fossil needs to be run multiple times, the thread should refresh the file list + // (and repopulate) as soon as it has any results. This means there might be multiple + // listview refreshes. See how that performs. + PopulateList(False); +end; + +procedure TfraFileList.SetStatuses(AValue: TFileStatuses); +begin + if FDisplayStatuses = AValue then Exit; + FDisplayStatuses := AValue; +end; + +procedure TfraFileList.DetermineDisplayStatuses; +begin + FDisplayStatuses := []; // requested statuses this time + if miUntracked.Checked then Include(FDisplayStatuses, fsUntracked); + if miAdded.Checked then Include(FDisplayStatuses, fsAdded); + if miModified.Checked then Include(FDisplayStatuses, fsModified); + if miDeleted.Checked then Include(FDisplayStatuses, fsDeleted); + if miMissing.Checked then Include(FDisplayStatuses, fsMissing); + if miMerged.Checked then Include(FDisplayStatuses, fsMerged); + if miConflicted.Checked then Include(FDisplayStatuses, fsConflict); + if miIgnored.Checked then Include(FDisplayStatuses, fsIgnored); + if miUnchanged.Checked then Include(FDisplayStatuses, fsUnchanged); + + FRequestStates := []; + if fsUntracked in FDisplayStatuses then Include(FRequestStates, ffsExtra); + if (FDisplayStatuses * [fsAdded, fsModified, fsDeleted, fsMissing, fsMerged, fsConflict]) <> [] then Include(FRequestStates, ffsChanged); + if fsIgnored in FDisplayStatuses then Include(FRequestStates, ffsIgnored); + if fsUnchanged in FDisplayStatuses then Include(FRequestStates, ffsUnchanged); +end; + +procedure TfraFileList.SetRevision(AValue: TFossilRevision); +begin + if FRevision = AValue then Exit; + + // TODO: clear the list; we're switching to a different revision anyway? + // otherwise we'll get SIGSEVs when trying to keep track of the selection + // although — we might not; the previous revision does still exist... + FRevision := AValue; + FCompareFileNames := cFileNameComparer[Revision.Checkout.CaseSensitive]; + + // Repopulate the list for the new revision + PopulateList(True); +end; + +function TfraFileList.DoFilter(const oFile: TFileVersion): Boolean; +begin + Result := (oFile.Statuses * FDisplayStatuses) <> []; + if Result = False then + Exit; + + Result := (edtFilter.Text = '') or (Pos(LowerCase(edtFilter.Text), LowerCase(oFile.FullName)) > 0); + + // TODO: test for matching file pattern +end; + +procedure TfraFileList.chkAllChange(Sender: TObject); +var + Checked: Boolean; + i: Integer; +begin + Checked := chkAll.Checked; + lvwFiles.BeginUpdate; + try + for i := 0 to lvwFiles.Items.Count - 1 do begin + lvwFiles.Items[i].Checked := Checked; + end; + finally + lvwFiles.EndUpdate; + lvwFiles.Repaint; + end; +end; + +procedure TfraFileList.btnStatusClick(Sender: TObject); +var + Button: TToolButton; + MenuPos: TPoint; +begin + Button := Sender as TToolButton; + MenuPos.X := Button.Left; + MenuPos.Y := Button.Top + Button.Height; + MenuPos := Button.Parent.ClientToScreen(MenuPos); + Button.DropdownMenu.PopUp(MenuPos.X, MenuPos.Y); +end; + +procedure TfraFileList.btnRefreshClick(Sender: TObject); +begin + PopulateList(True); +end; + +procedure TfraFileList.edtFilterChange(Sender: TObject); +begin + PopulateList(False); +end; + + + +procedure TfraFileList.lvwFilesColumnClick(Sender: TObject; Column: TListColumn); +begin + // if the SortColumn is different from the Column, then assume the new column + // will be sorted ascending; otherwise, the other direction than now. + {$IFDEF MSWINDOWS} + lvwFiles.Column[lvwFiles.SortColumn].ImageIndex := -1; + if lvwFiles.SortColumn <> Column.Index then begin + Column.ImageIndex := 11; + end else if lvwFiles.SortDirection = sdAscending then begin + Column.ImageIndex := 10; + end else begin + Column.ImageIndex := 11; + end; + {$ELSE} + if lvwFiles.SortColumn <> -1 then begin + if AnsiStartsStr(cSortAscending, lvwFiles.Column[lvwFiles.SortColumn].Caption) or AnsiStartsStr(cSortDescending, lvwFiles.Column[lvwFiles.SortColumn].Caption) then + lvwFiles.Column[lvwFiles.SortColumn].Caption := Copy(lvwFiles.Column[lvwFiles.SortColumn].Caption, Length(cSortAscending) + 2, 50); + end; + if (lvwFiles.SortColumn <> Column.Index) then begin + Column.Caption := cSortAscending + ' ' + Column.Caption; + end else if lvwFiles.SortDirection = sdDescending then begin + Column.Caption := cSortAscending + ' ' + Column.Caption; + end else begin + Column.Caption := cSortDescending + ' ' + Column.Caption; + end; + {$ENDIF} +end; + +end. + ADDED src/a_fileversioninfo.lfm Index: src/a_fileversioninfo.lfm ================================================================== --- /dev/null +++ src/a_fileversioninfo.lfm @@ -0,0 +1,714 @@ +object fraFileVersionInfo: TfraFileVersionInfo + Left = 0 + Height = 440 + Top = 0 + Width = 573 + ClientHeight = 440 + ClientWidth = 573 + Font.Quality = fqCleartype + ParentFont = False + TabOrder = 0 + DesignLeft = 565 + DesignTop = 297 + object tbcView: TTabControl + Left = 0 + Height = 414 + Top = 26 + Width = 573 + Images = modMain.imlMain + OnChange = tbcViewChange + OnChanging = tbcViewChanging + OnGetImageIndex = tbcViewGetImageIndex + TabIndex = 0 + Tabs.Strings = ( + 'Diff' + 'Side-by-side' + 'Contents' + 'Annotated' + 'Hex' + ) + Align = alClient + TabOrder = 0 + object imgContents: TImage + Left = 2 + Height = 384 + Top = 28 + Width = 569 + Align = alClient + Center = True + Proportional = True + Stretch = True + Transparent = True + Visible = False + end + inline synEdit: TSynEdit + Cursor = crDefault + Left = 2 + Height = 384 + Top = 28 + Width = 569 + Align = alClient + Font.Height = 12 + Font.Name = 'Monaco' + Font.Pitch = fpFixed + Font.Quality = fqCleartype + ParentColor = False + ParentFont = False + TabOrder = 1 + OnMouseWheel = synEditMouseWheel + Gutter.Width = 34 + Gutter.MouseActions = <> + RightGutter.Width = 0 + RightGutter.MouseActions = <> + Keystrokes = < + item + Command = ecUp + ShortCut = 16422 + end + item + Command = ecSelUp + ShortCut = 8230 + end + item + Command = ecScrollUp + ShortCut = 38 + end + item + Command = ecDown + ShortCut = 16424 + end + item + Command = ecSelDown + ShortCut = 8232 + end + item + Command = ecScrollDown + ShortCut = 40 + end + item + Command = ecScrollLeft + ShortCut = 37 + end + item + Command = ecSelLeft + ShortCut = 8229 + end + item + Command = ecWordLeft + ShortCut = 16421 + end + item + Command = ecSelWordLeft + ShortCut = 24613 + end + item + Command = ecScrollRight + ShortCut = 39 + end + item + Command = ecSelRight + ShortCut = 8231 + end + item + Command = ecWordRight + ShortCut = 16423 + end + item + Command = ecSelWordRight + ShortCut = 24615 + end + item + Command = ecPageDown + ShortCut = 34 + end + item + Command = ecSelPageDown + ShortCut = 8226 + end + item + Command = ecPageBottom + ShortCut = 16418 + end + item + Command = ecSelPageBottom + ShortCut = 24610 + end + item + Command = ecPageUp + ShortCut = 33 + end + item + Command = ecSelPageUp + ShortCut = 8225 + end + item + Command = ecPageTop + ShortCut = 16417 + end + item + Command = ecSelPageTop + ShortCut = 24609 + end + item + Command = ecLineStart + ShortCut = 36 + end + item + Command = ecSelLineStart + ShortCut = 8228 + end + item + Command = ecEditorTop + ShortCut = 16420 + end + item + Command = ecSelEditorTop + ShortCut = 24612 + end + item + Command = ecLineEnd + ShortCut = 35 + end + item + Command = ecSelLineEnd + ShortCut = 8227 + end + item + Command = ecEditorBottom + ShortCut = 16419 + end + item + Command = ecSelEditorBottom + ShortCut = 24611 + end + item + Command = ecToggleMode + ShortCut = 45 + end + item + Command = ecCopy + ShortCut = 16429 + end + item + Command = ecPaste + ShortCut = 8237 + end + item + Command = ecDeleteChar + ShortCut = 46 + end + item + Command = ecCut + ShortCut = 8238 + end + item + Command = ecDeleteLastChar + ShortCut = 8 + end + item + Command = ecDeleteLastChar + ShortCut = 8200 + end + item + Command = ecDeleteLastWord + ShortCut = 16392 + end + item + Command = ecUndo + ShortCut = 32776 + end + item + Command = ecRedo + ShortCut = 40968 + end + item + Command = ecLineBreak + ShortCut = 13 + end + item + Command = ecSelectAll + ShortCut = 16449 + end + item + Command = ecCopy + ShortCut = 16451 + end + item + Command = ecBlockIndent + ShortCut = 24649 + end + item + Command = ecLineBreak + ShortCut = 16461 + end + item + Command = ecInsertLine + ShortCut = 16462 + end + item + Command = ecDeleteWord + ShortCut = 16468 + end + item + Command = ecBlockUnindent + ShortCut = 24661 + end + item + Command = ecPaste + ShortCut = 16470 + end + item + Command = ecCut + ShortCut = 16472 + end + item + Command = ecDeleteLine + ShortCut = 16473 + end + item + Command = ecDeleteEOL + ShortCut = 24665 + end + item + Command = ecUndo + ShortCut = 16474 + end + item + Command = ecRedo + ShortCut = 24666 + end + item + Command = ecGotoMarker0 + ShortCut = 16432 + end + item + Command = ecGotoMarker1 + ShortCut = 16433 + end + item + Command = ecGotoMarker2 + ShortCut = 16434 + end + item + Command = ecGotoMarker3 + ShortCut = 16435 + end + item + Command = ecGotoMarker4 + ShortCut = 16436 + end + item + Command = ecGotoMarker5 + ShortCut = 16437 + end + item + Command = ecGotoMarker6 + ShortCut = 16438 + end + item + Command = ecGotoMarker7 + ShortCut = 16439 + end + item + Command = ecGotoMarker8 + ShortCut = 16440 + end + item + Command = ecGotoMarker9 + ShortCut = 16441 + end + item + Command = ecSetMarker0 + ShortCut = 24624 + end + item + Command = ecSetMarker1 + ShortCut = 24625 + end + item + Command = ecSetMarker2 + ShortCut = 24626 + end + item + Command = ecSetMarker3 + ShortCut = 24627 + end + item + Command = ecSetMarker4 + ShortCut = 24628 + end + item + Command = ecSetMarker5 + ShortCut = 24629 + end + item + Command = ecSetMarker6 + ShortCut = 24630 + end + item + Command = ecSetMarker7 + ShortCut = 24631 + end + item + Command = ecSetMarker8 + ShortCut = 24632 + end + item + Command = ecSetMarker9 + ShortCut = 24633 + end + item + Command = EcFoldLevel1 + ShortCut = 41009 + end + item + Command = EcFoldLevel2 + ShortCut = 41010 + end + item + Command = EcFoldLevel1 + ShortCut = 41011 + end + item + Command = EcFoldLevel1 + ShortCut = 41012 + end + item + Command = EcFoldLevel1 + ShortCut = 41013 + end + item + Command = EcFoldLevel6 + ShortCut = 41014 + end + item + Command = EcFoldLevel7 + ShortCut = 41015 + end + item + Command = EcFoldLevel8 + ShortCut = 41016 + end + item + Command = EcFoldLevel9 + ShortCut = 41017 + end + item + Command = EcFoldLevel0 + ShortCut = 41008 + end + item + Command = EcFoldCurrent + ShortCut = 41005 + end + item + Command = EcUnFoldCurrent + ShortCut = 41003 + end + item + Command = EcToggleMarkupWord + ShortCut = 32845 + end + item + Command = ecNormalSelect + ShortCut = 24654 + end + item + Command = ecColumnSelect + ShortCut = 24643 + end + item + Command = ecLineSelect + ShortCut = 24652 + end + item + Command = ecTab + ShortCut = 9 + end + item + Command = ecShiftTab + ShortCut = 8201 + end + item + Command = ecMatchBracket + ShortCut = 24642 + end + item + Command = ecColSelUp + ShortCut = 40998 + end + item + Command = ecColSelDown + ShortCut = 41000 + end + item + Command = ecColSelLeft + ShortCut = 40997 + end + item + Command = ecColSelRight + ShortCut = 40999 + end + item + Command = ecColSelPageDown + ShortCut = 40994 + end + item + Command = ecColSelPageBottom + ShortCut = 57378 + end + item + Command = ecColSelPageUp + ShortCut = 40993 + end + item + Command = ecColSelPageTop + ShortCut = 57377 + end + item + Command = ecColSelLineStart + ShortCut = 40996 + end + item + Command = ecColSelLineEnd + ShortCut = 40995 + end + item + Command = ecColSelEditorTop + ShortCut = 57380 + end + item + Command = ecColSelEditorBottom + ShortCut = 57379 + end> + MouseActions = <> + MouseTextActions = <> + MouseSelActions = <> + Lines.Strings = ( + '--- C:\MC\Code\Projects\Voronwe\GUI\FrontEnd\LazPaleo\src\prj\laz\paleo.lpi' + '+++ C:\MC\Code\Projects\Voronwe\GUI\FrontEnd\LazPaleo\src\prj\laz\paleo.lpi' + '@@ -3,23 +3,111 @@' + ' ' + ' ' + ' ' + ' ' + ' ' + '- ' + '+ <Title Value="Paleo"/>' + ' <ResourceType Value="res"/>' + ' <UseXPManifest Value="True"/>' + '+ <XPManifest>' + '+ <DpiAware Value="True"/>' + '+ <UIAccess Value="True"/>' + '+ </XPManifest>' + ' <Icon Value="0"/>' + ' </General>' + ' <i18n>' + ' <EnableI18N LFM="False"/>' + ' </i18n>' + ' <VersionInfo>' + '- <StringTable ProductVersion=""/>' + '+ <UseVersionInfo Value="True"/>' + '+ <MinorVersionNr Value="2"/>' + '+ <Language Value="0809"/>' + '+ <StringTable CompanyName="Voronwë" FileDescription="Fossil UI" InternalName="paleo" LegalCopyright="© Martijn Coppoolse" OriginalFilename="paleo" ProductName="Stylemys" ProductVersion=""/>' + ' </VersionInfo>' + '- <BuildModes Count="1">' + '+ <BuildModes Count="3">' + ' <Item1 Name="Default" Default="True"/>' + '+ <Item2 Name="Debug">' + '+ <CompilerOptions>' + '+ <Version Value="11"/>' + '+ <Target>' + '+ <Filename Value="../../out/$(TargetCPU)-$(TargetOS)/paleo"/>' + '+ </Target>' + '+ <SearchPaths>' + '+ <IncludeFiles Value="$(ProjOutDir)"/>' + '+ <OtherUnitFiles Value="../.."/>' + '+ <UnitOutputDirectory Value="../../out/lib/$(TargetCPU)-$(TargetOS)"/>' + '+ </SearchPaths>' + '+ <Parsing>' + '+ <SyntaxOptions>' + '+ <IncludeAssertionCode Value="True"/>' + '+ </SyntaxOptions>' + '+ </Parsing>' + '+ <CodeGeneration>' + '+ <Checks>' + '+ <IOChecks Value="True"/>' + '+ <RangeChecks Value="True"/>' + '+ <OverflowChecks Value="True"/>' + '+ <StackChecks Value="True"/>' + '+ </Checks>' + '+ </CodeGeneration>' + '+ <Linking>' + '+ <Debugging>' + '+ <DebugInfoType Value="dsDwarf2Set"/>' + '+ <UseHeaptrc Value="True"/>' + '+ <UseExternalDbgSyms Value="True"/>' + '+ </Debugging>' + '+ <Options>' + '+ <Win32>' + '+ <GraphicApplication Value="True"/>' + '+ </Win32>' + '+ </Options>' + '+ </Linking>' + '+ <Other>' + '+ <CompilerMessages>' + '+ <MsgFileName Value=""/>' + '+ </CompilerMessages>' + '+ <CompilerPath Value="$(CompPath)"/>' + '+ </Other>' + '+ </CompilerOptions>' + '+ </Item2>' + '+ <Item3 Name="Release">' + '+ <CompilerOptions>' + '+ <Version Value="11"/>' + '+ <Target>' + '+ <Filename Value="../../../out/$(TargetCPU)-$(TargetOS)/paleo"/>' + '+ </Target>' + '+ <SearchPaths>' + '+ <IncludeFiles Value="$(ProjOutDir)"/>' + '+ <OtherUnitFiles Value="../.."/>' + '+ <UnitOutputDirectory Value="../../../out/lib/$(TargetCPU)-$(TargetOS)"/>' + '+ </SearchPaths>' + '+ <CodeGeneration>' + '+ <SmartLinkUnit Value="True"/>' + '+ <Optimizations>' + '+ <OptimizationLevel Value="3"/>' + '+ </Optimizations>' + '+ <SmallerCode Value="True"/>' + '+ </CodeGeneration>' + '+ <Linking>' + '+ <Debugging>' + '+ <GenerateDebugInfo Value="False"/>' + '+ </Debugging>' + '+ <LinkSmart Value="True"/>' + '+ <Options>' + '+ <Win32>' + '+ <GraphicApplication Value="True"/>' + '+ </Win32>' + '+ </Options>' + '+ </Linking>' + '+ <Other>' + '+ <CompilerMessages>' + '+ <MsgFileName Value=""/>' + '+ </CompilerMessages>' + '+ <CompilerPath Value="$(CompPath)"/>' + '+ </Other>' + '+ </CompilerOptions>' + '+ </Item3>' + ' </BuildModes>' + ' <PublishOptions>' + ' <Version Value="2"/>' + ' </PublishOptions>' + ' <RunParams>' + '@@ -76,16 +164,16 @@' + ' </Units>' + ' </ProjectOptions>' + ' <CompilerOptions>' + ' <Version Value="11"/>' + ' <Target>' + '- <Filename Value="paleo"/>' + '+ <Filename Value="../../out/$(TargetCPU)-$(TargetOS)/paleo"/>' + ' </Target>' + ' <SearchPaths>' + ' <IncludeFiles Value="$(ProjOutDir)"/>' + ' <OtherUnitFiles Value="../.."/>' + '- <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>' + '+ <UnitOutputDirectory Value="../../out/lib/$(TargetCPU)-$(TargetOS)"/>' + ' </SearchPaths>' + ' <Linking>' + ' <Options>' + ' <Win32>' + ' <GraphicApplication Value="True"/>' + ) + Options = [eoAutoIndent, eoBracketHighlight, eoEnhanceHomeKey, eoGroupUndo, eoHideRightMargin, eoKeepCaretX, eoNoCaret, eoShowScrollHint, eoTabIndent, eoAltSetsColumnMode, eoShowCtrlMouseLinks] + Options2 = [eoCaretSkipTab, eoEnhanceEndKey, eoOverwriteBlock, eoAutoHideCursor] + MouseOptions = [emAltSetsColumnMode, emShowCtrlMouseLinks] + VisibleSpecialChars = [vscSpace, vscTabAtLast] + OverwriteCaret = ctHalfBlock + ReadOnly = True + RightEdge = -1 + ScrollBars = ssAutoBoth + SelectedColor.BackPriority = 50 + SelectedColor.ForePriority = 50 + SelectedColor.FramePriority = 50 + SelectedColor.BoldPriority = 50 + SelectedColor.ItalicPriority = 50 + SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 + BracketHighlightStyle = sbhsBoth + BracketMatchColor.Background = clNone + BracketMatchColor.Foreground = clNone + BracketMatchColor.Style = [fsBold] + FoldedCodeColor.Background = clNone + FoldedCodeColor.Foreground = clGray + FoldedCodeColor.FrameColor = clGray + MouseLinkColor.Background = clNone + MouseLinkColor.Foreground = clBlue + LineHighlightColor.Background = clNone + LineHighlightColor.Foreground = clNone + TabWidth = 4 + WantTabs = False + inline SynLeftGutterPartList1: TSynGutterPartList + object SynGutterMarks1: TSynGutterMarks + Width = 24 + MouseActions = <> + end + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 19 + Visible = False + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterSeparator1: TSynGutterSeparator + Width = 2 + Visible = False + MouseActions = <> + MarkupInfo.Background = clWhite + MarkupInfo.Foreground = clGray + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + MouseActions = <> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = <> + MouseActionsCollapsed = <> + end + end + end + end + object tbrFileVersion: TToolBar + Left = 0 + Height = 26 + Top = 0 + Width = 573 + Caption = 'tbrFileVersion' + EdgeBorders = [] + EdgeInner = esNone + EdgeOuter = esNone + Images = modMain.imlMain + TabOrder = 1 + object btnExternalDiff: TToolButton + Left = 24 + Hint = 'View in external diff tool' + Top = 0 + Caption = 'External diff' + ImageIndex = 8 + OnClick = btnExternalDiffClick + end + object btnDiffTK: TToolButton + Left = 1 + Hint = 'TK-based Diff viewer' + Top = 0 + Caption = 'DiffTK' + ImageIndex = 9 + OnClick = btnDiffTKClick + end + end +end ADDED src/a_fileversioninfo.pas Index: src/a_fileversioninfo.pas ================================================================== --- /dev/null +++ src/a_fileversioninfo.pas @@ -0,0 +1,475 @@ +unit A_FileVersionInfo; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Types, Controls, ComCtrls, ExtCtrls, + SynEdit, SynEditHighlighter, + M_Main, M_Highlighters, + U_Fossil; + +type + + { TfraFileVersionInfo } + + TfraFileVersionInfo = class(TFrame) + btnDiffTK: TToolButton; + btnExternalDiff: TToolButton; + imgContents: TImage; + synEdit: TSynEdit; + tbcView: TTabControl; + tbrFileVersion: TToolBar; + procedure btnDiffTKClick(Sender: TObject); + procedure btnExternalDiffClick(Sender: TObject); + procedure synEditMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure tbcViewChange(Sender: TObject); + procedure tbcViewChanging(Sender: TObject; var AllowChange: Boolean); + procedure tbcViewGetImageIndex(Sender: TObject; TabIndex: Integer; + var ImageIndex: Integer); + private + FFile: TFileVersion; + FExternalDiffCmd: string; + + function DetermineFileHighlighter(const AvoidMulti: Boolean = False): TSynCustomHighlighter; + + procedure SetFile(AValue: TFileVersion); + { private declarations } + public + { public declarations } + constructor Create(AOwner: TComponent); override; + + procedure SelectFile(const AFile: TFileVersion; const Selected: Boolean); + procedure PopulateView; + published + property ActiveFile: TFileVersion read FFile write SetFile; + end; + +implementation +uses + StrUtils, Graphics, + SynGutterLineNumber; + +{$R *.lfm} + +const + cGraphicsClasses: array[0..8] of TGraphicClass = (TCursorImage, TBitmap, TIcon, TIcnsIcon, + TPixmap, TPortableNetworkGraphic, TJpegImage, + TPortableAnyMapGraphic, TTiffImage); + + +{ TfraFileVersionInfo } + +constructor TfraFileVersionInfo.Create(AOwner: TComponent); +var + s: string; + GC: TGraphicClass; + Exts: TStringList; +begin + inherited Create(AOwner); + + for s in cEditorFontNames do begin + if Screen.Fonts.IndexOf(s) > -1 then begin + synEdit.Font.Name := s; + Break; + end; + end; + + Exts := TStringList.Create; + try + Exts.CaseSensitive := False; + Exts.Delimiter := ';'; + for GC in cGraphicsClasses do begin + Exts.DelimitedText := GC.GetFileExtensions; + for s in Exts do begin + TPicture.RegisterFileFormat(s, GC.ClassName, GC); + end; + end; + finally + Exts.Free; + end; + + tbcView.TabIndex := 0; + + if Assigned(modMain.Checkout) then + FExternalDiffCmd := modMain.Checkout.Settings.Values['gdiff-command']; + btnExternalDiff.Enabled := (FExternalDiffCmd <> ''); +end; + +procedure TfraFileVersionInfo.synEditMouseWheel(Sender: TObject; + Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +var + SizeOffset: Integer; +begin + if ssCtrl in Shift then begin + // TODO: test this with user-set font sizes as well; both on Mac and Windows + if WheelDelta > 0 then + SizeOffset := -1 + else + SizeOffset := 1; + synEdit.BeginUpdate(False); + try + synEdit.Font.Size := synEdit.Font.Size + SizeOffset; + finally + synEdit.EndUpdate; + end; + Handled := True; + end; +end; + +procedure TfraFileVersionInfo.tbcViewChange(Sender: TObject); +begin + PopulateView; +end; + +procedure TfraFileVersionInfo.tbcViewChanging(Sender: TObject; + var AllowChange: Boolean); +begin + // TODO: check if the current page can be left? Shame we don't know where we're going TO... +end; + +procedure TfraFileVersionInfo.tbcViewGetImageIndex(Sender: TObject; + TabIndex: Integer; var ImageIndex: Integer); +begin + case TabIndex of + 0: begin // Diff + ImageIndex := 8; + end; + 1: begin // Wide diff + ImageIndex := 9; + end; + 2: begin // Content + ImageIndex := 11; + end; + 3: begin // Annotated + ImageIndex := 10; + end; + 4: begin // Hexadecimal + ImageIndex := 12; + end; + end; +end; + +procedure TfraFileVersionInfo.btnExternalDiffClick(Sender: TObject); +begin + MessageBoxFunction(PChar('To be done:' + LineEnding + FExternalDiffCmd), 'Not implemented', 64); + + if not Assigned(FFile) then + Exit; + + // TODO: FFile.RunDiffExternal(); + + // TODO: copy and port (almost) code from existing project; see + // https://fossil.2of4.net/paleo/artifact/4bebe7bb2a5135e7cd4a9575760e7bf5b26f9bc1?ln=385-494 + + // TODO: if we've got a file from the repo (not a local one), save its contents to a temp file. + // TODO: Save a temp copy of the 'other' version to a temp file. + + // TODO: run the diff command + + // TODO: remember the temp files, to be deleted on exit of the program. + // See https://fossil.2of4.net/paleo/artifact/4bebe7bb2a5135e7cd4a9575760e7bf5b26f9bc1?ln=116-126 + // and https://fossil.2of4.net/paleo/artifact/4bebe7bb2a5135e7cd4a9575760e7bf5b26f9bc1?ln=1155-1192 +end; + +procedure TfraFileVersionInfo.btnDiffTKClick(Sender: TObject); +var + DiffOpts: TDiffOptions; +begin + if not Assigned(FFile) then + Exit; + + DiffOpts := cDefaultDiffOptions; + DiffOpts.External := True; + DiffOpts.SideBySide := True; + FFile.GetDiff({var}DiffOpts); +end; + +procedure TfraFileVersionInfo.SelectFile(const AFile: TFileVersion; + const Selected: Boolean); +begin + // TODO: if selected, then add to list of files + // TODO: if not selected, then remove from list of files + // TODO: if more than one file selected, do diffs for all of them, but don't show contents or + // annotation. External diff is fine if they're all workfiles, otherwise no go. + // TODO: if no file is selected, then clear everything. + if Selected then + SetFile(AFile) + else if AFile = FFile then + SetFile(nil); +end; + +procedure TfraFileVersionInfo.SetFile(AValue: TFileVersion); +var + HasDiff, HasHistory, HasContent: Boolean; +begin + if (AValue = FFile) then + Exit; + + FFile := AValue; + + if not Assigned(FFile) then begin + HasDiff := False; + HasHistory := False; + HasContent := False; + end else begin + HasDiff := FFile.Statuses * (fsChanged - [fsAdded, fsMissing, fsDeleted]) <> []; + HasHistory := FFile.Statuses * (fsChanged - [fsAdded] + [fsUnchanged]) <> []; + HasContent := FileExistsUTF8(FFile.RealPath); + end; + // TODO: can the tabs be disabled or hidden? + //btnViewDiff.Enabled := HasDiff; + //btnViewDiffWide.Enabled := HasDiff; + //btnViewAnnotate.Enabled := HasHistory; + //btnViewContents.Enabled := HasContent; + //btnViewHex.Enabled := HasContent; + btnDiffTK.Enabled := HasDiff; + btnExternalDiff.Enabled := HasDiff and (FExternalDiffCmd <> ''); + + PopulateView; +end; + +function IndexOfText(const Needle: string; const Haystack: array of string): Integer; +var + i: Integer; +begin + Result := -1; + for i := Low(Haystack) to High(Haystack) do begin + if SameText(Needle, Haystack[i]) then begin + Result := i; + Break; + end; + end; +end; + +procedure TfraFileVersionInfo.PopulateView; +const + cControlChars: array[0..31] of string = ('␀', '␁', '␂', '␃', '␄', '␅', '␆', '␇', '␈', '␉', '␊', '␋', '␌', '␍', '␎', '␏', '␐', '␑', '␒', '␓', '␔', '␕', '␖', '␗', '␘', '␙', '␚', '␛', '␜', '␝', '␞', '␟'); + cControlGlyphs: array[0..31] of widestring = (#$00A0, #$263A, #$263B, #$2665, #$2666, #$2663, #$2660, #$2022, #$25D8, #$25EF, #$25D9, #$2642, #$2640, #$266A, #$266C, #$263C, #$25BA, #$25C4, #$2195, #$203C, #$00B6, #$00A7, #$25AC, #$21A8, #$2191, #$2193, #$2192, #$2190, #$2319, #$2194, #$25B2, #$25BC); +var + DiffOpts: TDiffOptions; + Contents: TStream; + sContents: string; + CharPos: Integer; + ContentWidth, NumberWidth: Integer; + sPreview: string; + B: Byte; +begin + synEdit.Visible := Assigned(FFile); + if not Assigned(FFile) then + Exit; + + // TODO: can we disable a tab? If not, automatically switch to the most relevant one. + + modMain.SetBusy(True); + synEdit.BeginUpdate(False); + try + // Disconnect the current highligher + synEdit.Highlighter := nil; + synEdit.Lines.Clear; + try + case tbcView.TabIndex of + 0, 1: begin // Diff, Side-by-side diff + if tbcView.TabIndex = 1 { Wide diff } then begin + synEdit.Highlighter := modHighlighters.shlDiffWide; + end else begin + synEdit.Highlighter := modHighlighters.shlDiff; + end; + + DiffOpts := cDefaultDiffOptions; + DiffOpts.SideBySide := (tbcView.TabIndex = 1); // btnViewDiffWide.Down; + DiffOpts.Width := (synEdit.CharsInWindow div 2) - 9; + synEdit.Lines.Text := FFile.GetDiff({var}DiffOpts); + + synEdit.Gutter.Parts.ByClass[TSynGutterLineNumber, 0].Visible := False; + + end; + 3: begin // Annotated + // request GetAnnotated including full log + sContents := FFile.GetAnnotated(True); + CharPos := Pos(#10'-', sContents); + if CharPos > 0 then begin + modHighlighters.RecycleAnnotator; + + // parse the log, and feed it to the highlighter + modHighlighters.shlAnnotate.SetVersionsFromLog(Copy(sContents, 1, CharPos - 1)); + + // Remove the log from the contents + CharPos := PosEx(#10, sContents, CharPos + 1); + if CharPos > 0 then + sContents := Copy(sContents, CharPos + 1, Length(sContents)) + else + sContents := ''; + + // The multi-highlighter has been known to cause crashes (SIGTRAP) + modHighlighters.shlAnnotate.Highlighter := DetermineFileHighlighter(True); + synEdit.Highlighter := modHighlighters.shlAnnotate; + end; + + // put the remainder in the Edit. + synEdit.Lines.Text := sContents; + synEdit.Gutter.Parts.ByClass[TSynGutterLineNumber, 0].Visible := True; + + end; + // else if btnViewContents.Down then begin + 2: begin + synEdit.Highlighter := DetermineFileHighlighter(); + Contents := FFile.GetContents; + try + if synEdit.Highlighter = nil then begin + // The file type was not recognized; we'll try the picture formats now + try + imgContents.Picture.LoadFromStreamWithFileExt(Contents, ExtractFileExt(FFile.Filename)); + imgContents.Stretch := (imgContents.Picture.Graphic.Width > imgContents.Width) + or (imgContents.Picture.Graphic.Height > imgContents.Height); + imgContents.Visible := True; + synEdit.Visible := False; + except + on E: Exception do begin + imgContents.Visible := False; + synEdit.Visible := True; + //MessageBoxFunction(PChar(E.Message), PChar(string(E.ClassName)), $30); + end {Exception}; + end {except}; + end {if}; + + if synEdit.Visible then begin + with TStringStream.Create('') do begin + CopyFrom(Contents, 0); + Position := 0; + synEdit.Lines.Text := DataString; + Free; + end; + end; + finally + Contents.Free; + end; + synEdit.Gutter.Parts.ByClass[TSynGutterLineNumber, 0].Visible := True; + end {contents}; + + 4: begin // hexadecimal + Contents := FFile.GetContents; + try + NumberWidth := Length(TrimLeftSet(IntToHex(Contents.Size, 16), ['0'])); + ContentWidth := (synEdit.CharsInWindow - NumberWidth - 4) div 4; + ContentWidth -= ContentWidth div 4; + case ContentWidth of + Low(Integer)..7: ContentWidth := 4; + 8..63: ContentWidth := (ContentWidth div 8) * 8; + else ContentWidth := 64; + end; + while Contents.Position < Contents.Size - 1 do begin + sContents += IntToHex(Contents.Position, NumberWidth); + sContents += ' '; + sPreview := ''; + CharPos := 0; + repeat + B := Contents.ReadByte; + Inc(CharPos); + sContents += IntToHex(B, 2) + ' '; + if (CharPos mod 4) = 0 then + sContents += ' '; + case B of + 0: sPreview += '·'; + 1..31: sPreview += UTF8Encode(cControlGlyphs[B]); + else sPreview += UTF8Encode(WideString(WideChar(B))); + end; + until (CharPos >= ContentWidth) or (Contents.Position >= Contents.Size); + if CharPos < ContentWidth then + sContents += StringOfChar(' ', (ContentWidth - CharPos + 1) * 3); + sContents += ' '; + sContents += sPreview; + sContents += LineEnding; + end {while}; + + synEdit.Lines.Text := sContents; + finally + Contents.Free; + end; + synEdit.Gutter.Parts.ByClass[TSynGutterLineNumber, 0].Visible := False; + end {hexadecimal}; + end {case}; + + if synEdit.Gutter.Parts.ByClass[TSynGutterLineNumber, 0].Visible then + synEdit.Options := synEdit.Options + [TSynEditorOption.eoShowScrollHint] + else + synEdit.Options := synEdit.Options - [TSynEditorOption.eoShowScrollHint]; + + except + on E: Exception do begin + synEdit.Highlighter := modHighlighters.shlINI; + synEdit.Lines.Add('[' + E.ClassName + ']'); + synEdit.Lines.Add(E.Message); + synEdit.Gutter.Parts.ByClass[TSynGutterLineNumber, 0].Visible := False; + end; + end; + finally + synEdit.EndUpdate; + modMain.SetBusy(False); + end; +end {TfraFileVersionInfo.PopulateView}; + +function TfraFileVersionInfo.DetermineFileHighlighter(const AvoidMulti: Boolean = False): TSynCustomHighlighter; +var + Ext: TFileName; +begin + // TODO: use the DefaultFilter, split by ListSeparator, to determine which + // highlighter to use. + // Or figure out a more easily configurable way to assign highlighters to extensions. + + Ext := ExtractFileExt(FFile.Filename); + if IndexOfText(Ext, ['.pas', '.pp', '.lfm', '.lpr', '.lrs', '.dfm', '.dpr', '.fmx']) > -1 then begin + Result := modHighlighters.shlPascal; + end else if IndexOfText(Ext, ['.ini', '.dsk', '.vlb']) > -1 then begin + Result := modHighlighters.shlINI; + end else if IndexOfText(Ext, ['.xml', '.xsl', '.xslt', '.xsd', '.dtd', '.dproj', '.groupproj', '.deployproj', '.bdsproj', '.bdsgroup', '.config', '.manifest', '.lpi']) > -1 then begin + Result := modHighlighters.shlXML; + end else if IndexOfText(Ext, ['.htm', '.html', '.shtml', '.asp', '.aspx', '.asmx']) > -1 then begin + if AvoidMulti then + Result := modHighlighters.shlHTML + else + Result := modHighlighters.shlMulti; + end else if IndexOfText(Ext, ['.js', '.json']) > -1 then begin + Result := modHighlighters.shlJS; + end else if IndexOfText(Ext, ['.css']) > -1 then begin + Result := modHighlighters.shlCSS; + end else if IndexOfText(Ext, ['.sql']) > -1 then begin + Result := modHighlighters.shlSQL; + end else if IndexOfText(Ext, ['.pl']) > -1 then begin + Result := modHighlighters.shlPerl; + end else if IndexOfText(Ext, ['.php', '.php4', '.php5']) > -1 then begin + if AvoidMulti then + Result := modHighlighters.shlPHP + else + Result := modHighlighters.shlMulti; + end else if IndexOfText(Ext, ['.py']) > -1 then begin + Result := modHighlighters.shlPython; + end else if IndexOfText(Ext, ['.bas', '.vb', '.frm']) > -1 then begin + Result := modHighlighters.shlBasic; + end else if IndexOfText(Ext, ['.c', '.h', '.cpp', '.hpp']) > -1 then begin + Result := modHighlighters.shlCpp; + end else if IndexOfText(Ext, ['.sh']) > -1 then begin + Result := modHighlighters.shlShell; + end else if IndexOfText(Ext, ['.bat', '.cmd']) > -1 then begin + Result := modHighlighters.shlBatch; + end else if IndexOfText(Ext, ['.diff']) > -1 then begin + Result := modHighlighters.shlDiff; + end else if IndexOfText(Ext, ['.java', '.javaw']) > -1 then begin + Result := modHighlighters.shlJava; + end else if IndexOfText(Ext, ['.po']) > -1 then begin + Result := modHighlighters.shlPO; + + // TODO: all other file types and highlighters + + + end else begin + Result := nil; + end; +end; + + +end. + ADDED src/f_commit.lfm Index: src/f_commit.lfm ================================================================== --- /dev/null +++ src/f_commit.lfm @@ -0,0 +1,172 @@ +object frmCommit: TfrmCommit + Left = 221 + Height = 470 + Top = 211 + Width = 946 + Caption = 'Commit' + ClientHeight = 470 + ClientWidth = 946 + Menu = modMain.mnuMain + OnCreate = FormCreate + OnShow = FormShow + Position = poScreenCenter + SessionProperties = 'Height;Left;pssLeft.Width;pssTop.Height;Top;Width;WindowState;pssRight.Left;pssBottom.Top' + ShowHint = True + LCLVersion = '1.6.4.0' + object pspLeftRight: TPairSplitter + Left = 4 + Height = 462 + Top = 4 + Width = 938 + Align = alClient + BorderSpacing.Around = 4 + Position = 260 + object pssLeft: TPairSplitterSide + Cursor = crArrow + Left = 0 + Height = 462 + Top = 0 + Width = 260 + ClientWidth = 260 + ClientHeight = 462 + inline frameFileList: TfraFileList + Height = 462 + Width = 260 + Align = alClient + ClientHeight = 462 + ClientWidth = 260 + inherited lvwFiles: TListView + Height = 436 + Width = 260 + Columns = < + item + Caption = 'Name' + MinWidth = 50 + Width = 150 + end + item + Caption = 'Path' + ImageIndex = 11 + Width = 150 + end + item + Caption = 'Status' + Width = 20 + end + item + Caption = 'Type' + Width = 194 + end> + end + inherited tbrFiles: TToolBar + Width = 260 + inherited chkAll: TCheckBox + Height = 23 + Width = 24 + end + inherited btnSep1: TToolButton + Left = 25 + end + inherited btnStatus: TToolButton + Left = 30 + end + inherited btnSep3: TToolButton + Left = 223 + end + inherited btnRefresh: TToolButton + Left = 228 + end + inherited edtFilter: TEdit + Left = 70 + Height = 28 + end + inherited btnSep2: TToolButton + Left = 65 + end + end + end + end + object pssRight: TPairSplitterSide + Cursor = crArrow + Left = 265 + Height = 462 + Top = 0 + Width = 673 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ClientWidth = 673 + ClientHeight = 462 + object pspTopBottom: TPairSplitter + Cursor = crVSplit + Left = 0 + Height = 462 + Top = 0 + Width = 673 + Align = alClient + Position = 200 + SplitterType = pstVertical + object pssTop: TPairSplitterSide + Cursor = crArrow + Left = 0 + Height = 200 + Top = 0 + Width = 673 + ClientWidth = 673 + ClientHeight = 200 + inline fraCommitMessage: TframeCommitMessage + Height = 200 + Width = 673 + Align = alClient + ClientHeight = 200 + ClientWidth = 673 + end + end + object pssBottom: TPairSplitterSide + Cursor = crArrow + Left = 0 + Height = 257 + Top = 205 + Width = 673 + ClientWidth = 673 + ClientHeight = 257 + inline frameFileVersionInfo: TfraFileVersionInfo + Height = 257 + Width = 673 + Align = alClient + ClientHeight = 257 + ClientWidth = 673 + inherited tbcView: TTabControl + Height = 231 + Width = 673 + inherited imgContents: TImage + Height = 201 + Width = 669 + end + inherited synEdit: TSynEdit + Height = 201 + Width = 669 + Lines.Strings = ( ) + OverwriteCaret = ctBlock + end + end + inherited tbrFileVersion: TToolBar + Width = 673 + end + end + end + end + end + end + object xpsCommit: TXMLPropStorage + StoredValues = <> + RootNodePath = 'Commit/Form' + left = 240 + top = 152 + end + object ApplicationProperties: TApplicationProperties + ExceptionDialog = aedOkMessageBox + OnActivate = ApplicationPropertiesActivate + OnException = ApplicationPropertiesException + left = 240 + top = 288 + end +end ADDED src/f_commit.pas Index: src/f_commit.pas ================================================================== --- /dev/null +++ src/f_commit.pas @@ -0,0 +1,90 @@ +unit F_Commit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, IDEWindowIntf, SynEdit, Forms, Controls, + Graphics, Dialogs, PairSplitter, ExtCtrls, XMLPropStorage, ComCtrls, StdCtrls, + M_Main, A_FileList, A_FileVersionInfo, + U_Fossil, A_CommitMessage; + +type + + { TfrmCommit } + + TfrmCommit = class(TForm) + ApplicationProperties: TApplicationProperties; + fraCommitMessage: TframeCommitMessage; + frameFileVersionInfo: TfraFileVersionInfo; + frameFileList: TfraFileList; + pspTopBottom: TPairSplitter; + pssTop: TPairSplitterSide; + pssBottom: TPairSplitterSide; + pspLeftRight: TPairSplitter; + pssLeft: TPairSplitterSide; + pssRight: TPairSplitterSide; + xpsCommit: TXMLPropStorage; + procedure ApplicationPropertiesActivate(Sender: TObject); + procedure ApplicationPropertiesException(Sender: TObject; E: Exception); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure frameFileListSelectionChanged(Sender: TObject; AFile: TFileVersion; Selected: Boolean); + procedure fraCommitMessageGetFiles(Sender: TObject; const AFiles: TFossilFileList); + private + { private declarations } + public + { public declarations } + end; + +var + frmCommit: TfrmCommit; + +implementation + +{$R *.lfm} + +{ TfrmCommit } + +procedure TfrmCommit.FormCreate(Sender: TObject); +begin + frameFileList.OnSelectionChanged := @frameFileListSelectionChanged; + fraCommitMessage.OnGetFiles := @fraCommitMessageGetFiles; +end; + +procedure TfrmCommit.FormShow(Sender: TObject); +begin + if Assigned(modMain.Checkout) then begin + Caption := 'Commit - ' + modMain.Checkout.Info.Values['project-name']; + frameFileList.Revision := modMain.Checkout.Workdir; + fraCommitMessage.WorkDir := modMain.Checkout.Workdir; + end; +end; + +procedure TfrmCommit.ApplicationPropertiesActivate(Sender: TObject); +begin + // TODO: autorefresh? + //frameFileList.btnRefresh.Click; +end; + +procedure TfrmCommit.ApplicationPropertiesException(Sender: TObject; + E: Exception); +begin + Application.ShowException(E); // TODO: use another dialog +end; + +procedure TfrmCommit.frameFileListSelectionChanged(Sender: TObject; + AFile: TFileVersion; Selected: Boolean); +begin + frameFileVersionInfo.SelectFile(AFile, Selected); +end; + +procedure TfrmCommit.fraCommitMessageGetFiles(Sender: TObject; + const AFiles: TFossilFileList); +begin + frameFileList.LoadCheckedFiles(AFiles); +end; + +end. + ADDED src/f_newbranch.lfm Index: src/f_newbranch.lfm ================================================================== --- /dev/null +++ src/f_newbranch.lfm @@ -0,0 +1,69 @@ +object frmNewBranch: TfrmNewBranch + Left = 270 + Height = 132 + Top = 142 + Width = 437 + BorderIcons = [biSystemMenu] + Caption = 'Next commit' + ClientHeight = 132 + ClientWidth = 437 + OnCreate = FormCreate + Position = poOwnerFormCenter + ShowInTaskBar = stNever + LCLVersion = '1.4.4.0' + object rbnCurrentBranch: TRadioButton + Left = 8 + Height = 18 + Top = 8 + Width = 156 + Caption = 'in current branch "%s"' + Checked = True + OnClick = rbnCurrentBranchClick + TabOrder = 0 + TabStop = True + end + object chkCloseBranch: TCheckBox + Left = 24 + Height = 18 + Top = 32 + Width = 98 + Caption = 'close branch' + TabOrder = 1 + end + object rbnNewBranch: TRadioButton + Left = 8 + Height = 18 + Top = 64 + Width = 105 + Caption = 'in new branch' + OnClick = rbnNewBranchClick + TabOrder = 2 + end + object edtBranchName: TEdit + Left = 129 + Height = 22 + Top = 64 + Width = 302 + Anchors = [akTop, akLeft, akRight] + Enabled = False + TabOrder = 3 + end + object pnlButtons: TButtonPanel + Left = 6 + Height = 22 + Top = 104 + Width = 425 + OKButton.Name = 'OKButton' + OKButton.DefaultCaption = True + HelpButton.Name = 'HelpButton' + HelpButton.DefaultCaption = True + CloseButton.Name = 'CloseButton' + CloseButton.DefaultCaption = True + CancelButton.Name = 'CancelButton' + CancelButton.DefaultCaption = True + TabOrder = 4 + Spacing = 8 + ShowButtons = [pbOK, pbCancel] + ShowBevel = False + end +end ADDED src/f_newbranch.pas Index: src/f_newbranch.pas ================================================================== --- /dev/null +++ src/f_newbranch.pas @@ -0,0 +1,92 @@ +unit F_NewBranch; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + ButtonPanel, + U_Fossil; + +type + + { TfrmNewBranch } + + TfrmNewBranch = class(TForm) + pnlButtons: TButtonPanel; + chkCloseBranch: TCheckBox; + edtBranchName: TEdit; + rbnCurrentBranch: TRadioButton; + rbnNewBranch: TRadioButton; + procedure FormCreate(Sender: TObject); + procedure rbnCurrentBranchClick(Sender: TObject); + procedure rbnNewBranchClick(Sender: TObject); + private + FBranch: string; + procedure EnableControls; + function GetCloseBranch: Boolean; + function GetBranchName: string; + { private declarations } + public + { public declarations } + procedure Initialize(const ACurrentBranch: string; const ACommitOptions: TCommitOptions); + + property CurrentBranch: string read FBranch; + property BranchName: string read GetBranchName; + property CloseBranch: Boolean read GetCloseBranch; + end; + +implementation + +{$R *.lfm} + +{ TfrmNewBranch } + +procedure TfrmNewBranch.FormCreate(Sender: TObject); +begin + EnableControls; +end; + +procedure TfrmNewBranch.rbnCurrentBranchClick(Sender: TObject); +begin + EnableControls; +end; + +procedure TfrmNewBranch.rbnNewBranchClick(Sender: TObject); +begin + EnableControls; +end; + +procedure TfrmNewBranch.EnableControls; +begin + chkCloseBranch.Enabled := rbnCurrentBranch.Checked; + edtBranchName.Enabled := rbnNewBranch.Checked; +end; + +function TfrmNewBranch.GetCloseBranch: Boolean; +begin + Result := rbnCurrentBranch.Checked and chkCloseBranch.Checked; +end; + +function TfrmNewBranch.GetBranchName: string; +begin + if rbnNewBranch.Checked then + Result := Trim(edtBranchName.Text) + else + Result := FBranch; +end; + +procedure TfrmNewBranch.Initialize(const ACurrentBranch: string; const ACommitOptions: TCommitOptions); +begin + FBranch := ACurrentBranch; + rbnCurrentBranch.Caption := Format('in current branch "%s"', [FBranch]); + rbnCurrentBranch.Checked := (ACommitOptions.BranchName = FBranch); + chkCloseBranch.Checked := ACommitOptions.CloseBranch; + rbnNewBranch.Checked := not rbnCurrentBranch.Checked; + if rbnNewBranch.Checked then + edtBranchName.Text := ACommitOptions.BranchName; +end; + +end. + ADDED src/f_opencheckout.lfm Index: src/f_opencheckout.lfm ================================================================== --- /dev/null +++ src/f_opencheckout.lfm @@ -0,0 +1,162 @@ +object frmOpenCheckout: TfrmOpenCheckout + Left = 278 + Height = 531 + Top = 72 + Width = 696 + Caption = 'Open checkout' + ClientHeight = 531 + ClientWidth = 696 + OnCloseQuery = FormCloseQuery + Position = poScreenCenter + LCLVersion = '1.6.4.0' + object pgcSource: TPageControl + Left = 0 + Height = 344 + Top = 0 + Width = 696 + ActivePage = tshRecentCheckout + Align = alClient + TabIndex = 0 + TabOrder = 0 + object tshRecentCheckout: TTabSheet + Caption = 'Recent checkouts' + ClientHeight = 311 + ClientWidth = 688 + object lvwCheckouts: TListView + Left = 0 + Height = 311 + Top = 0 + Width = 688 + Align = alClient + BorderStyle = bsNone + Columns = < + item + AutoSize = True + Caption = 'Project' + Width = 66 + end + item + AutoSize = True + Caption = 'Branch' + Width = 65 + end + item + AutoSize = True + Caption = 'Path' + Width = 49 + end + item + AutoSize = True + Caption = 'Repository' + Width = 91 + end + item + Caption = 'Date' + end> + HideSelection = False + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = lvwCheckoutsColumnClick + OnCustomDrawItem = lvwCheckoutsCustomDrawItem + OnDblClick = lvwCheckoutsDblClick + OnSelectItem = lvwCheckoutsSelectItem + end + end + object tshOpen: TTabSheet + Caption = 'Select checkout' + ClientHeight = 316 + ClientWidth = 688 + object tvwFolders: TShellTreeView + Left = 0 + Height = 316 + Top = 0 + Width = 688 + Align = alClient + BorderStyle = bsNone + FileSortType = fstFoldersFirst + ReadOnly = True + RightClickSelect = True + TabOrder = 0 + Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] + ObjectTypes = [otFolders] + end + end + end + object pnlButtons: TPanel + Left = 0 + Height = 50 + Top = 481 + Width = 696 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 50 + ClientWidth = 696 + TabOrder = 1 + object btnOK: TButton + Left = 478 + Height = 33 + Top = 9 + Width = 104 + Anchors = [akRight, akBottom] + Caption = '&Open' + Default = True + Enabled = False + ModalResult = 1 + TabOrder = 0 + end + object btnCancel: TButton + Left = 590 + Height = 34 + Top = 8 + Width = 99 + Anchors = [akRight, akBottom] + Cancel = True + Caption = '&Cancel' + ModalResult = 2 + TabOrder = 1 + end + end + object pnlRepoInfo: TPanel + Left = 0 + Height = 129 + Top = 352 + Width = 696 + Align = alBottom + ClientHeight = 129 + ClientWidth = 696 + TabOrder = 2 + object mmoRepoInfo: TMemo + Left = 1 + Height = 127 + Top = 1 + Width = 694 + Align = alClient + BorderStyle = bsNone + Color = clBtnFace + Font.Name = 'Monospace' + Font.Pitch = fpFixed + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoVertical + TabOrder = 0 + WantReturns = False + end + end + object splRepo: TSplitter + Cursor = crVSplit + Left = 0 + Height = 8 + Top = 344 + Width = 696 + Align = alBottom + ResizeAnchor = akBottom + end + object tmrPopulate: TTimer + Enabled = False + Interval = 100 + OnTimer = tmrPopulateTimer + left = 616 + top = 88 + end +end ADDED src/f_opencheckout.pas Index: src/f_opencheckout.pas ================================================================== --- /dev/null +++ src/f_opencheckout.pas @@ -0,0 +1,469 @@ +unit F_OpenCheckout; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, + ShellCtrls, ExtCtrls, StdCtrls, Menus, + M_Main, U_Fossil, types; + +type + { TCheckoutRepoReader } + + TCheckoutRepoReader = class(TThread) + private + FFossil: TFossil; + FCheckouts: TStringList; + FOnFound: TNotifyEvent; + FCurrentPath: string; + FCurrentTitle: string; + FCurrentRepo: string; + FCurrentBranch: string; + procedure DoFound; + public + constructor Create(const AFossil: TFossil; const ACheckouts: TStringList; const AOnFound, AOnTerminate: TNotifyEvent); + destructor Destroy; override; + + procedure Execute; override; + + property OnFound: TNotifyEvent read FOnFound write FOnFound; + property CurrentPath: string read FCurrentPath; + property CurrentTitle: string read FCurrentTitle; + property CurrentRepo: string read FCurrentRepo; + property CurrentBranch: string read FCurrentBranch; + end; + + { TRepoReader } + + TRepoReader = class(TThread) + private + FFossil: TFossil; + FRepos: TStringList; + FOnFound: TNotifyEvent; + FCurrentTitle: string; + FCurrentRepo: string; + FTipBranch: string; + procedure DoFound; + public + constructor Create(const AFossil: TFossil; const ARepos: TStringList; const AOnFound, AOnTerminate: TNotifyEvent); + destructor Destroy; override; + + procedure Execute; override; + + property OnFound: TNotifyEvent read FOnFound write FOnFound; + property CurrentTitle: string read FCurrentTitle; + property CurrentRepo: string read FCurrentRepo; + property TipBranch: string read FTipBranch; + end; + +type + { TfrmOpenCheckout } + + TfrmOpenCheckout = class(TForm) + btnOK: TButton; + btnCancel: TButton; + lvwCheckouts: TListView; + mmoRepoInfo: TMemo; + pnlRepoInfo: TPanel; + pnlButtons: TPanel; + pgcSource: TPageControl; + splRepo: TSplitter; + tmrPopulate: TTimer; + tvwFolders: TShellTreeView; + tshRecentCheckout: TTabSheet; + tshOpen: TTabSheet; + procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); + procedure lvwCheckoutsColumnClick(Sender: TObject; Column: TListColumn); + procedure lvwCheckoutsCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure lvwCheckoutsDblClick(Sender: TObject); + procedure lvwCheckoutsSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure tmrPopulateTimer(Sender: TObject); + private + { private declarations } + FDirName: string; + FCheckoutReader: TCheckoutRepoReader; + FRepoReader: TRepoReader; + procedure PopulateCheckouts; + procedure FossilCheckoutFound(Sender: TObject); + procedure CheckoutReaderTerminate(Sender: TObject); + procedure PopulateRepos; + procedure FossilRepoFound(Sender: TObject); + procedure RepoReaderTerminate(Sender: TObject); + public + { public declarations } + function Execute: boolean; + + property SelectedDir: string read FDirName write FDirName; + end; + +implementation + +{$R *.lfm} + +{ TCheckoutRepoReader } + +constructor TCheckoutRepoReader.Create(const AFossil: TFossil; const ACheckouts: TStringList; const AOnFound, AOnTerminate: TNotifyEvent); +begin + inherited Create(False); + FFossil := TFossil.Create(AFossil.Executable); + FCheckouts := TStringList.Create; + FCheckouts.AddStrings(ACheckouts); + Self.OnFound := AOnFound; + Self.OnTerminate := AOnTerminate; + FreeOnTerminate := True; +end; + +destructor TCheckoutRepoReader.Destroy; +begin + FCheckouts.Free; + FFossil.Free; + inherited Destroy; +end; + +procedure TCheckoutRepoReader.Execute; +var + Lines: TStringList; + CheckoutPath: string; + CharPos: integer; +begin + Lines := TStringList.Create; + try + Lines.NameValueSeparator := ':'; + for CheckoutPath in FCheckouts do begin + FCurrentPath := CheckoutPath; + FCurrentTitle := ''; + FCurrentRepo := ''; + FCurrentBranch := ''; + try + FFossil.CurrentDir := CheckoutPath; + Lines.Text := FFossil.Run('info'); + if Self.Terminated then Break; + FCurrentTitle := Trim(Lines.Values['project-name']); + FCurrentRepo := Trim(Lines.Values['repository']); + if DirectorySeparator <> '/' then + FCurrentRepo := StringReplace(FCurrentRepo, '/', DirectorySeparator, [rfReplaceAll]); + FCurrentBranch := Trim(Lines.Values['tags']); + CharPos := Pos(', ', FCurrentBranch); + if CharPos > 0 then + FCurrentBranch := Copy(FCurrentBranch, 1, CharPos - 1); + except + on E: Exception do begin + FCurrentRepo := '<' + E.Message + '>'; + end; + end; + if Self.Terminated then Break; + Synchronize(@DoFound); + end; + finally + Lines.Free; + end; +end; + +procedure TCheckoutRepoReader.DoFound; +begin + FOnFound(Self); +end; + + +{ TRepoReader } + +constructor TRepoReader.Create(const AFossil: TFossil; + const ARepos: TStringList; const AOnFound, AOnTerminate: TNotifyEvent); +begin + inherited Create(False); + FFossil := TFossil.Create(AFossil.Executable); + FRepos := TStringList.Create; + FRepos.AddStrings(ARepos); + Self.OnFound := AOnFound; + Self.OnTerminate := AOnTerminate; + FreeOnTerminate := True; +end; + +destructor TRepoReader.Destroy; +begin + FRepos.Free; + FFossil.Free; + inherited Destroy; +end; + +procedure TRepoReader.Execute; +var + Lines: TStringList; + RepoPath: string; + CharPos: integer; +begin + Lines := TStringList.Create; + try + Lines.NameValueSeparator := ':'; + for RepoPath in FRepos do begin + FCurrentRepo := RepoPath; + if DirectorySeparator <> '/' then + FCurrentRepo := StringReplace(FCurrentRepo, '/', DirectorySeparator, [rfReplaceAll]); + FCurrentTitle := ''; + FTipBranch := ''; + try + Lines.Text := FFossil.Run('info -R ' + AnsiQuotedStr(RepoPath, '"')); + if Self.Terminated then Break; + FCurrentTitle := Trim(Lines.Values['project-name']); + + Lines.Text := FFossil.Run('info tip -R ' + AnsiQuotedStr(RepoPath, '"')); + if Self.Terminated then Break; + FTipBranch := Trim(Lines.Values['tags']); + CharPos := Pos(', ', FTipBranch); + if CharPos > 0 then + FTipBranch := Copy(FTipBranch, 1, CharPos - 1); + except + on E: Exception do begin + FCurrentRepo := '<' + E.Message + '>'; + end; + end; + if Self.Terminated then Break; + Synchronize(@DoFound); + end; + finally + Lines.Free; + end; +end; +procedure TRepoReader.DoFound; +begin + FOnFound(Self); +end; + + +{ TfrmOpenCheckout } + +procedure TfrmOpenCheckout.FormCloseQuery(Sender: TObject; var CanClose: boolean + ); +begin + if Assigned(FCheckoutReader) then begin + FCheckoutReader.Terminate; + FCheckoutReader.OnTerminate := nil; + end; + if Assigned(FRepoReader) then begin + FRepoReader.Terminate; + FRepoReader.OnTerminate := nil; + end; +end; + +procedure TfrmOpenCheckout.lvwCheckoutsColumnClick(Sender: TObject; + Column: TListColumn); +const + cOtherDirection: array[TSortDirection] of TSortDirection = (sdAscending, sdDescending); +begin + if lvwCheckouts.SortType = stNone then begin + lvwCheckouts.SortDirection := sdDescending; + lvwCheckouts.SortColumn := Column.Index; + lvwCheckouts.SortType := stText; + end else if lvwCheckouts.SortColumn = Column.Index then begin + lvwCheckouts.SortDirection := cOtherDirection[lvwCheckouts.SortDirection]; + end else begin + lvwCheckouts.SortColumn := Column.Index; + lvwCheckouts.SortDirection := sdDescending; + end; +end; + +procedure TfrmOpenCheckout.lvwCheckoutsCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Item.Cut then + Sender.Canvas.Font.Color := clRed; +end; + +function TfrmOpenCheckout.Execute: boolean; +begin + tmrPopulate.Enabled := True; + Result := (ShowModal = mrOK); +end; + +procedure TfrmOpenCheckout.tmrPopulateTimer(Sender: TObject); +begin + tmrPopulate.Enabled := False; + PopulateCheckouts; +end; + +procedure TfrmOpenCheckout.lvwCheckoutsSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +var + Branch: string; + CharPos: integer; + Repo: string; +begin + if Selected then begin + FDirName := Item.SubItems[1]; + try + mmoRepoInfo.Lines.NameValueSeparator := ':'; + if FDirName <> '' then begin + modMain.Fossil.CurrentDir := FDirName; + mmoRepoInfo.Text := modMain.Fossil.Run('info'); + btnOK.Enabled := True; + + if Item.Caption = '' then + Item.Caption := Trim(mmoRepoInfo.Lines.Values['project-name']); + Branch := Trim(mmoRepoInfo.Lines.Values['tags']); + CharPos := Pos(', ', Branch); + if CharPos > 0 then + Branch := Copy(Branch, 1, CharPos - 1); + if Item.SubItems[0] = '' then begin + Item.SubItems[0] := Branch; + end; + if Item.SubItems.Count < 3 then begin + Item.SubItems.Add(Trim(mmoRepoInfo.Lines.Values['repository'])); + end else if Item.SubItems[2] = '' then begin + Item.SubItems[2] := Trim(mmoRepoInfo.Lines.Values['repository']); + end; + end else begin + btnOK.Enabled := False; + if Item.SubItems.Count > 2 then begin + Repo := Item.SubItems[2]; + mmoRepoInfo.Text := modMain.Fossil.Run('info --verbose -R ' + AnsiQuotedStr(Repo, '"')); + if Item.Caption = '' then + Item.Caption := Trim(mmoRepoInfo.Lines.Values['project-name']); + end else begin + mmoRepoInfo.Text := ''; + end; + end; + except + on E: Exception do begin + btnOK.Enabled := False; + mmoRepoInfo.Text := E.Message; + end; + end; + end else if FDirName = Item.SubItems[1] then begin + FDirName := ''; + btnOK.Enabled := False; + mmoRepoInfo.Text := ''; + end; +end; + +procedure TfrmOpenCheckout.lvwCheckoutsDblClick(Sender: TObject); +begin + if btnOK.Enabled then + btnOK.Click; +end; + +procedure TfrmOpenCheckout.PopulateCheckouts; +var + RawLine, Line: string; + Item: TListItem; + Lines, Checkouts: TStringList; +begin + Checkouts := TStringList.Create; + try + lvwCheckouts.Items.BeginUpdate; + Lines := TStringList.Create; + try + Lines.Text := modMain.Fossil.Run('all list --ckout'); + for RawLine in Lines do begin + if DirectorySeparator <> '/' then + Line := StringReplace(RawLine, '/', DirectorySeparator, [rfReplaceAll]) + else + Line := RawLine; + Item := lvwCheckouts.Items.Add; + Item.Caption := ''; + Item.SubItems.Add(''); + Item.SubItems.Add(Line); + Checkouts.Add(Line); + end; + finally + Lines.Free; + lvwCheckouts.Items.EndUpdate; + end; + + Self.Cursor := crAppStart; + FCheckoutReader := TCheckoutRepoReader.Create(modMain.Fossil, Checkouts, @FossilCheckoutFound, @CheckoutReaderTerminate); + finally + Checkouts.Free; + end; +end; + +procedure TfrmOpenCheckout.PopulateRepos; +var + RawLine, Line: string; + Item: TListItem; + Lines, Repos: TStringList; +begin + Repos := TStringList.Create; + try + lvwCheckouts.Items.BeginUpdate; + Lines := TStringList.Create; + try + Lines.Text := modMain.Fossil.Run('all list'); + for RawLine in Lines do begin + if DirectorySeparator <> '/' then + Line := StringReplace(RawLine, '/', DirectorySeparator, [rfReplaceAll]) + else + Line := RawLine; + Repos.Add(Line); + end; + finally + Lines.Free; + lvwCheckouts.Items.EndUpdate; + end; + + Self.Cursor := crAppStart; + FRepoReader := TRepoReader.Create(modMain.Fossil, Repos, @FossilRepoFound, @RepoReaderTerminate); + finally + Repos.Free; + end; +end; + +procedure TfrmOpenCheckout.FossilCheckoutFound(Sender: TObject); +var + i: integer; + Item: TListItem; +begin + for i := 0 to lvwCheckouts.Items.Count - 1 do begin + Item := lvwCheckouts.Items[i]; + if SameFileName(Item.SubItems[1], FCheckoutReader.CurrentPath) then begin + Item.Caption := FCheckoutReader.CurrentTitle; + Item.SubItems[0] := FCheckoutReader.CurrentBranch; + Item.SubItems.Add(FCheckoutReader.CurrentRepo); + Item.Cut := Copy(FCheckoutReader.CurrentRepo, 1, 1) = '<'; + Break; + end; + end; +end; + +procedure TfrmOpenCheckout.CheckoutReaderTerminate(Sender: TObject); +begin + FCheckoutReader := nil; + Self.Cursor := crHourGlass; + PopulateRepos; +end; + +procedure TfrmOpenCheckout.FossilRepoFound(Sender: TObject); +var + i: integer; + Found: Boolean; + Item: TListItem; +begin + Found := False; + for i := 0 to lvwCheckouts.Items.Count - 1 do begin + Item := lvwCheckouts.Items[i]; + if SameFileName(Item.SubItems[2], FRepoReader.CurrentRepo) then begin + Found := True; + Break; + end; + end; + if not Found then begin + Item := lvwCheckouts.Items.Add; + Item.Caption := FRepoReader.CurrentTitle; + Item.SubItems.Add(FRepoReader.TipBranch); + Item.SubItems.Add(''); + Item.SubItems.Add(FRepoReader.CurrentRepo); + Item.Cut := Copy(FRepoReader.CurrentRepo, 1, 1) = '<'; + end; +end; + +procedure TfrmOpenCheckout.RepoReaderTerminate(Sender: TObject); +begin + FRepoReader := nil; + Self.Cursor := crDefault; +end; + +end. + ADDED src/lib/dirwatch.pas Index: src/lib/dirwatch.pas ================================================================== --- /dev/null +++ src/lib/dirwatch.pas @@ -0,0 +1,335 @@ +unit DirWatch; + +// ----------------------------------------------------------------------------- +// Component Name: TDirectoryWatch . +// Module: DirWatch . +// Description: Implements watching for file changes in a designated . +// directory (or directories). . +// Version: 1.4 . +// Date: 10-MAR-2003 . +// Target: Win32, Delphi 3 - Delphi 7 . +// Author: Angus Johnson, angusj-AT-myrealbox-DOT-com . +// A portion of code has been copied from the Drag & Drop . +// Component Suite which I co-authored with Anders Melander. . +// Copyright: © 2003 Angus Johnson . +// http://www.angusj.com/delphi/dirwatch.html . +// . +// Usage: 1. Add a TDirectoryWatch component to your form. . +// 2. Set its Directory property . +// 3. If you wish to watch its subdirectories too then set . +// the WatchSubDir property to true . +// 4. Assign the OnChange event . +// 5. Set Active to true . +// ----------------------------------------------------------------------------- + +interface + +uses + Windows, Messages, SysUtils, Forms, Classes; + +type + TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib, + nfSize, nfLastWrite, nfSecurity); + + TWatchThread = class; //forward declaration + + TDirectoryWatch = class(TComponent) + private + fWindowHandle: THandle; + fWatchThread: TWatchThread; + fWatchSubDirs: boolean; + fDirectory: string; + fActive: boolean; + fNotifyFilters: TNotifyFilters; //see FindFirstChangeNotification in winAPI + fOnChangeEvent: TNotifyEvent; + procedure SetActive(aActive: boolean); + procedure SetDirectory(aDir: string); + procedure SetWatchSubDirs(aWatchSubDirs: boolean); + procedure SetNotifyFilters(aNotifyFilters: TNotifyFilters); + procedure WndProc(var aMsg: TMessage); + public + constructor Create(aOwner: TComponent); override; + destructor Destroy; override; + published + property Directory: string read fDirectory write SetDirectory; + property NotifyFilters: TNotifyFilters + read fNotifyFilters write SetNotifyFilters; + property WatchSubDirs: boolean read fWatchSubDirs write SetWatchSubDirs; + property Active: boolean read fActive write SetActive; + property OnChange: TNotifyEvent read fOnChangeEvent write fOnChangeEvent; + end; + + TWatchThread = class(TThread) + private + fOwnerHdl: Thandle; + fChangeNotify : THandle; //Signals whenever Windows detects a change in . + //the watched directory . + fBreakEvent: THandle; //Signals when either the Directory property . + //changes or when the thread terminates . + fDirectory: string; + fWatchSubDirs: longbool; + fNotifyFilters: dword; + fFinished: boolean; + protected + procedure SetDirectory(const Value: string); + procedure ProcessFilenameChanges; + procedure Execute; override; + public + constructor Create( OwnerHdl: THandle; + const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword); + destructor Destroy; override; + procedure Terminate; + property Directory: string write SetDirectory; + end; + +procedure Register; + +implementation + +const + NOTIFYCHANGE_MESSAGE = WM_USER + 1; + +resourcestring + sInvalidDir = 'Invalid Directory: '; + +//---------------------------------------------------------------------------- +// Miscellaneous functions ... +//---------------------------------------------------------------------------- + +procedure Register; +begin + RegisterComponents('Samples', [TDirectoryWatch]); +end; +//---------------------------------------------------------------------------- + +function DirectoryExists(const Name: string): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributes(PChar(Name)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; + +//---------------------------------------------------------------------------- +// TDirectoryWatch methods ... +//---------------------------------------------------------------------------- + +constructor TDirectoryWatch.Create(aOwner: TComponent); +begin + inherited Create(aOwner); + //default Notify values - notify if either a file name or a directory name + //changes or if a file is modified ... + fNotifyFilters := [nfFilename, nfDirname, nfLastWrite]; + fDirectory := 'C:\'; + //this non-visual control needs to handle messages, so ... + if not (csDesigning in ComponentState) then + fWindowHandle := AllocateHWnd(WndProc); +end; +//---------------------------------------------------------------------------- + +destructor TDirectoryWatch.Destroy; +begin + Active := false; + if not (csDesigning in ComponentState) then + DeallocateHWnd(fWindowHandle); + inherited Destroy; +end; +//---------------------------------------------------------------------------- + +procedure TDirectoryWatch.WndProc(var aMsg: TMessage); +begin + with aMsg do + if Msg = NOTIFYCHANGE_MESSAGE then + begin + if assigned(OnChange) then OnChange(self); + end else + Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam); +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetNotifyFilters(aNotifyFilters: TNotifyFilters); +begin + if aNotifyFilters = fNotifyFilters then exit; + fNotifyFilters := aNotifyFilters; + if assigned(fWatchThread) then + begin + Active := false; + Active := true; + end; +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetWatchSubDirs(aWatchSubDirs: boolean); +begin + if aWatchSubDirs = fWatchSubDirs then exit; + fWatchSubDirs := aWatchSubDirs; + if assigned(fWatchThread) then + begin + Active := false; + Active := true; + end; +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetDirectory(aDir: string); +begin + if aDir = '' then + begin + Active := false; + fDirectory := ''; + exit; + end; + if (aDir[length(aDir)] <> '\') then aDir := aDir + '\'; + if aDir = fDirectory then exit; + if not (csDesigning in ComponentState) and not DirectoryExists(aDir) then + raise Exception.Create( sInvalidDir + aDir); + fDirectory := aDir; + if assigned(fWatchThread) then + fWatchThread.Directory := fDirectory; +end; +//------------------------------------------------------------------------------ + +procedure TDirectoryWatch.SetActive(aActive: boolean); +var + nf: dword; +begin + if aActive = fActive then exit; + fActive := aActive; + if csDesigning in ComponentState then exit; + if fActive then + begin + if not DirectoryExists(fDirectory) then + begin + fActive := false; + raise Exception.Create(sInvalidDir + fDirectory); + end; + nf := 0; + if nfFilename in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_FILE_NAME; + if nfDirname in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_DIR_NAME; + if nfAttrib in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_ATTRIBUTES; + if nfSize in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_SIZE; + if nfLastWrite in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_LAST_WRITE; + if nfSecurity in fNotifyFilters then + nf := nf or FILE_NOTIFY_CHANGE_SECURITY; + fWatchThread := TWatchThread.Create( + fWindowHandle, fDirectory, fWatchSubDirs, nf); + end else + begin + fWatchThread.Terminate; + fWatchThread := nil; + end; +end; + +//---------------------------------------------------------------------------- +// TWatchThread methods ... +//---------------------------------------------------------------------------- + +constructor TWatchThread.Create(OwnerHdl: THandle; + const InitialDir: string; WatchSubDirs: boolean; NotifyFilters: dword); +begin + inherited Create(True); + fOwnerHdl := OwnerHdl; + if WatchSubDirs then + cardinal(fWatchSubDirs) := 1 //workaround a Win9x OS issue + else + fWatchSubDirs := false; + FreeOnTerminate := true; + Priority := tpLowest; + fDirectory := InitialDir; + fNotifyFilters := NotifyFilters; + fBreakEvent := windows.CreateEvent(nil, False, False, nil); + Resume; +end; +//------------------------------------------------------------------------------ + +destructor TWatchThread.Destroy; +begin + CloseHandle(fBreakEvent); + inherited Destroy; +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.SetDirectory(const Value: string); +begin + if (Value = FDirectory) then exit; + FDirectory := Value; + SetEvent(fBreakEvent); +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.Terminate; +begin + inherited Terminate; + SetEvent(fBreakEvent); + while not fFinished do sleep(10); //avoids a reported resource leak + //if called while closing the application. +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.Execute; +begin + //OUTER LOOP - manages Directory property reassignments + while (not Terminated) do + begin + fChangeNotify := FindFirstChangeNotification(pchar(fDirectory), + fWatchSubDirs, fNotifyFilters); + if (fChangeNotify = INVALID_HANDLE_VALUE) then + //Can't monitor the specified directory so we'll just wait for + //a new Directory assignment or the thread terminating ... + WaitForSingleObject(fBreakEvent, INFINITE) + else + try + //Now do the INNER loop... + ProcessFilenameChanges; + finally + FindCloseChangeNotification(fChangeNotify); + end; + end; + fFinished := true; +end; +//------------------------------------------------------------------------------ + +procedure TWatchThread.ProcessFilenameChanges; +var + WaitResult : DWORD; + HandleArray : array[0..1] of THandle; +const + TEN_MSECS = 10; + HUNDRED_MSECS = 100; +begin + HandleArray[0] := fBreakEvent; + HandleArray[1] := fChangeNotify; + //INNER LOOP - exits only when fBreakEvent signaled + while (not Terminated) do + begin + //waits for either fChangeNotify or fBreakEvent ... + WaitResult := WaitForMultipleObjects(2, @HandleArray, False, INFINITE); + if (WaitResult = WAIT_OBJECT_0 + 1) then //fChangeNotify + begin + repeat //ie: if a number of files are changing in a block + //just post the one notification message ... + FindNextChangeNotification(fChangeNotify); + until Terminated or + (WaitForSingleObject(fChangeNotify, TEN_MSECS) <> WAIT_OBJECT_0); + if Terminated then break; + //OK, now notify the main thread (before restarting inner loop)... + PostMessage(fOwnerHdl, NOTIFYCHANGE_MESSAGE, 0, 0); + end else //fBreakEvent ... + begin + //If the Directory property is undergoing multiple rapid reassignments + //wait 'til this stops before restarting monitoring of a new directory ... + while (not Terminated) and + (WaitForSingleObject(fBreakEvent, HUNDRED_MSECS) = WAIT_OBJECT_0) do; + break; //EXIT LOOP HERE + end; + end; +end; +//------------------------------------------------------------------------------ +//------------------------------------------------------------------------------ + +end. ADDED src/m_highlighters.lfm Index: src/m_highlighters.lfm ================================================================== --- /dev/null +++ src/m_highlighters.lfm @@ -0,0 +1,218 @@ +object modHighlighters: TmodHighlighters + OldCreateOrder = False + Height = 526 + HorizontalOffset = 314 + VerticalOffset = 162 + Width = 455 + object shlPascal: TSynPasSyn + Enabled = False + CommentAttri.Foreground = clGreen + KeyAttri.Foreground = clNavy + KeyAttri.StyleMask = [fsBold] + NumberAttri.Foreground = clBlue + SpaceAttri.Foreground = clSilver + StringAttri.Foreground = clMaroon + SymbolAttri.Foreground = clRed + DirectiveAttri.Foreground = clTeal + DirectiveAttri.Style = [] + CompilerMode = pcmDelphi + NestedComments = False + D4syntax = False + ExtendedKeywordsMode = True + left = 24 + top = 208 + end + object shlHTML: TSynHTMLSyn + DefaultFilter = 'HTML Document (*.htm,*.html)|*.htm;*.html' + Enabled = False + ASPAttri.FrameColor = clYellow + CDATAAttri.Foreground = 4227327 + DOCTYPEAttri.Background = clInfoBk + DOCTYPEAttri.Foreground = clPurple + DOCTYPEAttri.Style = [] + CommentAttri.Foreground = clGreen + left = 24 + top = 80 + end + object shlJS: TSynJScriptSyn + Enabled = False + CommentAttri.Foreground = clGreen + KeyAttri.Foreground = clNavy + NumberAttri.Foreground = clBlue + StringAttri.Foreground = clMaroon + SymbolAttri.Style = [fsBold] + left = 80 + top = 80 + end + object shlCSS: TSynCssSyn + DefaultFilter = 'Cascading Stylesheets (*.css)|*.css' + Enabled = False + CommentAttri.Foreground = clGreen + IdentifierAttri.Foreground = clNavy + KeyAttri.Foreground = clBlue + NumberAttri.Foreground = clTeal + StringAttri.Foreground = clMaroon + SymbolAttri.Foreground = clRed + SymbolAttri.Style = [fsBold] + left = 136 + top = 80 + end + object shlXML: TSynXMLSyn + DefaultFilter = 'XML Document (*.xml,*.xsd,*.xsl,*.xslt,*.dtd)|*.xml;*.xsd;*.xsl;*.xslt;*.dtd' + Enabled = False + WantBracesParsed = False + left = 24 + top = 144 + end + object shlSQL: TSynSQLSyn + DefaultFilter = 'SQL Files (*.sql)|*.sql' + Enabled = False + CommentAttri.Foreground = clGreen + DataTypeAttri.Foreground = clTeal + KeyAttri.Foreground = clNavy + NumberAttri.Foreground = clBlue + StringAttri.Foreground = clMaroon + SQLDialect = sqlStandard + left = 24 + top = 272 + end + object shlINI: TSynIniSyn + DefaultFilter = 'INI Files (*.ini)|*.ini' + Enabled = False + left = 80 + top = 144 + end + object shlDiff: TSynDiffSyn + Enabled = False + SpaceAttri.Foreground = clSilver + OrigFileAttri.Background = clNone + OrigFileAttri.Foreground = clRed + NewFileAttri.Background = clNone + NewFileAttri.Foreground = clGreen + LineAddedAttri.Background = 12707275 + LineRemovedAttri.Background = 13421803 + LineRemovedAttri.Foreground = 4408225 + left = 24 + top = 16 + end + object shlAny: TSynAnySyn + Enabled = False + Comments = [] + DetectPreprocessor = True + IdentifierChars = '!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~' + Markup = False + Entity = False + DollarVariables = False + ActiveDot = False + left = 328 + top = 16 + end + object shlMulti: TSynMultiSyn + Enabled = False + Schemes = < + item + CaseSensitive = False + StartExpr = '<script\s?[^>]*>' + EndExpr = '<\/script>' + Highlighter = shlJS + MarkerAttri.Background = clSkyBlue + MarkerAttri.Style = [] + SchemeName = 'JavaScript' + end + item + CaseSensitive = False + StartExpr = '<style\s?[^>]*>' + EndExpr = '<\/style>' + Highlighter = shlCSS + MarkerAttri.Background = clNone + MarkerAttri.Foreground = clPurple + SchemeName = 'CSS' + end + item + CaseSensitive = False + StartExpr = '<\?(php)?' + EndExpr = '\?>' + Highlighter = shlPHP + MarkerAttri.Foreground = clRed + SchemeName = 'PHP' + end + item + StartExpr = '<%' + EndExpr = '%>' + Highlighter = shlBasic + MarkerAttri.Style = [] + SchemeName = 'ASP' + end> + DefaultHighlighter = shlHTML + DefaultLanguageName = 'HTML' + left = 392 + top = 16 + end + object shlCpp: TSynCppSyn + DefaultFilter = 'C++ Files (*.c,*.cpp,*.h,*.hpp,*.hh)|*.c;*.cpp;*.h;*.hpp;*.hh' + Enabled = False + left = 80 + top = 208 + end + object shlJava: TSynJavaSyn + DefaultFilter = 'Java Files (*.java)|*.java' + Enabled = False + left = 136 + top = 208 + end + object shlPerl: TSynPerlSyn + DefaultFilter = 'Perl Files (*.pl,*.pm,*.cgi)|*.pl;*.pm;*.cgi' + Enabled = False + left = 24 + top = 332 + end + object shlShell: TSynUNIXShellScriptSyn + DefaultFilter = 'UNIX Shell Scripts (*.sh)|*.sh' + Enabled = False + left = 24 + top = 394 + end + object shlPHP: TSynPHPSyn + DefaultFilter = 'PHP Files (*.php,*.php3,*.phtml,*.inc)|*.php;*.php3;*.phtml;*.inc' + Enabled = False + CommentAttri.Foreground = clGreen + IdentifierAttri.Foreground = clNavy + KeyAttri.Foreground = clBlue + KeyAttri.Style = [] + NumberAttri.Foreground = clTeal + StringAttri.Foreground = clMaroon + SymbolAttri.Foreground = clRed + VariableAttri.Foreground = clPurple + left = 80 + top = 332 + end + object shlPython: TSynPythonSyn + DefaultFilter = 'Python Files (*.py)|*.py' + Enabled = False + left = 136 + top = 332 + end + object shlBasic: TSynVBSyn + Enabled = False + CommentAttri.Foreground = clGreen + IdentifierAttri.Foreground = clNavy + KeyAttri.Foreground = clBlue + KeyAttri.Style = [] + NumberAttri.Foreground = clMenuHighlight + StringAttri.Foreground = clMaroon + left = 192 + top = 208 + end + object shlBatch: TSynBatSyn + DefaultFilter = 'MS-DOS Batch Files (*.bat;*.cmd)|*.bat;*.cmd' + Enabled = False + left = 80 + top = 394 + end + object shlPO: TSynPoSyn + DefaultFilter = 'Po Files (*.po)|*.po' + Enabled = False + left = 24 + top = 458 + end +end ADDED src/m_highlighters.pas Index: src/m_highlighters.pas ================================================================== --- /dev/null +++ src/m_highlighters.pas @@ -0,0 +1,77 @@ +unit M_Highlighters; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, SynHighlighterMulti, SynHighlighterDiff, + SynHighlighterAny, SynHighlighterPas, SynHighlighterJScript, + SynHighlighterHTML, SynHighlighterXML, SynHighlighterCss, SynHighlighterSQL, + SynHighlighterIni, SynHighlighterCpp, SynHighlighterJava, SynHighlighterPerl, + synhighlighterunixshellscript, SynHighlighterPHP, SynHighlighterPython, + SynHighlighterVB, SynHighlighterBat, SynHighlighterPo, + SynHighlighterDiffWide, SynHighlighterAnnotate; + +type + + { TmodHighlighters } + + TmodHighlighters = class(TDataModule) + shlAny: TSynAnySyn; + shlCSS: TSynCssSyn; + shlDiff: TSynDiffSyn; + shlHTML: TSynHTMLSyn; + shlINI: TSynIniSyn; + shlJS: TSynJScriptSyn; + shlMulti: TSynMultiSyn; + shlPascal: TSynPasSyn; + shlSQL: TSynSQLSyn; + shlXML: TSynXMLSyn; + shlCpp: TSynCppSyn; + shlJava: TSynJavaSyn; + shlPerl: TSynPerlSyn; + shlShell: TSynUNIXShellScriptSyn; + shlPHP: TSynPHPSyn; + shlPython: TSynPythonSyn; + shlBasic: TSynVBSyn; + shlBatch: TSynBatSyn; + shlPO: TSynPoSyn; + private + { private declarations } + FshlDiffWide: TSynDiffWideSyn; + FshlAnnotate: TSynAnnotateSyn; + public + { public declarations } + constructor Create(AOwner: TComponent); override; + + procedure RecycleAnnotator; + published + property shlDiffWide: TSynDiffWideSyn read FshlDiffWide; + property shlAnnotate: TSynAnnotateSyn read FshlAnnotate; + end; + +var + modHighlighters: TmodHighlighters; + +implementation + +{$R *.lfm} + +{ TmodHighlighters } + +constructor TmodHighlighters.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FshlDiffWide := TSynDiffWideSyn.Create(Self); + FshlAnnotate := TSynAnnotateSyn.Create(Self); +end; + +procedure TmodHighlighters.RecycleAnnotator; +begin + FshlAnnotate.Free; + FshlAnnotate := TSynAnnotateSyn.Create(Self); +end; + +end. + ADDED src/m_main.lfm Index: src/m_main.lfm ================================================================== --- /dev/null +++ src/m_main.lfm @@ -0,0 +1,841 @@ +object modMain: TmodMain + OldCreateOrder = False + Height = 218 + HorizontalOffset = 974 + VerticalOffset = 519 + Width = 243 + object imlMain: TImageList + left = 24 + top = 24 + Bitmap = { + 4C690D0000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00CBCBCB63C7C7C7BFC4C4C4BFBFBFBF63FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D1D1D129CECE + CE0ECBCBCB02C7C7C7EAE5E5E5FFE4E4E4FFACACACEAB6B6B602B2B2B20EADAD + AD29FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D1D1D19BCECECEFDCACA + CAE7C6C6C619C2C2C2E7DEDEDEFFDDDDDDFFB2B2B2E7B1B1B119ACACACE7A7A7 + A7FDA3A3A39BFFFFFF00FFFFFF00FFFFFF00D0D0D07BDCDCDCFFEDEDEDFFDBDB + DBFFC2C2C2F4BEBEBEFED6D6D6FFD4D4D4FFB0B0B0FEACACACF4CBCBCBFFE7E7 + E7FFB7B7B7FF8B8B8B7BFFFFFF00FFFFFF00CACACA7DC4C4C4FEDCDCDCFFD4D4 + D4FFD9D9D9FFDBDBDBFFD6D6D6FFD4D4D4FFD9D9D9FFD2D2D2FFCBCBCBFFC8C8 + C8FF797979FE7171717DFFFFFF00FFFFFF00FFFFFF00C5C5C585D4D4D4FFCCCC + CCFFC9C9C9FFBABABAFF9C9C9CFFA1A1A1FFC2C2C2FFC6C6C6FFC1C1C1FFB7B7 + B7FF89898985FFFFFF00FFFFFF00C8C8C8CDC4C4C4E3C0C0C0EED8D8D8FFCDCD + CDFFBCBCBCFF828282C6777777447E7E7E448F8F8FC6C3C3C3FFC2C2C2FFCDCD + CDFF8C8C8CEE878787E3838383CDC4C4C4FDE9E9E9FFD6D6D6FFC9C9C9FFCECE + CEFFA5A5A5FF84848444FFFFFF00FFFFFF009A9A9A44ACACACFFC4C4C4FFBABA + BAFFC6C6C6FFDDDDDDFF6B6B6BFDBFBFBFFDE2E2E2FFD2D2D2FFC6C6C6FFCDCD + CDFFB1B1B1FF93939344FFFFFF00FFFFFF0095959544A8A8A8FFC2C2C2FFB7B7 + B7FFC0C0C0FFD2D2D2FF616161FDA3A3A3CD8F8F8FE3A0A0A0EECFCFCFFFC6C6 + C6FFCCCCCCFF9E9E9EC699999944949494448F8F8FC6C1C1C1FFBCBCBCFFB9B9 + B9FF646464EE585858E3535353CDFFFFFF00FFFFFF00ACACAC85C5C5C5FFC1C1 + C1FFC5C5C5FFC7C7C7FFAAAAAAFFA7A7A7FFC1C1C1FFBEBEBEFFB5B5B5FFAAAA + AAFF69696985FFFFFF00FFFFFF00FFFFFF00ABABAB7DA6A6A6FED5D5D5FFC5C5 + C5FFCBCBCBFFD1D1D1FFC9C9C9FFC7C7C7FFCCCCCCFFC5C5C5FFBDBDBDFFCBCB + CBFF6E6E6EFE6767677DFFFFFF00FFFFFF00A4A4A47BBCBCBCFFDEDEDEFFA6A6 + A6FF838383F4858585FEC4C4C4FFC2C2C2FF6D6D6DFE6E6E6EF4A6A6A6FFD2D2 + D2FF808080FF5252527BFFFFFF00FFFFFF00FFFFFF008181819B6F6F6FFD6464 + 64E776767619838383E7CBCBCBFFC7C7C7FF626262E75A5A5A19585858E74E4E + 4EFD4949499BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006F6F6F296A6A + 6A0E7A7A7A02818181EABDBDBDFFB2B2B2FF5B5B5BEA5A5A5A025C5C5C0E4E4E + 4E29FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF006D6D6D63585858BF515151BF52525263FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D898 + 5223D4964D7DD2924CDBCD8C45F3CB8B41F3C98B40DBC78B407DC5873D23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6974F53D191 + 49E6D0A06AFFE0BFA0FFE3C5AEFFE3C5AEFFDFBC9FFFC89762FFBD7D35E6BC7E + 3553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4964D53CF8D47F4D9B2 + 8CFFE6CDB8FFE0BA9DFFD7AB85FFD6A982FFD9B391FFE1C2ABFFD4AE86FFB16B + 35F4B16F3553FFFFFF00FFFFFF00FFFFFF00D2934C22CE8E47E5D9B28CFFE6CA + B3FFD6A97DFFD1A579FFE2C4A8FFE1C3A8FFD0A276FFD1A477FFDDBDA2FFD0AC + 85FFAB6635E5A9653522FFFFFF00FFFFFF00CE91477ECD9C68FFE7CBB4FFD4A5 + 7AFFD0A077FFCF9E74FFFBF8F5FFFBF8F5FFCB9E71FFCB9D71FFCDA177FFDFC0 + A5FFB98A5BFFA45C347EFFFFFF00FFFFFF00CB8E41DBE0BC9FFFDBB393FFCFA0 + 75FFCD9E72FFCB9C71FFDDBFA3FFDDBFA2FFC5996BFFC5996BFFC4986BFFD1AB + 85FFD8BA97FF9E5635DBFFFFFF00FFFFFF00C5853BF6E4C9B0FFD0A37AFFCC9D + 71FFC79A6CFFC5986BFFFFFFFFFFFFFFFEFFC39669FFC19468FFC29468FFC398 + 6DFFDFC5ABFF955334F6FFFFFF00FFFFFF00BF7E35F6E3C7AFFFD0A276FFC599 + 6BFFC4976AFFC49669FFEEE0D4FFFBF7F4FFBF9066FFBE8F65FFBE8F64FFBE92 + 69FFDFC6AAFF925034F6FFFFFF00FFFFFF00BC7E35DBDBBC9CFFD5AD89FFC798 + 6CFFC39569FFC19367FFEDDFD3FFFAF7F4FFBB8B63FFB98A63FFB88A62FFC59D + 78FFD2B893FF905135DBFFFFFF00FFFFFF00B878357EBF915EFFE0C2A8FFC596 + 6CFFC29169FFE1CBB8FFFEFDFCFFFFFFFEFFEADCD0FFB4855EFFB3855EFFD4B5 + 99FFAE7B56FF8F51357EFFFFFF00FFFFFF00AF703522AB6935E5CFAA81FFDABC + A2FFBE9166FFBA8C62FFB7895FFFB3845EFFB1835DFFB0835CFFCDAA8DFFC6A5 + 79FF895034E589503522FFFFFF00FFFFFF00FFFFFF00A76234539F5533F4CBA7 + 7DFFD8BB9FFFC39C77FFB68A62FFB48660FFBE9672FFD1B397FFC5A377FF844F + 35F489503553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009F5634539955 + 34E6B28057FFD5B793FFDBC3A6FFDAC3A6FFD2B490FFAB7A52FF864F34E68850 + 3553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009754 + 35239453347D925234DB8A5034F3884F34F3895035DB8950357D84503623FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0040C9 + 62233BC55E7D39C25BDB31BD54F32DBB52F32BB952DB2BB7527D28B44E23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003DC7605336C2 + 59E659C274FF96D7A3FFA5DCAEFFA5DCAEFF95D6A1FF50B96AFF1FAB42E61FA9 + 4253FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003BC55E5334C055F47FCE + 90FFAFE1B7FF92D89DFF77CE83FF77CE83FF92D89DFFAEE1B5FF78C88BFF1D9D + 32F41D9D3653FFFFFF00FFFFFF00FFFFFF0039C25C2234BE55E57FCE90FFAEE1 + B5FF6DCC7AFF6ACA76FF68C872FF68C874FF68C875FF6BC979FFACDFB4FF76C4 + 89FF1C962DE51C942D22FFFFFF00FFFFFF0034BE597E57BF70FFAFE1B7FF6DCC + 7AFF68C872FF65C770FF63C56EFF62C46EFF63C471FFB6E3BEFF6FC77EFFACDF + B5FF48A95EFF1C8F267EFFFFFF00FFFFFF002DBB54DB95D7A1FF91D79BFF69C9 + 76FF64C66FFF61C46EFF61C36FFF61C26FFFB9E4C0FFFFFFFFFFE3F4E6FF8BD1 + 99FF8BCE9DFF1C8820DBFFFFFF00FFFFFF0026B44BF6A7DDB1FF72CC80FF66C7 + 73FFB0E1B7FFD2EED6FF63C170FFB8E3BFFFFFFFFFFFFBFDFCFF8CD099FF69C1 + 7EFFA1D7AEFF1B7F1EF6FFFFFF00FFFFFF001FAD42F6A6DCAFFF70CA7FFF73CA + 80FFF0F9F1FFFFFFFFFFEBF7EDFFFFFFFFFFFBFDFCFF88CD96FF5BB971FF67BE + 7DFFA0D7AFFF1B7A1EF6FFFFFF00FFFFFF001FA942DB91D29FFF8DD49AFF64C3 + 74FF79C987FFF2FAF4FFFFFFFFFFFDFEFDFF86CB96FF57B76DFF5BB972FF85CC + 97FF87C79AFF1B781FDBFFFFFF00FFFFFF001EA43D7E4CB064FFAADDB4FF64C1 + 79FF5FBE71FF75C585FFD4ECD9FF8ACD99FF56B66CFF58B56EFF5CB774FFA6DA + B4FF419B4EFF1B771F7EFFFFFF00FFFFFF001D9B36221C962FE572C287FFA8DB + B2FF60BC77FF5CBA73FF59B870FF59B56FFF58B56FFF5BB774FFA5D9B3FF69B8 + 7FFF1A711EE51B711F22FFFFFF00FFFFFF00FFFFFF001C912B531B8A20F46DBE + 83FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB98FFA5D9B4FF66B77DFF1A6C + 1DF41B711F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C8A21531B83 + 1FE642A052FF87CA9AFF9BD3ABFF9BD2ABFF83C796FF3D974CFF1A6E1EE61B70 + 1F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C81 + 1F231B7E1F7D1B7A1FDB1A731EF31A701EF31B711FDB1B711F7D1B6C1F23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF003DBFEC033CBCEBD43ABAEAC339B8E803FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF003CBCEB9585D4F1FF82D1F0FF37B5E769FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF003CBCEB123ABAE9F2F1FAFDFFD5EFFAFF35B2E6ED33AFE412FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF003AB9E9B494D8F2FFF3FCFEFFE7FAFEFF8FD3F0FF31ACE396FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003AB9 + E93038B7E8FDF9FDFFFF94E9F9FF9EEBFAFFECFAFEFF2FA9E1FC2DA6E030FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B7 + E8D4A9DFF4FFEDF9FDFF3EA3D6FF3EA3D6FFD4F5FCFFA2D7F1FF2BA3DEC3FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B6E85A71C8 + EDFFF9FEFFFF5EDCF4FF3EA2D5FF3EA2D5FF5CD9F4FFEDFBFEFF68BBE5FF269C + DB5AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B6E80C36B4E6ECC8EA + F7FFE6FAFDFF5DDAF4FF3DA1D5FF3DA1D5FF57D7F2FFC7F3FCFFC0E3F4FF2499 + D9E42296D80CFFFFFF00FFFFFF00FFFFFF00FFFFFF0036B3E6AA8CD2F0FFEAFB + FEFF94E6F8FF5CDAF4FF47B1DDFF3DA1D5FF56D7F2FF5CDBF5FFDEF8FDFF7DC0 + E7FF1D8ED487FFFFFF00FFFFFF00FFFFFF0036B3E62434B1E5FBF3FBFEFFC3F2 + FBFF5CDCF6FF5CDAF4FF64DFF6FF57CBEBFF55D6F2FF54D9F5FF94E7F8FFE3F4 + FBFF1787D0F91380CD24FFFFFF00FFFFFF0034B0E5CA9DD7F1FFE7F9FDFF8BE5 + F8FF5ADBF6FF5BDAF4FF3DA1D5FF3DA1D5FF54D6F2FF52D8F5FF50D6F4FFD8F6 + FCFF88BFE5FF0E79C9B4FFFFFF0034B0E54B62BFE8FFF4FCFEFFB5EFFAFF58DA + F5FF58DAF5FF57D8F3FF58D7F2FF58D6F2FF57D9F4FF51D8F5FF4ED7F4FF62DA + F6FFEAFBFEFF4493D2FF066DC34B31ADE3E3BEE3F5FFF4FCFEFFEFFBFEFFEEFB + FEFFEEFBFEFFEFFCFEFFEFFCFEFFEFFBFEFFEEFBFEFFEDFBFEFFEDFBFEFFECFB + FEFFF2FCFEFFABCEEBFF0368C1D82FAAE2A22DA7E0FF2BA4DFFF29A1DDFF279E + DCFF259BDAFF2398D9FF2093D6FF1B8CD3FF1685CFFF117ECCFF0D77C9FF0971 + C6FF066CC3FF0368C1FF0064BFA2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006A85 + FC236984FA7D6782F9DB6580F7F3637EF5F3617CF3DB5F7AF17D5D77EF23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006984FA536882 + F9E66E83EEFF92A6F4FFA0B4F8FFA0B4F8FF91A6F3FF687DE9FF5973EBE65671 + E953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006883F9536681F8F48497 + F1FFA9BDFBFF8AA3F8FF6B89F6FF6B89F6FF89A2F8FFA8BCFAFF7F92ECFF526C + E4F44F69E253FFFFFF00FFFFFF00FFFFFF006781F822657FF6E58397F0FFA9BD + FBFF6382F5FF6382F5FFFFFFFFFFFFFFFFFF617EF3FF607CF3FFA6B9F9FF7B8D + EAFF4A64DEE54862DB22FFFFFF00FFFFFF00637EF57E6C81ECFFA9BDFBFF6382 + F5FF6281F5FF6280F4FFFFFFFFFFFFFFFFFF5F7AF1FF5F78F0FF5D76EFFFA5B5 + F8FF5D70DDFF435DD77EFFFFFF00FFFFFF005F7AF1DB91A6F3FF88A1F8FF6280 + F4FF617EF3FF607CF3FFFFFFFFFFFFFFFFFF5D76EFFF5C73EEFF5B70ECFF8293 + F1FF8998ECFF3E58D2DBFFFFFF00FFFFFF005B76EDF6A1B6F8FF6784F4FF607C + F3FF5F7AF1FF5F78F0FFFFFFFFFFFFFFFFFF5B70ECFF5A6EEBFF596CEAFF5F6F + E9FF9BA8F1FF3A53CEF6FFFFFF00FFFFFF005771E9F6A0B3F7FF6580F2FF5F78 + F0FF5D76EFFF5C73EEFFD3D9FAFFFFFFFFFF596CEAFF5869E8FF5767E7FF5D6C + E7FF99A5F1FF354FCAF6FFFFFF00FFFFFF00526DE5DB8E9FF0FF8499F4FF5C73 + EEFF5B70ECFF5A6EEBFF909DF1FFA6AFF3FF5767E7FF5665E6FF5562E5FF7D89 + EBFF8591E7FF314AC6DBFFFFFF00FFFFFF004E68E17E6073E0FFA4B3F7FF5A6E + EBFF596CEAFF5869E8FFFFFFFFFFFFFFFFFF5562E5FF5461E3FF535FE2FF9FA9 + F2FF5061D1FF2D46C27EFFFFFF00FFFFFF004963DC224660DAE57888E6FFA3B0 + F5FF5767E7FF5665E6FF8992EDFF8892ECFF535FE2FF525DE1FF9FA9F2FF6F7D + DDFF2B44C0E52942BE22FFFFFF00FFFFFF00FFFFFF00425CD5533F59D3F47584 + E3FFA1ACF4FF7F8BECFF5C67E4FF5B66E3FF7D87EAFF9FA8F1FF6F7CDDFF2943 + BFF42741BD53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003A54CF533852 + CCE65264D4FF8490E7FF95A0EEFF959FEDFF838EE5FF4C5DCEFF2841BDE6263F + BB53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00334D + C823314BC67D2F48C4DB2C46C2F32A44C0F32842BEDB2640BC7D243EBA23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F9DB + C423F8DAC27DF7D8C0DBF6D7BEF3F4D5BCF3F3D3B9DBF1D1B77DF0CFB423FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F6D8BF53F5D6 + BDE6F9E9DCFFF6E8DDFFF3E5DAFFF3E5DAFFF5E7DCFFF5E4D6FFEBC8ACE6E9C6 + A953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F4D4BB53F2D2B8F4F7EA + DFFFEEDED0FFE3C1A7FFD8AE89FFD7AC86FFDDBB9CFFEBD6C7FFF3E6D9FFE3BE + 9FF4E1BB9C53FFFFFF00FFFFFF00FFFFFF00F1D0B522EFCEB3E5F6E9DDFFECD8 + C6FFD7AC81FFDCBB9AFFF6ECE3FFF5ECE2FFE4C8AEFFD2A77BFFE6CEBAFFF1E2 + D5FFDBB391E5D9B08E22FFFFFF00FFFFFF00EBC9AD7EF4E3D4FFEFDCCDFFD5A8 + 7EFFD0A077FFFBF8F5FFFCF8F5FFFCF8F5FFFBF8F5FFD1A881FFCFA47BFFEAD5 + C3FFEAD4C2FFD2A7837EFFFFFF00FFFFFF00E6C1A3DBF3E5D9FFDFBB9EFFCFA0 + 75FFCD9E72FFF5EBE3FFE4CBB4FFE7D3BFFFFBF8F6FFE5D3BFFFC4986BFFD6B4 + 91FFEEE0D2FFCC9E78DBFFFFFF00FFFFFF00E0B999F6F2E5DAFFD1A67EFFCC9D + 71FFC79A6CFFC5986BFFE2CCB6FFF8F3EEFFF6EEE8FFD9BDA1FFC29468FFC59B + 71FFF0E2D6FFC5956CF6FFFFFF00FFFFFF00D9B08FF6F2E4D9FFD1A57AFFC599 + 6BFFC4976AFFC49669FFFAF6F2FFF3EAE1FFC2956DFFBE8F65FFBE8F64FFC095 + 6DFFEFE3D5FFBF8C61F6FFFFFF00FFFFFF00D3A784DBEFE1D3FFD9B595FFC798 + 6CFFC39569FFC19367FFBF9066FFBF9066FFBB8B63FFB98A63FFB88A62FFCBA7 + 86FFEADCCCFFB88357DBFFFFFF00FFFFFF00CC9E787EE4CCB9FFEAD6C5FFC799 + 71FFBF9066FFBF9066FFF7F1ECFFF6F0EAFFB7895FFFB7895FFFB58963FFE2CE + BBFFD9BDA6FFB27B4D7EFFFFFF00FFFFFF00C6956D22C3926AE5EAD8C9FFE3CD + BAFFC0946BFFBA8C62FFCFB094FFCFB094FFB7895FFFB28761FFDAC0AAFFE4D1 + C0FFAE7546E5AD734322FFFFFF00FFFFFF00FFFFFF00BD895F53BB875BF4E7D5 + C4FFE5D2BFFFC9A685FFB88E67FFB68A65FFC5A180FFE0CCBAFFE3D0BEFFAB70 + 40F4A96E3D53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B57E5153B37C + 4EE6D7BBA3FFE9DACAFFECE0D1FFECE0D1FFE8D8C8FFD3B59CFFA76C3AE6A66A + 3853FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AD74 + 4423AC72417DAA703FDBA86D3CF3A76B3AF3A56937DBA468357DA3663323FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004EA35778499B5103FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0047994FD24191499CFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0063C06E1D5FBB6A705BB4 + 65B756AD5FEA50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3A90FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0062BE6D395EB968B079C383FF89CA + 92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D + 2C84FFFFFF00FFFFFF00FFFFFF0060BC6C1D5CB667B085C98EFF9BD4A4FF8FCE + 98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265 + 258AFFFFFF00FFFFFF00FFFFFF005BB4657075BF7EFF98D2A1FF94CF9CFF86C7 + 8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF20632493FFFF + FF00FFFFFF00FFFFFF00FFFFFF0054AB5EB780C389FF8DCC95FF83C48AFF3D8B + 44E137833E8DFFFFFF00FFFFFF00FFFFFF00236627D21F61239FFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF004DA155E847994FF8419149F63B8842ED3580 + 3C83FFFFFF00FFFFFF00FFFFFF00FFFFFF001E5F217B1B5B1E0354AB5E614EA3 + 5761499B516143934B613D8B446145964D613F8E466139864061347E3A612E76 + 336167C6730364C2707BFFFFFF00FFFFFF00FFFFFF00FFFFFF004DA155834799 + 4FED419149F63B8842F835803CE8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0063C06E9F5FBB6AD2FFFFFF00FFFFFF00FFFFFF004B9E538D45964DE186C6 + 8EFF88C98FFF6FB376FF2E7633B7FFFFFF00FFFFFF00FFFFFF00FFFFFF0062BE + 6D937BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9 + 8FFF82C689FF509756FF276D2C70FFFFFF00FFFFFF00FFFFFF0060BC6C8A79C4 + 83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4 + 85FF5DA463FF266B2AB02265251DFFFFFF00FFFFFF00FFFFFF005BB4658473BD + 7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92 + 51FF246829B020632439FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004EA3 + 579066B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432EA276D2CB72366 + 27701F61231DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF004191499C3B8842D2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0039864003347E3A78FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00EFC2A37EEFC1A2E3EDC09FFFEBBE9DFFEBBC + 9AFFE9BA96FFE7B793FFE6B590FFE4B28CFFE2AF88FFE0AC84FFDDA980FFDCA5 + 7DFFDAA37ACAFFFFFF00FFFFFF00EEC1A1EBFBF7F4FFFBF7F4FFFBF7F4FFFBF7 + F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7 + F4FFD7A074F8FFFFFF00FFFFFF00ECBF9EFFFBF7F4FF9CD5A5FF98D3A1FF94D0 + 9DFF90CE98FF8BCB93FF87C98EFF82C689FF7EC384FF7AC180FF76BE7CFFFBF7 + F4FFD49B6FFFFFFFFF00FFFFFF00EBBD9BFFFBF7F4FFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF7 + F4FFD1976AFFFFFFFF00FFFFFF00E9BA98FFFBF7F4FFE9C3A6FFE9C3A6FFE9C3 + A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFFBF7 + F4FFCE9364FFFFFFFF00FFFFFF00E7B794FFFBF7F4FFE9C3A6FFFFFFFFFFE8C4 + A9FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7ACFFFFFFFFFFBABABAFFB4B4B4FFF7F1 + EBFFCB8F5FFFFFFFFF00FFFFFF00E5B48FFFFAF6F2FFE9C6AAFFE9C6ACFFEAC7 + ACFFE9C7ADFFE9C9AEFFD5C4B7FFBDBBBAFFDFC5B1FFC0C0C0FFBEBEBEFFE0D7 + D1FFABA39EFFA3A3A398FFFFFF00E3B18CFFFAF6F1FFEAC9AEFFFFFFFFFFEAC9 + B0FFFFFFFFFFFFFFFFFFBABABAFFDADADAFFBFBFBFFFD6D6D6FFD8D8D8FFB8B8 + B8FFD4D4D4FF888888FF8686860AE1AE87FFFAF4F0FFEACBB2FFEACCB3FFEACC + B3FFEACCB3FFEACCB3FFCEC1B6FFD2D2D2FFABABABFF818181FF8A8A8AFFB4B4 + B4FFCACACAFF9393939EFFFFFF00DFAA82FFF9F3EFFFEACEB7FFFFFFFFFFEBD0 + BBFFFFFFFFFFB4B4B4FFCACACAFFE8E8E8FF868686FFFFFFFFFFFFFFFFFF9A99 + 99FFE2E2E2FFB6B6B6FF878787FFDDA87EFFF9F3EFFFEBD0BAFFEBD0BBFFEBD0 + BBFFEBD0BBFFA5A5A5FFB7B7B7FFE1E1E1FF9C9C9CFFEACDB5FFEACDB5FF9A9A + 99FFD5D5D5FF999999FF656565FFD9A47AFFF9F3EEFFEBD2BEFFFFFFFFFFEBD3 + BFFFFFFFFFFFF9F9F9FFCDCDCDFFC9C9C9FFBDBDBDFF9C9C9CFF9A9A9AFFB5B5 + B5FFC2C2C2FF6D6D6D9C65656512D7A175FFF8F2EDFFF7F0EAFFF6EDE6FFF4EA + E2FFF3E7DEFFF1E4DBFFA0A0A0FFC9C9C9FFA5A5A5FFCACACAFFC2C2C2FFA1A1 + A1FFC4C4C4FF6D6D6DFF6E6E6E03D69E72C4D3996EF4D19668FFCE9263FFCB8E + 5EFFC98A5BFFC78756FF9F8672FF696969FFAE815EFFA2A2A2FF8B8B8BFFA379 + 58FF5D5D5DFE595959B9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00727272FF5C5C5CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00777777FF777777FF7676 + 76FF717171FF6C6C6CFF656565FF5E5E5EFF565656FF4D4D4DFF444444FF3C3C + 3CFF333333FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00737373FF6D6D6DFF6767 + 67FF606060FF585858FF505050FF474747FF3E3E3EFF363636FFFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00636363FF5B5B5BFF5353 + 53FF4A4A4AFF414141FF393939FF303030FF272727FF1F1F1FFF171717FF1010 + 10FF0A0A0AFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004D4D4DFF444444FF3C3C + 3CFF333333FF2A2A2AFF212121FF191919FF121212FF0B0B0BFFFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BCBCBCFFBCBCBCFFBCBC + BCFFBCBCBCFFBCBCBCFFBCBCBCFFBBBBBBFFBBBBBBFFBABABAFFB9B9B9FFB7B7 + B7FFB7B7B7FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00BCBCBCFFF0F0F0FFF0F0 + F0FFEFEFEFFFEEEEEEFFEDEDEDFFEBEBEBFFEAEAEAFFE8E8E8FFE7E7E7FFE6E6 + E6FFB3B3B3FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00BBBBBBFFBBBBBBFFBABA + BAFFB9B9B9FFB7B7B7FFB7B7B7FFB5B5B5FFB4B4B4FFB3B3B3FFB3B3B3FFB3B3 + B3FFB3B3B3FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00767676FF747474FF7070 + 70FF6C6C6CFF686868FFFFFFFF00FFFFFF00595959FF535353FF4E4E4EFF4848 + 48FF424242FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006F6F6FFF6B6B6BFF6666 + 66FF616161FF5C5C5CFFFFFFFF00FFFFFF004B4B4BFF454545FF3F3F3FFF3939 + 39FF333333FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00646464FF5F5F5FFF5A5A + 5AFF545454FF4F4F4FFFFFFFFF00FFFFFF003D3D3DFF373737FF313131FF2B2B + 2BFF252525FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00585858FF525252FF4C4C + 4CFF464646FF404040FFFFFFFF00FFFFFF002E2E2EFF282828FF232323FF1D1D + 1DFF181818FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A4AFF444444FF3E3E + 3EFF383838FF323232FFFFFFFF00FFFFFF00202020FF1B1B1BFF161616FF1111 + 11FF0C0C0CFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003C3C3CFF353535FF2F2F + 2FFF292929FF242424FFFFFFFF00FFFFFF00141414FF0F0F0FFF0B0B0BFF0707 + 07FF030303FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BCBCBCFFBCBCBCFFBCBC + BCFFFFFFFF00777777FF747474FF707070FF6B6B6BFF656565FF606060FF5959 + 59FF535353FF4C4C4C6BFFFFFF00FFFFFF00FFFFFF00BCBCBCFFF0F0F0FFBCBC + BCFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BCBCBCFFF0F0F0FFBBBB + BBFFFFFFFF006D6D6DFF686868FF636363FF5C5C5CFF565656FF4F4F4FFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BCBCBCFFEFEFEFFFBBBB + BBFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BBBBBBFFEDEDEDFFB9B9 + B9FFFFFFFF00606060FF595959FF535353FF4C4C4CFF454545FF3D3D3DFF3636 + 36FF2F2F2FFF2828286BFFFFFF00FFFFFF00FFFFFF00BABABAFFEBEBEBFFB7B7 + B7FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B8B8B8FFE8E8E8FFB5B5 + B5FFFFFFFF004F4F4FFF484848FF414141FF3A3A3AFF323232FF2B2B2BFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B6B6B6FFE6E6E6FFB3B3 + B3FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B4B4B4FFE5E5E5FFB3B3 + B3FFFFFFFF003D3D3DFF363636FF2F2F2FFF282828FF212121FF1B1B1BFF1414 + 14FF0F0F0FFF0A0A0A6BFFFFFF00FFFFFF00FFFFFF00B3B3B3FFE4E4E4FFB3B3 + B3FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B3B3B3FFB3B3B3FFB3B3 + B3FFFFFFFF002B2B2BFF242424FF1E1E1EFF171717FF121212FF0C0C0CFFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00767676FF747474FF7070 + 70FF6C6C6CFF686868FF636363FF5E5E5EFF595959FF535353FF4E4E4EFF4848 + 48FF424242FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006F6F6FFF6B6B6BFF6666 + 66FF616161FF5C5C5CFF575757FF515151FF4B4B4BFF454545FFFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00646464FF5F5F5FFF5A5A + 5AFF545454FF4F4F4FFF494949FF434343FF3D3D3DFF373737FF313131FF2B2B + 2BFF252525FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00585858FF525252FF4C4C + 4CFF464646FF404040FF3A3A3AFF343434FF2E2E2EFF282828FFFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A4AFF444444FF3E3E + 3EFF383838FF323232FF2C2C2CFF262626FF202020FF1B1B1BFF161616FF1111 + 11FF0C0C0CFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003C3C3CFF353535FF2F2F + 2FFF292929FF242424FF1E1E1EFF191919FF141414FF0F0F0FFFFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00A971516BDDB18DF4DCA77BFFDCA67AFFDAA4 + 7AFFD8A279FFD5A076FFD49E75FFD29D73FFCF9A72FFCE9970FFCB966FFFC994 + 6CFFC49A7AF4A971516BFFFFFF00DDAC85FDE8B992FFE8B992FFE8B992FFE8B9 + 92FFE8B992FFE8B992FFE8B992FFE8B992FFE8B992FFE8B992FFE8B992FFE8B9 + 92FFE8B992FFC1906FFDFFFFFF00DCA77BFFDCA77BFFDCA77BFFDCA77BFFDCA7 + 7BFFDCA77BFFDCA77BFFDCA77BFFDCA77BFFDCA77BFFDCA77BFFDCA77BFFDCA7 + 7BFFDCA77BFFC08B66FFFFFFFF00DBA47AFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFBD8763FFFFFFFF00D9A379FFFFFFFFFFFFBF68FFFFFFFFFFC7C7 + C7FFC6C6C6FFC3C3C3FFC1C1C1FFBFBFBFFFBDBDBDFFBBBBBBFFB9B9B9FFB9B9 + B9FFFFFFFFFFBA8560FFFFFFFF00D8A279FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFEFEFFFEFEFEFFFEFEFEFFFDFDFDFFFDFD + FDFFFFFFFFFFB7815EFFFFFFFF00D5A076FFFFFFFFFFFFB95EFFFFFFFFFFC1C1 + C1FFBEBEBEFFBABABAFFB7B7B7FFB5B5B5FFB2B2B2FFB0B0B0FFAEAEAEFFADAD + ADFFFFFFFFFFB57E5CFFFFFFFF00D49E75FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFEFEFEFFFEFEFEFFFEFEFEFFFDFDFDFFFDFDFDFFFDFDFDFFFDFDFDFFFCFC + FCFFFFFFFFFFB27C5AFFFFFFFF00D19C73FFFFFFFFFFFFB252FFFEFEFEFFB9B9 + B9FFB5B5B5FFB1B1B1FFADADADFFA9A9A9FFA6A6A6FFA4A4A4FFA2A2A2FFA1A1 + A1FFFFFFFFFFB07A58FFFFFFFF00CC976FFFFFFFFFFFFEFEFEFFFDFDFDFFFDFD + FDFFFDFDFDFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFBFBFBFFFBFBFBFFFBFB + FBFFFFFFFFFFAC7554FFFFFFFF00CA946EFFFFFFFFFFFFAC48FFFDFDFDFFB2B2 + B2FFADADADFFA8A8A8FFA4A4A4FF9F9F9FFF9D9D9DFF9B9B9BFF999999FF9999 + 99FFFFFFFFFFAA7353FFFFFFFF00C8926CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFA97251FFFFFFFF00A97151A9C38E68FFC08B66FFBE8864FFBB85 + 61FFB9835FFFB47E5CFFB27C5AFFB17B58FFAE7957FFAD7656FFAB7554FFA973 + 53FFA97151FFA97151A9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object imlFileStatuses: TImageList + left = 95 + top = 25 + Bitmap = { + 4C690C0000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0040C9 + 62233BC55E7D39C25BDB31BD54F32DBB52F32BB952DB2BB7527D28B44E23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003DC7605336C2 + 59E659C274FF96D7A3FFA5DCAEFFA5DCAEFF95D6A1FF50B96AFF1FAB42E61FA9 + 4253FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003BC55E5334C055F47FCE + 90FFAFE1B7FF92D89DFF77CE83FF77CE83FF92D89DFFAEE1B5FF78C88BFF1D9D + 32F41D9D3653FFFFFF00FFFFFF00FFFFFF0039C25C2234BE55E57FCE90FFAEE1 + B5FF6DCC7AFF6ACA76FF68C872FF68C874FF68C875FF6BC979FFACDFB4FF76C4 + 89FF1C962DE51C942D22FFFFFF00FFFFFF0034BE597E57BF70FFAFE1B7FF6DCC + 7AFF68C872FF65C770FF63C56EFF62C46EFF63C471FFB6E3BEFF6FC77EFFACDF + B5FF48A95EFF1C8F267EFFFFFF00FFFFFF002DBB54DB95D7A1FF91D79BFF69C9 + 76FF64C66FFF61C46EFF61C36FFF61C26FFFB9E4C0FFFFFFFFFFE3F4E6FF8BD1 + 99FF8BCE9DFF1C8820DBFFFFFF00FFFFFF0026B44BF6A7DDB1FF72CC80FF66C7 + 73FFB0E1B7FFD2EED6FF63C170FFB8E3BFFFFFFFFFFFFBFDFCFF8CD099FF69C1 + 7EFFA1D7AEFF1B7F1EF6FFFFFF00FFFFFF001FAD42F6A6DCAFFF70CA7FFF73CA + 80FFF0F9F1FFFFFFFFFFEBF7EDFFFFFFFFFFFBFDFCFF88CD96FF5BB971FF67BE + 7DFFA0D7AFFF1B7A1EF6FFFFFF00FFFFFF001FA942DB91D29FFF8DD49AFF64C3 + 74FF79C987FFF2FAF4FFFFFFFFFFFDFEFDFF86CB96FF57B76DFF5BB972FF85CC + 97FF87C79AFF1B781FDBFFFFFF00FFFFFF001EA43D7E4CB064FFAADDB4FF64C1 + 79FF5FBE71FF75C585FFD4ECD9FF8ACD99FF56B66CFF58B56EFF5CB774FFA6DA + B4FF419B4EFF1B771F7EFFFFFF00FFFFFF001D9B36221C962FE572C287FFA8DB + B2FF60BC77FF5CBA73FF59B870FF59B56FFF58B56FFF5BB774FFA5D9B3FF69B8 + 7FFF1A711EE51B711F22FFFFFF00FFFFFF00FFFFFF001C912B531B8A20F46DBE + 83FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB98FFA5D9B4FF66B77DFF1A6C + 1DF41B711F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C8A21531B83 + 1FE642A052FF87CA9AFF9BD3ABFF9BD2ABFF83C796FF3D974CFF1A6E1EE61B70 + 1F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C81 + 1F231B7E1F7D1B7A1FDB1A731EF31A701EF31B711FDB1B711F7D1B6C1F23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0074BB + 8B2371B9887D6EB684DB6AB380F367B17CF363AE77DB60AB737D5CA86E23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0073BB8B5371B8 + 87E694CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDDB8FF6DB97FFF58A569E654A1 + 6553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0073BB8B5370B887F4AFDC + BBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DFAFFFC0E8C5FF79C28AFF509E + 5FF44C9B5B53FFFFFF00FFFFFF00FFFFFF0073BA8A2270B887E5AADAB7FFD8F1 + DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD495FF83D28EFFAFE0B7FF6BB9 + 7DFF489856E544945122FFFFFF00FFFFFF0070B8877E85C797FFD2EED7FF95D9 + A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD85FF6BC37CFF6FC77EFFACDF + B5FF459E57FF40914C7EFFFFFF00FFFFFF006DB583DBACDDB6FFA6DFAFFF81CB + 8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC6AFF60BC77FF5CBA73FF8BD1 + 99FF80C592FF3C8E47DBFFFFFF00FFFFFF0069B27EF6B6E2BEFF8BD597FF7AC9 + 86FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF59B870FF69C1 + 7EFF9DD4AAFF388B42F6FFFFFF00FFFFFF0065AF7AF6A9DDB3FF7DCF8AFF75CC + 81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF59B870FF67BE + 7DFF9CD4ABFF34883DF6FFFFFF00FFFFFF0061AC75DB8ACC98FF89D396FF6BC6 + 7AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B870FF59B870FF5BB972FF85CC + 97FF7BBE8DFF308539DBFFFFFF00FFFFFF005DA9707E53AB68FFAADDB4FF64C1 + 79FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B870FF58B56EFF5CB774FFA6DA + B4FF388F43FF2C82347EFFFFFF00FFFFFF0059A66B2256A366E56AB97DFFA8DB + B2FF60BC77FF5CBA73FF59B870FF59B56FFF58B56FFF5BB774FFA5D9B3FF5AAA + 6CFF2C8234E5297F3022FFFFFF00FFFFFF00FFFFFF00519F61534D9C5DF464B4 + 78FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB98FFA5D9B4FF58AA6BFF2C81 + 34F4297F3053FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00499958534596 + 53E6419950FF7DC28FFF96D0A6FF96CFA6FF78BE89FF368D42FF2C8134E6297F + 3053FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004192 + 4E233D8F497D3A8C44DB368940F332873CF32F8437DB2C81337D287F3023FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002FBAE4094FAADBEA5093 + CAFD4E90C8FF2F9DD2DF35A4DE19FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0050A8D9FF6AA5D8FFC9E1 + F7FFCBE3F8FF4295CAFF3182C2AEFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002FBAE4FFA7D4F4FFC5E1F8FFCCE3 + F9FFCCE3F9FFBDDBF7FF4F90C9FDFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF002FBAE4FFC3EDF8FFA8E2F8FF6CAEDDFFA5CF + F4FFA5CFF4FFBDDBF7FF5393CBF7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF002FBAE4FFC3EDF8FFB3F4FCFF68D9F5FF6FCFF3FF599D + D0FF73ABDDFF4F91C9FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF002FBAE4FFC3EDF8FFB3F4FCFF60DCF5FF44D6F4FF8EEEFAFF5DB4 + E6FF3B8FD9FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002FBAE4FFC3EDF8FFB3F4FCFF60DCF5FF44D6F4FF8EEEFAFF5DB4E6FF3B8F + D9FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002790 + BFFFC3EDF8FFB3F4FCFF60DCF5FF44D6F4FF8EEEFAFF5DB4E6FF3B8FD9FFFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002689B9FFBEE6 + F2FFB3F4FCFF60DCF5FF44D6F4FF8EEEFAFF5DB4E6FF3B8FD9FFFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00206398202689B9FFB0CBE1FF67A9 + C8FF60DCF5FF44D6F4FF8EEEFAFF5DB4E6FF3B8FD9FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001E6D93FFC8E1F2FFD1E7FAFF347D + B5FF3199C3FF6DC4DCFF4A9CCFFF3483C7FFFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001E6D93FFCBE3F9FF61AAECFF4098 + E8FF1567C2FF1660AAFF2C76B4FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00124259FF5D9CD4FFA6CFF5FFA9CF + ECFF488BC1FF2C76B4FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00134058FF15425EFF25699CFF2C76 + B4FF3B8BBAADFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006360 + F80AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007774FF1F7774 + FF2BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00625FF82B5D5B + F76F5956F53EFFFFFF00FFFFFF00FFFFFF00FFFFFF007774FF1F7A77FFFF7976 + FEFF726FFD2BFFFFFF00FFFFFF00FFFFFF00FFFFFF00615EF82B6461F8FF6A68 + F9FF5451F3A84F4DF229FFFFFF00FFFFFF007774FF1F7A77FFFF817EFFFF817E + FEFF7471FDFF6C69FB2BFFFFFF00FFFFFF00605DF72B625FF8FF6F6DFBFF7E7C + FFFF625FF8FF4A47F06F4542EE02FFFFFF007673FF087471FEFD7D7AFEFF8A87 + FFFF7C79FDFF6C69FBFF6361F92B5F5CF72B615EF8FF6E6CFAFF7D7AFFFF615F + F7FF4946F0FC4441EE05FFFFFF00FFFFFF00FFFFFF00716EFD086E6BFCFC7774 + FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6AFAFF7B79FFFF605DF7FF4845 + EFFC4341EE08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006967FB086663 + F9FC706DFBFF807EFFFF7E7BFFFF7C79FFFF7977FFFF5E5CF7FF4744EFFC4240 + EE08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00615E + F8085D5AF6FD7D79FFFF5E5BFFFF5B58FFFF7674FFFF4643EFFD413FED08FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005C59 + F62B5D5BF7FF7976FFFF5956FFFF5754FFFF7270FFFF4846F0FF3C39EB2BFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005B58F62B5C5A + F6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6CFFFF5755F7FF3F3DEEFF3230 + E82BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005A57F52B5B59F6FF6663 + FAFF7471FFFF5A58F6FF4341EEFC3E3CECFD504DF4FF6867FFFF504EF5FF3634 + EBFF2A27E52BFFFFFF00FFFFFF00FFFFFF005956F52B5B58F6FF6562FAFF7170 + FFFF5956F6FF4240EEFC3E3BEC083937EB083532E9FC4745F2FF6362FFFF4A48 + F4FF2F2DE9FF2220E32BFFFFFF00FFFFFF005451F3415856F5FF6361FAFF5855 + F6FF413FEDFC3D3AEC08FFFFFF00FFFFFF00302DE7082C2AE6FC413FF1FF4C4A + F6FF312FEAFF1F1DE241FFFFFF00FFFFFF00FFFFFF004A47F0414F4CF2FF403E + EDFD3C39EB08FFFFFF00FFFFFF00FFFFFF00FFFFFF002725E5082422E4FC312F + EAFF1F1DE241FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003F3DED413B38 + EB08FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00211FE3081E1C + E241FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006A85 + FC236984FA7D6782F9DB6580F7F3637EF5F3617CF3DB5F7AF17D5D77EF23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006984FA536882 + F9E66E83EEFF92A6F4FFA0B4F8FFA0B4F8FF91A6F3FF687DE9FF5973EBE65671 + E953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006883F9536681F8F48497 + F1FFA9BDFBFF8AA3F8FF6B89F6FF6B89F6FF89A2F8FFA8BCFAFF7F92ECFF526C + E4F44F69E253FFFFFF00FFFFFF00FFFFFF006781F822657FF6E58397F0FFA9BD + FBFF6382F5FF6382F5FFFFFFFFFFFFFFFFFF617EF3FF607CF3FFA6B9F9FF7B8D + EAFF4A64DEE54862DB22FFFFFF00FFFFFF00637EF57E6C81ECFFA9BDFBFF6382 + F5FF6281F5FF6280F4FFFFFFFFFFFFFFFFFF5F7AF1FF5F78F0FF5D76EFFFA5B5 + F8FF5D70DDFF435DD77EFFFFFF00FFFFFF005F7AF1DB91A6F3FF88A1F8FF6280 + F4FF617EF3FF607CF3FFFFFFFFFFFFFFFFFF5D76EFFF5C73EEFF5B70ECFF8293 + F1FF8998ECFF3E58D2DBFFFFFF00FFFFFF005B76EDF6A1B6F8FF6784F4FF607C + F3FF5F7AF1FF5F78F0FFFFFFFFFFFFFFFFFF5B70ECFF5A6EEBFF596CEAFF5F6F + E9FF9BA8F1FF3A53CEF6FFFFFF00FFFFFF005771E9F6A0B3F7FF6580F2FF5F78 + F0FF5D76EFFF5C73EEFFD3D9FAFFFFFFFFFF596CEAFF5869E8FF5767E7FF5D6C + E7FF99A5F1FF354FCAF6FFFFFF00FFFFFF00526DE5DB8E9FF0FF8499F4FF5C73 + EEFF5B70ECFF5A6EEBFF909DF1FFA6AFF3FF5767E7FF5665E6FF5562E5FF7D89 + EBFF8591E7FF314AC6DBFFFFFF00FFFFFF004E68E17E6073E0FFA4B3F7FF5A6E + EBFF596CEAFF5869E8FFFFFFFFFFFFFFFFFF5562E5FF5461E3FF535FE2FF9FA9 + F2FF5061D1FF2D46C27EFFFFFF00FFFFFF004963DC224660DAE57888E6FFA3B0 + F5FF5767E7FF5665E6FF8992EDFF8892ECFF535FE2FF525DE1FF9FA9F2FF6F7D + DDFF2B44C0E52942BE22FFFFFF00FFFFFF00FFFFFF00425CD5533F59D3F47584 + E3FFA1ACF4FF7F8BECFF5C67E4FF5B66E3FF7D87EAFF9FA8F1FF6F7CDDFF2943 + BFF42741BD53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003A54CF533852 + CCE65264D4FF8490E7FF95A0EEFF959FEDFF838EE5FF4C5DCEFF2841BDE6263F + BB53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00334D + C823314BC67D2F48C4DB2C46C2F32A44C0F32842BEDB2640BC7D243EBA23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0066C471C464C16FC9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0065C370CF7DCA88FF7BC886FF5EBA69D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0066C4720664C2 + 70D97CC987FFA0D7A9FF9ED6A7FF76C27FFF58B162DB55AD5F06FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0063C06FB861BE + 6CF779C684FF9DD5A6FF9BD4A4FF72BE7CFF54AB5EF751A75ABBFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005BB566FF9AD4A2FF98D2A1FF53AA5CFFFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0058B062FF97D29FFF94D09DFF4FA458FFFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0054AA5DFF94CF9CFF90CF99FF66B16FFF47994F71FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF004FA458FF90CE98FF84C88DFF7BBF82FF42924AC33F8E4671FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF004B9E53FF8CCB94FF70BE79FF87C98FFF74B97BFF58A15FFF37833EFF347E + 3AFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0046984EFF88CA90FF65B56EFF66B86FFF78C07FFF7EC485FF7DC282FF3078 + 35FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00429149FF85C78BFF418946FF5BA061FF71B677FF79C080FF79C17FFF2C73 + 31FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF003D8B44FF82C588FF71B778FF377D3CFF2D7433E92D7533F92A712FFF286D + 2CFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0038853FFF7EC384FF7BC282FF2F7735FF2B713008FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00347E3AFF7AC280FF78C07EFF2B7230FFFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00307835FF77BF7DFF75BE7AFF276C2CFFFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002C7331FF296F2DFF266B2AFF246728FFFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF003DBFEC033CBCEBD43ABAEAC339B8E803FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF003CBCEB9585D4F1FF82D1F0FF37B5E769FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF003CBCEB123ABAE9F2F1FAFDFFD5EFFAFF35B2E6ED33AFE412FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF003AB9E9B494D8F2FFF3FCFEFFE7FAFEFF8FD3F0FF31ACE396FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003AB9 + E93038B7E8FDF9FDFFFF94E9F9FF9EEBFAFFECFAFEFF2FA9E1FC2DA6E030FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B7 + E8D4A9DFF4FFEDF9FDFF3EA3D6FF3EA3D6FFD4F5FCFFA2D7F1FF2BA3DEC3FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B6E85A71C8 + EDFFF9FEFFFF5EDCF4FF3EA2D5FF3EA2D5FF5CD9F4FFEDFBFEFF68BBE5FF269C + DB5AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0038B6E80C36B4E6ECC8EA + F7FFE6FAFDFF5DDAF4FF3DA1D5FF3DA1D5FF57D7F2FFC7F3FCFFC0E3F4FF2499 + D9E42296D80CFFFFFF00FFFFFF00FFFFFF00FFFFFF0036B3E6AA8CD2F0FFEAFB + FEFF94E6F8FF5CDAF4FF47B1DDFF3DA1D5FF56D7F2FF5CDBF5FFDEF8FDFF7DC0 + E7FF1D8ED487FFFFFF00FFFFFF00FFFFFF0036B3E62434B1E5FBF3FBFEFFC3F2 + FBFF5CDCF6FF5CDAF4FF64DFF6FF57CBEBFF55D6F2FF54D9F5FF94E7F8FFE3F4 + FBFF1787D0F91380CD24FFFFFF00FFFFFF0034B0E5CA9DD7F1FFE7F9FDFF8BE5 + F8FF5ADBF6FF5BDAF4FF3DA1D5FF3DA1D5FF54D6F2FF52D8F5FF50D6F4FFD8F6 + FCFF88BFE5FF0E79C9B4FFFFFF0034B0E54B62BFE8FFF4FCFEFFB5EFFAFF58DA + F5FF58DAF5FF57D8F3FF58D7F2FF58D6F2FF57D9F4FF51D8F5FF4ED7F4FF62DA + F6FFEAFBFEFF4493D2FF066DC34B31ADE3E3BEE3F5FFF4FCFEFFEFFBFEFFEEFB + FEFFEEFBFEFFEFFCFEFFEFFCFEFFEFFBFEFFEEFBFEFFEDFBFEFFEDFBFEFFECFB + FEFFF2FCFEFFABCEEBFF0368C1D82FAAE2A22DA7E0FF2BA4DFFF29A1DDFF279E + DCFF259BDAFF2398D9FF2093D6FF1B8CD3FF1685CFFF117ECCFF0D77C9FF0971 + C6FF066CC3FF0368C1FF0064BFA2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C8C8C80CC3C3C36CBEBE + BEBEB8B8B8F6B2B2B2BEACACAC6CA5A5A50CFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C2C2C276D3D4D4FFDDDE + DEFFE0E3E4FFD8DADBFFC5C6C6FF9D9D9D76FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00C6C6C61AC1C1C180BBBBBBF7DBDEDFFFCCD1 + D3FFC6CDCFFFCAD0D3FFD7DBDCFF969696F38E8E8E6C8888880CFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00C0C0C080D7D7D7FFDBDEDFFFCCD1D3FFC3CA + CCFFC1C9CCFFC0C9CBFFC7CCCEFFC7C8C9FFBCBCBCFFB5B5B5F0B0B0B09DA6A6 + A641FFFFFF00FFFFFF00FFFFFF00B9B9B9D5DEE0E1FFCAD0D2FFC2CACCFFC1C9 + CCFFBEC7C9FFBEC4C6FFC0C2C2FFE3E3E3FFEAEAEAFFE9E9E9FFDEDEDEFFABAB + ABD29F9F9F44FFFFFF00FFFFFF00B2B2B2D5DBDEDFFFC8CED0FFC2C9CCFFC5C8 + C9FFC3C4C5FFC3C4C4FFE5E5E5FFE6E6E6FFE2E2E2FFE2E2E2FFE7E7E7FFDCDC + DCFFA7A7A7A7FFFFFF00FFFFFF00A7A7A780C5C6C6FFD2D5D5FFC9CBCBFFDCDC + DCFFE8E8E8FFE8E8E8FFE6E6E6FFE3E3E3FFE0E0E0FFDFDFDFFFE0E0E0FFE9E9 + E9FFA9A9A9FD9E9E9EB0949494429F9F9F1A969696808E8E8ED5B9B9B9F8E9E9 + E9FFE2E2E2FFE0E0E0FFE3E3E3FFE5E5E5FFE2E2E2FFDFDFDFFFDFDFDFFFE2E2 + E2FFE8E8E8FFD8D8D8FF989898B4FFFFFF00FFFFFF00FFFFFF00BEBEBED8E9E9 + E9FFE3E3E3FFE1E1E1FFE2E2E2FFE4E4E4FFE2E2E2FFDFDFDFFFE0E0E0FFDFDF + DFFFDEDEDEFFE7E7E7FF9A9A9AF5FFFFFF00FFFFFF00FFFFFF00B7B7B787DADA + DAFFE7E7E7FFE4E4E4FFDADADAFFDCDCDCFFE5E5E5FFE1E1E1FFD7D7D7FFD9D9 + D9FFE4E4E4FFD3D3D3FF949494B8FFFFFF00FFFFFF00FFFFFF00ACACAC1CB4B4 + B491BABABAE2B7B7B7E3B1B1B1B8ADADADBBA3A3A3EA959595E9999999C39999 + 99CC979797F5919191B88E8E8E4AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F9DB + C423F8DAC27DF7D8C0DBF6D7BEF3F4D5BCF3F3D3B9DBF1D1B77DF0CFB423FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F6D8BF53F5D6 + BDE6F9E9DCFFF6E8DDFFF3E5DAFFF3E5DAFFF5E7DCFFF5E4D6FFEBC8ACE6E9C6 + A953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00F4D4BB53F2D2B8F4F7EA + DFFFEEDED0FFE3C1A7FFD8AE89FFD7AC86FFDDBB9CFFEBD6C7FFF3E6D9FFE3BE + 9FF4E1BB9C53FFFFFF00FFFFFF00FFFFFF00F1D0B522EFCEB3E5F6E9DDFFECD8 + C6FFD7AC81FFDCBB9AFFF6ECE3FFF5ECE2FFE4C8AEFFD2A77BFFE6CEBAFFF1E2 + D5FFDBB391E5D9B08E22FFFFFF00FFFFFF00EBC9AD7EF4E3D4FFEFDCCDFFD5A8 + 7EFFD0A077FFFBF8F5FFFCF8F5FFFCF8F5FFFBF8F5FFD1A881FFCFA47BFFEAD5 + C3FFEAD4C2FFD2A7837EFFFFFF00FFFFFF00E6C1A3DBF3E5D9FFDFBB9EFFCFA0 + 75FFCD9E72FFF5EBE3FFE4CBB4FFE7D3BFFFFBF8F6FFE5D3BFFFC4986BFFD6B4 + 91FFEEE0D2FFCC9E78DBFFFFFF00FFFFFF00E0B999F6F2E5DAFFD1A67EFFCC9D + 71FFC79A6CFFC5986BFFE2CCB6FFF8F3EEFFF6EEE8FFD9BDA1FFC29468FFC59B + 71FFF0E2D6FFC5956CF6FFFFFF00FFFFFF00D9B08FF6F2E4D9FFD1A57AFFC599 + 6BFFC4976AFFC49669FFFAF6F2FFF3EAE1FFC2956DFFBE8F65FFBE8F64FFC095 + 6DFFEFE3D5FFBF8C61F6FFFFFF00FFFFFF00D3A784DBEFE1D3FFD9B595FFC798 + 6CFFC39569FFC19367FFBF9066FFBF9066FFBB8B63FFB98A63FFB88A62FFCBA7 + 86FFEADCCCFFB88357DBFFFFFF00FFFFFF00CC9E787EE4CCB9FFEAD6C5FFC799 + 71FFBF9066FFBF9066FFF7F1ECFFF6F0EAFFB7895FFFB7895FFFB58963FFE2CE + BBFFD9BDA6FFB27B4D7EFFFFFF00FFFFFF00C6956D22C3926AE5EAD8C9FFE3CD + BAFFC0946BFFBA8C62FFCFB094FFCFB094FFB7895FFFB28761FFDAC0AAFFE4D1 + C0FFAE7546E5AD734322FFFFFF00FFFFFF00FFFFFF00BD895F53BB875BF4E7D5 + C4FFE5D2BFFFC9A685FFB88E67FFB68A65FFC5A180FFE0CCBAFFE3D0BEFFAB70 + 40F4A96E3D53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B57E5153B37C + 4EE6D7BBA3FFE9DACAFFECE0D1FFECE0D1FFE8D8C8FFD3B59CFFA76C3AE6A66A + 3853FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AD74 + 4423AC72417DAA703FDBA86D3CF3A76B3AF3A56937DBA468357DA3663323FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00008AFF85008AFFEE008AFF85008AFF7F008A + FFE8008AFF8B008AFFF4008AFFDA008AFFCB008AFFAB008AFF42008AFF66008A + FF66008AFF6E008AFFD7008AFF6E008AFFEEEEF7FFFF44A9FFFF008AFFE8E8F4 + FFFF44A9FFFFF4FAFFFFDAEEFFFFCBE7FFFFABD8FFFF0C90FFFF66B9FFFF66B9 + FFFF008AFFD7D7EDFFFF1895FFFF008AFFF6F6FBFFFFEEF7FFFF008AFFF4F4FA + FFFF77C1FFFFE8F4FFFF008AFFE80C90FFFFEDF7FFFF78C1FFFFBBE0FFFFBBE0 + FFFF56B1FFFFE3F2FFFF008AFFE3008AFFF4F4FAFFFF99D0FFFF77C1FFFFF4FA + FFFF77C1FFFFF9FCFFFFDAEEFFFFC7E5FFFF9FD3FFFFE4F3FFFFDCEFFFFFE3F2 + FFFFCDE8FFFFBADFFFFF008AFFBA008AFFF4F4FAFFFF008AFFF4EEF7FFFFF4FA + FFFF77C1FFFFE8F4FFFF008AFFE8008AFFC7038BFFFFF9FCFFFFB7DEFFFFAAD8 + FFFFFBFDFFFF279CFFFF008AFF51008AFFF4F4FAFFFF008AFFF477C1FFFFFFFF + FFFF77C1FFFFF9FCFFFFDAEEFFFFC7E5FFFF008AFFF6F6FBFFFF98D0FFFF6FBD + FFFFFFFFFFFF008AFFFFFFFFFF00008AFF8B008AFFF4008AFF8B008AFF96008A + FFFF008AFF96008AFFF9008AFFDA008AFFC7008AFF8D008AFFF6008AFF98008A + FF96008AFFFF008AFF96FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0067C673C965C270C4FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0066C572D17ECA88FF7BC885FF5DB868CFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0068C7 + 740666C472DB7CCA87FF9ED6A7FF9CD4A5FF73C07DFF55AC5ED950A65906FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0065C3 + 71BB62BF6EF779C683FF9AD4A3FF98D3A1FF7DC386FF4FA458F74A9E53B8FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF005BB465FF96D29FFF94D09CFF5DAC65FF499C5238FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0056AD5FFF93CF9AFF90CE98FF489A50FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0050A659FF8ECC95FF8BCB93FF42924AFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004A9E53FF8ACA91FF87C98EFF3C8A43FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0045954CFF85C78CFF82C689FF36823DFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF003F8D46FF81C587FF7EC385FF317A36FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0039853FFF7DC282FF7AC180FF2B7230FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00337D39FF79C07EFF76BF7CFF266B2BFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF002D7533FF74BD7AFF72BD78FF226526FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00286E2DFF256929FF216425FF1E6022FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774FF67C673FF65C270FF62BE6DFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0066C572FFA2D8ABFFA0D7A9FF5DB868FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0063C06FFF9ED6A7FF9CD4A5FF59B263FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF005FBB6AFF9AD4A3FF98D3A1FF53AA5DFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF005BB465FF96D29FFF94D09CFF4EA257FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0056AD5FFF93CF9AFF90CE98FF489A50FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0050A659FF8ECC95FF8BCB93FF42924AFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004A9E53FF8ACA91FF87C98EFF3C8A43FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0045954CFF85C78CFF82C689FF36823DFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0043944B384E9A55FF81C587FF7EC385FF317A36FFFFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004292 + 4AB83D8C45F765AD6CFF7DC282FF7AC180FF4B9250FF276D2CF7246828BBFFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003C8A + 430638833ED9519957FF79C07EFF76BF7CFF468D4BFF236627DB20622306FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF002D7533CF488F4DFF458C4AFF226526D1FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00256929C4216425C9FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object mnuMain: TMainMenu + Images = imlMain + left = 24 + top = 104 + object miApplication: TMenuItem + Caption = 'Paleo' + Visible = False + object miAppAbout: TMenuItem + Caption = 'About Paleo' + OnClick = miAppAboutClick + end + object MenuItem1: TMenuItem + Caption = '-' + end + object miAppPreferences: TMenuItem + Caption = 'Preferences...' + ShortCut = 4284 + end + end + end +end ADDED src/m_main.pas Index: src/m_main.pas ================================================================== --- /dev/null +++ src/m_main.pas @@ -0,0 +1,218 @@ +unit M_Main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Dialogs, Menus, + U_Fossil; + +const + cEditorFontNames: array[1..5] of string = ('Consolas', 'Monaco', 'Inconsolata', 'Monospace', 'Courier New'); + + // TODO: add a DirWatcher here, and handle change notification for the given repo's files? + // Or should we set that up in TFossilCheckout? + +type + + { TmodMain } + + TmodMain = class(TDataModule) + imlFileStatuses: TImageList; + imlMain: TImageList; + MenuItem1: TMenuItem; + miAppPreferences: TMenuItem; + miAppAbout: TMenuItem; + miApplication: TMenuItem; + mnuMain: TMainMenu; + procedure miAppAboutClick(Sender: TObject); + private + { private declarations } + FFossil: TFossil; + FCheckout: TFossilCheckout; + FBusyLevel: Integer; + function GetCheckout: TFossilCheckout; + function GetFossil: TFossil; + public + { public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function ImageIndexFromStatuses(const Statuses: TFileStatuses): Integer; + function ImageIndexFromType(const FileExt: string): Integer; + + function SetBusy(const Busy: Boolean): Boolean; + + property Fossil: TFossil read GetFossil; + property Checkout: TFossilCheckout read GetCheckout; + end; + +var + modMain: TmodMain; + +implementation +uses + LazFileUtils, Forms, + f_opencheckout; + +{$R *.lfm} + +{ TmodMain } + +constructor TmodMain.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + {$IFDEF DARWIN} + miApplication.Caption := #$EF#$A3#$BF; // The Apple logo + miApplication.Visible := True; + {$ENDIF} +end; + +destructor TmodMain.Destroy; +begin + FCheckout.Free; + FFossil.Free; + inherited Destroy; +end; + +function TmodMain.GetFossil: TFossil; +var + Dlg: TOpenDialog; +begin + if FFossil = nil then begin + try + FFossil := TFossil.Create(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'fossil'); + except + FFossil := nil; + end; + if FFossil = nil then begin + try + FFossil := TFossil.Create('fossil'); + except + FFossil := nil; + end; + end; + if FFossil = nil then begin + Dlg := TOpenDialog.Create(Self); + try + Dlg.Title := 'Select fossil executable'; + {$IFDEF MSWINDOWS} + Dlg.DefaultExt := 'exe'; + Dlg.FileName := 'fossil.exe'; + Dlg.Filter := 'Fossil executable|fossil.exe|All executables|*.exe|All files|*'; + {$ELSE} + Dlg.FileName := 'fossil'; + Dlg.Filter := 'Fossil executable|fossil|All files|*'; + {$ENDIF} + Dlg.FilterIndex := 1; + Dlg.Options := [ofEnableSizing, ofFileMustExist]; + if Dlg.Execute then begin + FFossil := TFossil.Create(Dlg.FileName); + end else begin + Halt(1); + end; + finally + Dlg.Free; + end; + end; + end; + Result := FFossil; +end; + +procedure TmodMain.miAppAboutClick(Sender: TObject); +begin + MessageDlg(Application.Title, FFossil.VersionInfo, mtInformation, [mbOK], 'Version'); +end; + +function TmodMain.GetCheckout: TFossilCheckout; +var + frm: TfrmOpenCheckout; + Dlg: TSelectDirectoryDialog; +begin + if not Assigned(FCheckout) and not Application.Terminated then begin + // ask for checkout directory + if (ParamCount >= 1) and DirectoryExistsUTF8(ParamStr(1)) then begin + FCheckout := TFossilCheckout.Create(Fossil, ParamStr(1)); + end; + + if not Assigned(FCheckout) then begin + frm := TfrmOpenCheckout.Create(Self); + try + if frm.Execute then begin + FCheckout := TFossilCheckout.Create(Fossil, frm.SelectedDir); + end; + finally + frm.Free; + end; + end; + + if not Assigned(FCheckout) then begin + Dlg := TSelectDirectoryDialog.Create(Self); + try + Dlg.InitialDir := GetCurrentDir; + Dlg.Title := 'Select checkout directory'; + Dlg.Options := [ofEnableSizing, ofPathMustExist]; + Dlg.Filter := 'All files|*'; + Dlg.FilterIndex := 1; + if Dlg.Execute then begin + FCheckout := TFossilCheckout.Create(Fossil, Dlg.FileName); + end else begin + Application.Terminate; + end; + finally + Dlg.Free; + end; + end; + end; + Result := FCheckout; +end; + +function TmodMain.ImageIndexFromStatuses(const Statuses: TFileStatuses): Integer; +const + Prio: array[TFileStatus] of TFileStatus = (fsConflict, fsMerged, fsMissing, fsIgnored, fsUntracked, fsAdded, fsModified, fsDeleted, fsUnchanged); +var + i, Status: TFileStatus; +begin + for i := Low(TFileStatus) to High(TFileStatus) do begin + Status := Prio[i]; + if Status in Statuses then begin + Result := Ord(Status); + Exit; + end; + end; +end; + +function TmodMain.ImageIndexFromType(const FileExt: string): Integer; +begin + Result := -1; + // TODO: check if we've already got it; if so, return that + // TODO: if not, retrieve the file type's icon + // TODO: Windows: SHGetFileIcon + // TODO: Linux? + // TODO: MacOS? + // TODO: add it to imlFileStatuses +end; + +function TmodMain.SetBusy(const Busy: Boolean): Boolean; +begin + if Busy then begin + if FBusyLevel = 0 then begin + Screen.Cursor := crHourGlass; + // TODO: indicate busyness elsewhere? + end; + Inc(FBusyLevel); + end else begin + Dec(FBusyLevel); + if FBusyLevel < 0 then + FBusyLevel := 0; + if FBusyLevel = 0 then begin + Screen.Cursor := crDefault; + // TODO: remove other indicators of busyness? + end; + end; + Result := FBusyLevel > 0; +end {TmodMain.SetBusy}; + +end. + ADDED src/prj/laz/paleo.ico Index: src/prj/laz/paleo.ico ================================================================== --- /dev/null +++ src/prj/laz/paleo.ico cannot compute difference between binary files ADDED src/prj/laz/paleo.lpi Index: src/prj/laz/paleo.lpi ================================================================== --- /dev/null +++ src/prj/laz/paleo.lpi @@ -0,0 +1,253 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <General> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="Paleo"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <UseVersionInfo Value="True"/> + <MinorVersionNr Value="2"/> + <Language Value="0809"/> + <CharSet Value="04B0"/> + <StringTable CompanyName="Voronwë" FileDescription="Fossil UI" InternalName="paleo" LegalCopyright="© Martijn Coppoolse" OriginalFilename="paleo.exe" ProductName="Stylemys" ProductVersion="1.0.0.0"/> + </VersionInfo> + <BuildModes Count="3"> + <Item1 Name="Default" Default="True"/> + <Item2 Name="Debug"> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="../../../out/$(TargetCPU)-$(TargetOS)/paleo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../..;../../lib"/> + <UnitOutputDirectory Value="../../../out/lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Checks> + <IOChecks Value="True"/> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf2Set"/> + <UseHeaptrc Value="True"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <IgnoredMessages idx5024="True"/> + </CompilerMessages> + </Other> + </CompilerOptions> + </Item2> + <Item3 Name="Release"> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="../../../out/$(TargetCPU)-$(TargetOS)/paleo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../.."/> + <UnitOutputDirectory Value="../../../out/lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <ExecuteAfter> + <Command Value=""C:/MC/Run/Util/Compression/UPX/upx.exe" --best -vk C:/MC/Code/Projects/Voronwe/GUI/FrontEnd/LazPaleo/out/i386-win32/paleo.exe"/> + <CompileReasons Compile="False" Run="False"/> + </ExecuteAfter> + </Other> + </CompilerOptions> + </Item3> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="4"> + <Item1> + <PackageName Value="LazControls"/> + </Item1> + <Item2> + <PackageName Value="IDEIntf"/> + </Item2> + <Item3> + <PackageName Value="SynEdit"/> + </Item3> + <Item4> + <PackageName Value="LCL"/> + </Item4> + </RequiredPackages> + <Units Count="13"> + <Unit0> + <Filename Value="paleo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="../../f_commit.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="frmCommit"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="F_Commit"/> + </Unit1> + <Unit2> + <Filename Value="../../a_filelist.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="fraFileList"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Frame"/> + <UnitName Value="A_FileList"/> + </Unit2> + <Unit3> + <Filename Value="../../m_main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="modMain"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="DataModule"/> + <UnitName Value="M_Main"/> + </Unit3> + <Unit4> + <Filename Value="../../a_fileversioninfo.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="fraFileVersionInfo"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Frame"/> + <UnitName Value="A_FileVersionInfo"/> + </Unit4> + <Unit5> + <Filename Value="../../u_fossil.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="U_Fossil"/> + </Unit5> + <Unit6> + <Filename Value="../../a_commitmessage.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="frameCommitMessage"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Frame"/> + <UnitName Value="A_CommitMessage"/> + </Unit6> + <Unit7> + <Filename Value="../../m_highlighters.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="modHighlighters"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="DataModule"/> + <UnitName Value="M_Highlighters"/> + </Unit7> + <Unit8> + <Filename Value="../../synhighlighterdiffwide.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="SynHighlighterDiffWide"/> + </Unit8> + <Unit9> + <Filename Value="../../synhighlighterannotate.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="SynHighlighterAnnotate"/> + </Unit9> + <Unit10> + <Filename Value="../../lib/dirwatch.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="DirWatch"/> + </Unit10> + <Unit11> + <Filename Value="../../f_opencheckout.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="frmOpenCheckout"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="F_OpenCheckout"/> + </Unit11> + <Unit12> + <Filename Value="../../f_newbranch.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="frmNewBranch"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="F_NewBranch"/> + </Unit12> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="../../../out/$(TargetCPU)-$(TargetOS)/paleo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../.."/> + <UnitOutputDirectory Value="../../../out/lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> ADDED src/prj/laz/paleo.lpr Index: src/prj/laz/paleo.lpr ================================================================== --- /dev/null +++ src/prj/laz/paleo.lpr @@ -0,0 +1,46 @@ +program paleo; + +{$mode objfpc}{$H+} + +uses + {$DEFINE UseCThreads} + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, SysUtils, + M_Main, + F_Commit, + A_FileList, + A_FileVersionInfo, + A_CommitMessage, + M_Highlighters; + +{$R *.res} + +(* + TODO + + // In CommitMessage, get list of tickets to insert => [<tkt_uuid>|Subject]? + // also mark those tickets as closed; + // fossil ticket set '+TicketUUID+' status '+NewStatus+' icomment '+ TicketQuoted(NewStatus + ' by commit [' + GetParentUUID + ']' --quote; + + TFossilStashList + TFossilStash + + TFossilTickets + TFossilTicket + TFossilTicketChanges + +*) + +begin + Application.Title:='Paleo'; + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TmodMain, modMain); + Application.CreateForm(TfrmCommit, frmCommit); + Application.CreateForm(TmodHighlighters, modHighlighters); + Application.Run; +end. + ADDED src/prj/laz/paleo.res Index: src/prj/laz/paleo.res ================================================================== --- /dev/null +++ src/prj/laz/paleo.res cannot compute difference between binary files ADDED src/synhighlighterannotate.pas Index: src/synhighlighterannotate.pas ================================================================== --- /dev/null +++ src/synhighlighterannotate.pas @@ -0,0 +1,341 @@ +unit SynHighlighterAnnotate; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, + fgl, + SynEditHighlighter; + +type + TSynHighlighterAttributesList = specialize TFPGList<TSynHighlighterAttributes>; + + TAnnFileVersion = record + Version: Integer; + Date: TDateTime; + RevisionUUID: string; + FileUUID: string; + end; + PAnnFileVersion = ^TAnnFileVersion; + + { TSynAnnotateSyn } + + TSynAnnotateSyn = class(TSynCustomHighlighter) + private + FColorAncient: TColor; + FColorRecent: TColor; + FSubHL: TSynCustomHighlighter; + + FStyles: TSynHighlighterAttributesList; + FVersions: array of TAnnFileVersion; + FRevisions: TStringList; + FColorsAssigned: Boolean; + + FLineText: string; + FLineIndex: Integer; + + FTokenPos: Integer; + FTokenLength: Integer; + FTokenStyle: Integer; // index in FStyles + FDelegate: Boolean; + + procedure AssignColors; + + procedure SetColorAncient(AValue: TColor); + procedure SetColorRecent(AValue: TColor); + public + procedure SetLine(const NewValue: String; + LineNumber:Integer // 0 based + ); override; + procedure Next; override; + function GetEol: Boolean; override; + procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; + function GetTokenAttribute: TSynHighlighterAttributes; override; + function GetToken: String; override; + function GetTokenPos: Integer; override; // 0-based + function GetTokenKind: integer; override; + + function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override; + function GetEndOfLineAttribute: TSynHighlighterAttributes; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function SetVersionsFromLog(const AnnotateLog: string): Integer; + published + property ColorAncient: TColor read FColorAncient write SetColorAncient; + property ColorRecent: TColor read FColorRecent write SetColorRecent; + property Highlighter: TSynCustomHighlighter read FSubHL write FSubHL; + end; + + +implementation +uses + Math; + +{ TSynAnnotateSyn } + +constructor TSynAnnotateSyn.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FColorAncient := RGBToColor(128, 128, 64); + FColorRecent := RGBToColor(128, 255, 64); + FStyles := TSynHighlighterAttributesList.Create; + FStyles.Add(AddSpecialAttribute('regular', 'regular')); + + SetLength(FVersions, 0); + FRevisions := TStringList.Create; + FRevisions.CaseSensitive := True; +end; + +destructor TSynAnnotateSyn.Destroy; +begin + FRevisions.Free; + FStyles.Free; + inherited Destroy; +end; + +function TSynAnnotateSyn.SetVersionsFromLog(const AnnotateLog: string): Integer; +var + Lines, Fields: TStringList; + Line: string; + FV: PAnnFileVersion; + Index: Integer; +begin + // ASSERTION: This only gets called once in the lifetime of this instance + Assert(FRevisions.Count = 0, 'TSynAnnotateSyn currently does not support re-use'); + + FRevisions.BeginUpdate; + try + FRevisions.Sorted := False; + FRevisions.Clear; + Lines := TStringList.Create; + Fields := TStringList.Create; + try + Fields.StrictDelimiter := False; + Fields.Delimiter := ' '; + Lines.Sorted := False; + Lines.Text := AnnotateLog; + SetLength(FVersions, Lines.Count); + Result := 0; + + for Line in Lines do begin + Fields.DelimitedText := Line; + FV := @FVersions[Result]; + if not TryStrToInt(StringReplace(Fields[1], ':', '', []), FV^.Version) then + Continue; + if not TryStrToDate(Fields[2], FV^.Date, 'yyyy-MM-dd', '-') then + Continue; + FV^.RevisionUUID := Fields[3]; + if Fields[4] <> 'file' then + Continue; + FV^.FileUUID := Fields[5]; + + Index := FStyles.Add(AddSpecialAttribute(FV^.RevisionUUID, FV^.RevisionUUID)); + Assert(Index = Result + 1); + + FRevisions.AddObject(FV^.RevisionUUID, FStyles.Items[Index]); + + // TODO? + + Inc(Result); + end {for}; + if Result < Length(FVersions) then + SetLength(FVersions, Result); + finally + Fields.Free; + Lines.Free; + end; + finally + FRevisions.Sorted := True; + FRevisions.EndUpdate; + end; + + FColorsAssigned := False; +end {TSynAnnotateSyn.SetVersionsFromLog}; + +procedure TSynAnnotateSyn.AssignColors; +var + R1, G1, B1, R2, G2, B2: Byte; + R, G, B: Byte; + Span: Integer; + i: Integer; + Fraction, InvFraction: Double; +begin + Span := High(FVersions); + if Span > 0 then begin + RedGreenBlue(FColorRecent, R1, G1, B1); + RedGreenBlue(FColorAncient, R2, G2, B2); + for i := Low(FVersions) to High(FVersions) do begin + Fraction := i / Span; + InvFraction := 1 - Fraction; + R := Trunc((R1 * InvFraction) + (R2 * Fraction)); + G := Trunc((G1 * InvFraction) + (G2 * Fraction)); + B := Trunc((B1 * InvFraction) + (B2 * Fraction)); + FStyles[i + 1].Background := RGBToColor(R, G, B); + end; + end else begin + FStyles[1].Background := FColorRecent; + end; + FColorsAssigned := True; +end; + +procedure TSynAnnotateSyn.SetColorAncient(AValue: TColor); +begin + if FColorAncient = AValue then Exit; + FColorAncient := AValue; + FColorsAssigned := False; +end; + +procedure TSynAnnotateSyn.SetColorRecent(AValue: TColor); +begin + if FColorRecent = AValue then Exit; + FColorRecent := AValue; + FColorsAssigned := False; +end; + +procedure TSynAnnotateSyn.SetLine(const NewValue: String; LineNumber: Integer); +var + UUID: string; + Attr: TSynHighlighterAttributes; + i: Integer; +begin + inherited SetLine(NewValue, LineNumber); + FLineText := NewValue; + FLineIndex := LineNumber; + + if not FColorsAssigned then begin + // assign colors to revisions or dates + AssignColors; + end; + + FTokenPos := 1; + FTokenLength := Pos(':', FLineText) + 1; + + // determine which revision and date we're dealing with + UUID := Copy(FLineText, 1, 10); + // select the appropriate styler + Attr := TSynHighlighterAttributes(FRevisions.Objects[FRevisions.IndexOf(UUID)]); + FTokenStyle := 0; + for i := 0 to FStyles.Count - 1 do begin + if FStyles[i] = Attr then begin + FTokenStyle := i; + Break; + end; + end; + + FDelegate := False; +end; + +procedure TSynAnnotateSyn.Next; +begin + if not Assigned(FSubHL) then begin + FTokenPos := FTokenPos + Max(1, FTokenLength); + FTokenLength := Max(0, Length(FLineText) - FTokenPos + 1); + // switch to the regular styler for the textual contents + FTokenStyle := 0; + end else if not FDelegate then begin + // notify the subhighlighter + FDelegate := True; + try + FSubHL.SetLine(Copy(FLineText, FTokenLength + 1, Length(FLineText)), FLineIndex); + except + // In case of boo-boo, immediately disable the sub-highlighter, and fall back to our default behaviour + FSubHL := nil; + FDelegate := False; + Next; + end; + end else begin + // delegate to the subhighlighter + try + FSubHL.Next; + except + // In case of boo-boo, immediately disable the sub-highlighter, and fall back to our default behaviour + FSubHL := nil; + FDelegate := False; + Next; + end; + end; +end; + +function TSynAnnotateSyn.GetEol: Boolean; +begin + if not FDelegate then begin + Result := FTokenPos > Length(FLineText); + end else begin + Result := FSubHL.GetEol; + end; +end; + +procedure TSynAnnotateSyn.GetTokenEx(out TokenStart: PChar; out + TokenLength: integer); +begin + if not FDelegate then begin + TokenStart := @FLineText[FTokenPos]; + TokenLength := FTokenLength; + end else begin + FSubHL.GetTokenEx(TokenStart, TokenLength); + end; +end; + +function TSynAnnotateSyn.GetTokenAttribute: TSynHighlighterAttributes; +begin + if not FDelegate then begin + Result := FStyles[FTokenStyle]; + end else begin + Result := FSubHL.GetTokenAttribute; + end; +end; + +function TSynAnnotateSyn.GetToken: String; +begin + if not FDelegate then begin + Result := Copy(FLineText, FTokenPos, FTokenLength); + end else begin + Result := FSubHL.GetToken; + end; +end; + +function TSynAnnotateSyn.GetTokenPos: Integer; +begin + // return the token position (0-based) + if not FDelegate then begin + Result := FTokenPos - 1; + end else begin + Result := FSubHL.GetTokenPos + Pos(':', FLineText); + end; +end; + +function TSynAnnotateSyn.GetTokenKind: integer; +begin + if not FDelegate then begin + Result := FTokenStyle; + end else begin + Result := FSubHL.GetTokenKind + FStyles.Count; // TODO: do we need to increment with FStyles.Count? + end; +end; + +function TSynAnnotateSyn.GetDefaultAttribute(Index: integer + ): TSynHighlighterAttributes; +begin + case Index of + SYN_ATTR_WHITESPACE: + Result := FStyles[0]; + else + Result := nil; + end; +end; + +function TSynAnnotateSyn.GetEndOfLineAttribute: TSynHighlighterAttributes; +begin + if not FDelegate then begin + Result := inherited GetEndOfLineAttribute; + end else begin + Result := FSubHL.GetEndOfLineAttribute; + end; +end; + +end. + ADDED src/synhighlighterdiffwide.pas Index: src/synhighlighterdiffwide.pas ================================================================== --- /dev/null +++ src/synhighlighterdiffwide.pas @@ -0,0 +1,594 @@ +unit SynHighlighterDiffWide; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, + SynEditHighlighter; + +type + + THighlightStyle = (hsUnknown, hsHeader, hsDivider, hsLineNumber, hsSpace, + hsMarkerDeleted, hsMarkerEdited, hsMarkerAdded, + hsContent, hsContentDeleted, hsContentEdited, hsContentAdded); + + THSColDef = record + ByteStart: Integer; + CharStart: Integer; + ByteLength: Integer; + CharLength: Integer; + Style: THighlightStyle; + end; + PHSColDef = ^THSColDef; + + { TSynDiffWideSyn } + + TSynDiffWideSyn = class(TSynCustomHighlighter) + private + FStyles: array[THighlightStyle] of TSynHighlighterAttributes; + + FLineText: string; + FLineIndex: Integer; + FLineType: Char; + FFullWidth: Integer; + FContentWidth: Integer; + FColDefs: array[0..8] of THSColDef; + FSubColDefs: array[Boolean,0..3] of THSColDef; + + FColIndex: Integer; + FSubColIndex: Integer; + + FTokenPos: Integer; + FTokenLength: Integer; + FTokenStyle: THighlightStyle; + + procedure CompareContent(const Left, Right: String); + + function GetStyleAttrib(AIndex: THighlightStyle): TSynHighlighterAttributes; + procedure SetStyleAttrib(AIndex: THighlightStyle; AValue: TSynHighlighterAttributes); + protected + procedure SetToken(const StartPos, ALength: Integer; const Style: THighlightStyle); overload; + procedure SetToken(const ColDef: PHSColDef); overload; inline; + public + procedure SetLine(const NewValue: String; + LineNumber:Integer // 0 based + ); override; + procedure Next; override; + function GetEol: Boolean; override; + procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; + function GetTokenAttribute: TSynHighlighterAttributes; override; + function GetToken: String; override; + function GetTokenPos: Integer; override; // 0-based + function GetTokenKind: integer; override; + + function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override; + function GetEndOfLineAttribute: TSynHighlighterAttributes; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property UnknownAttrib: TSynHighlighterAttributes index hsUnknown read GetStyleAttrib write SetStyleAttrib; + property HeaderAttrib: TSynHighlighterAttributes index hsHeader read GetStyleAttrib write SetStyleAttrib; + property DividerAttrib: TSynHighlighterAttributes index hsDivider read GetStyleAttrib write SetStyleAttrib; + property LineNumberAttrib: TSynHighlighterAttributes index hsLineNumber read GetStyleAttrib write SetStyleAttrib; + property SpaceAttrib: TSynHighlighterAttributes index hsSpace read GetStyleAttrib write SetStyleAttrib; + property MarkerDeletedAttrib: TSynHighlighterAttributes index hsMarkerDeleted read GetStyleAttrib write SetStyleAttrib; + property MarkerEditedAttrib: TSynHighlighterAttributes index hsMarkerEdited read GetStyleAttrib write SetStyleAttrib; + property MarkerAddedAttrib: TSynHighlighterAttributes index hsMarkerAdded read GetStyleAttrib write SetStyleAttrib; + property ContentAttrib: TSynHighlighterAttributes index hsContent read GetStyleAttrib write SetStyleAttrib; + property ContentDeletedAttrib: TSynHighlighterAttributes index hsContentDeleted read GetStyleAttrib write SetStyleAttrib; + property ContentEditedAttrib: TSynHighlighterAttributes index hsContentEdited read GetStyleAttrib write SetStyleAttrib; + property ContentAddedAttrib: TSynHighlighterAttributes index hsContentAdded read GetStyleAttrib write SetStyleAttrib; + end; + +implementation +uses + TypInfo, Math, StrUtils; + +type TByteType = (Invalid = 0, FirstOf1, FirstOf2, FirstOf3, FirstOf4, AfterFirst); + +function ByteType(const B: Byte): TByteType; inline; +begin + // https://en.wikipedia.org/wiki/UTF-8#Description + if B and %10000000 = %00000000 then + Result := FirstOf1 // single-byte character + else if B and %11000000 = %10000000 then + Result := AfterFirst // 2nd, 3rd, or 4th byte of multiple-byte char + else if B and %11100000 = %11000000 then + Result := FirstOf2 // first byte of two-byte char + else if B and %11110000 = %11100000 then + Result := FirstOf3 // first byte of three-byte char + else if B and %11111000 = %11110000 then + Result := FirstOf4 // first byte of four-byte char + else + Result := Invalid; // invalid UTF-8 character +end; +function ByteType(const C: Char): TByteType; inline; +begin + Result := ByteType(Byte(C)); +end; +function ByteType(const C: PChar): TByteType; inline; +begin + Result := ByteType(Byte(C^)); +end; + +function FirstByteOfChar(const C: PChar): PChar; +var + BT: TByteType; +begin + if (C = nil) or (C^ = #0) then + Exit(C); + + Result := C; + BT := ByteType(Result); + while BT = AfterFirst do begin + Dec(Result); + BT := ByteType(Result); + end; +end; + +function FirstByteOfChar(const S: string; const Index: Integer): Integer; +var + BT: TByteType; +begin + if (Index < 1) or (Index > Length(S)) then + Exit(Index); + + Result := Index; + BT := ByteType(S[Result]); + while (Result > 1) and (BT = AfterFirst) do begin + Dec(Result); + BT := ByteType(S[Result]); + end; +end; + +function LastByteOfChar(const C: PChar): PChar; +var + BT: TByteType; +begin + if (C = nil) or (C^ = #0) then + Exit(C); + + Result := C; + BT := ByteType(C); + while BT in [FirstOf2, FirstOf3, FirstOf4] do begin + Inc(Result); + BT := ByteType(Result); + end; +end; +function LastByteOfChar(const S: string; const Index: Integer): Integer; +var + BT: TByteType; +begin + if (Index < 1) or (Index > Length(S)) then + Exit(Index); + + Result := Index; + BT := ByteType(S[Result]); + while (Result < Length(S)) and (BT in [FirstOf2, FirstOf3, FirstOf4]) do begin + Inc(Result); + BT := ByteType(S[Result]); + end; +end; + + +{ TSynDiffWideSyn } + +constructor TSynDiffWideSyn.Create(AOwner: TComponent); +var + ColStart: Integer; + procedure DefineCol(const ColIndex, Length: Integer; const Style: THighlightStyle); + begin + if ColIndex = 0 then ColStart := 1; + FColDefs[ColIndex].ByteStart := ColStart; + FColDefs[ColIndex].ByteLength := Length; + FColDefs[ColIndex].CharStart := ColStart; + FColDefs[ColIndex].CharLength := Length; + FColDefs[ColIndex].Style := Style; + ColStart += Length; + end; +var + hs: THighlightStyle; + Attr: TSynHighlighterAttributes; + StyleName: string; +begin + inherited Create(AOwner); + + FLineText := ''; + FLineIndex := -1; + FLineType := #0; + + FTokenPos := 1; + FTokenLength := 0; + FTokenStyle := hsUnknown; + + FColIndex := 0; + DefineCol(0, 5, hsLineNumber); + DefineCol(1, 2, hsSpace); + DefineCol(2, 50, hsContentDeleted); + DefineCol(3, 1, hsSpace); + DefineCol(4, 1, hsMarkerEdited); + DefineCol(5, 1, hsSpace); + DefineCol(6, 5, hsLineNumber); + DefineCol(7, 2, hsSpace); + DefineCol(8, 50, hsContentAdded); + + for hs := Low(THighlightStyle) to High(THighlightStyle) do begin + StyleName := GetEnumName(TypeInfo(THighlightStyle), Ord(hs)); + StyleName := Copy(StyleName, 3, Length(StyleName)); + Attr := AddSpecialAttribute(StyleName, StyleName); + FStyles[hs] := Attr; + case hs of + hsUnknown: begin + Attr.Style := [fsItalic]; + end; + hsHeader: begin + Attr.Style := [fsBold]; + end; + hsDivider: begin + Attr.Style := [fsBold]; + Attr.Foreground := clBlue; + end; + hsSpace, hsContent: begin + end; + hsLineNumber: begin + Attr.Background := clBtnFace; // clGray; + Attr.Foreground := clBtnText; // clWhite; + end; + hsMarkerAdded: begin + Attr.Foreground := clGreen; + end; + hsMarkerEdited: begin + Attr.Foreground := clNavy; + end; + hsMarkerDeleted: begin + Attr.Foreground := clRed; + end; + hsContentAdded: begin + Attr.Background := TColor($C0FFC0); + end; + hsContentEdited: begin + Attr.Background := TColor($FFC0C0); + end; + hsContentDeleted: begin + Attr.Background := TColor($C0C0FF); + end; + end; + end; +end; + +destructor TSynDiffWideSyn.Destroy; +begin + inherited Destroy; +end; + +function TSynDiffWideSyn.GetStyleAttrib(AIndex: THighlightStyle): TSynHighlighterAttributes; +begin + Result := FStyles[AIndex]; +end; + +procedure TSynDiffWideSyn.SetStyleAttrib(AIndex: THighlightStyle; AValue: TSynHighlighterAttributes); +begin + FStyles[AIndex].Assign(AValue); +end; + +procedure TSynDiffWideSyn.SetToken(const StartPos, ALength: Integer; const Style: THighlightStyle); +begin + FTokenPos := StartPos; // FTokenPos is 1-based + if (ALength < 0) or (StartPos + ALength > Length(FLineText)) then begin + FTokenLength := Length(FLineText) - FTokenPos + 1 + end else begin + FTokenLength := StartPos + ALength - FTokenPos; + end; + FTokenStyle := Style; +end; +procedure TSynDiffWideSyn.SetToken(const ColDef: PHSColDef); +begin + SetToken(ColDef^.ByteStart, ColDef^.ByteLength, ColDef^.Style); +end; + +procedure TSynDiffWideSyn.SetLine(const NewValue: String; LineNumber: Integer); +var + DiffType: string; + ContentLeft, ContentRight: string; + i: Integer; + ColIndex, ByteIndex, CharIndex: Integer; + PLastChar, PCurrChar: PChar; + BytesToSkip: Integer; +begin + inherited SetLine(NewValue, LineNumber); + FLineText := NewValue; + FLineIndex := LineNumber; + if Length(NewValue) = 0 then begin + FLineType := #0; + SetToken(1, -1, hsUnknown); + Exit; + end; + // keep track of the type of line we're on + FLineType := NewValue[1]; + case FLineType of + '=': begin // header + // set the token to the entire line, and set the styler to HeaderAttri + SetToken(1, -1, hsHeader); + + // Determine the content width + FFullWidth := Length(FLineText); + FContentWidth := (Length(FLineText) - 1) div 2 - 8; + FColDefs[2].ByteLength := FContentWidth; + FColDefs[8].ByteLength := FContentWidth; + // Adjust the content columns + for i := 2 to High(FColDefs) do begin + with FColDefs[i] do begin + ByteStart := FColDefs[i - 1].ByteStart + FColDefs[i - 1].ByteLength; + CharStart := ByteStart; + CharLength := ByteLength; + end; + end; + end; + '.': begin // divider + // set the token to the entire line, and set the styler to DividerAttri + SetToken(1, -1, hsDivider); + end; + ' ', '0'..'9': begin // a diff line + FLineType := ' '; + // set the token to the first 5 chars, and set the styler to LineNumberAttri + FColIndex := 0; + SetToken(@FColDefs[FColIndex]); + + // Walk through the entire line, *character by character*, and populate/adjust the + // ByteStart and ByteLength properties of each column as we go. Also isolate the left and + // right content while we're at it. + DiffType := ' '; + ColIndex := 0; + PLastChar := @FLineText[Length(FLineText)]; + PCurrChar := @FLineText[1]; + ByteIndex := 1; + CharIndex := 1; + while PCurrChar <= PLastChar do begin + if (PCurrChar = PLastChar) and (CharIndex < FFullWidth) then begin + FLineText := FLineText + StringOfChar(' ', FFullWidth - CharIndex); + PLastChar := @FLineText[Length(FLineText)]; + PCurrChar := @FLineText[ByteIndex]; + end; + // Skip bytes in case of multibyte characters + case ByteType(PCurrChar) of + FirstOf2: BytesToSkip := 1; + FirstOf3: BytesToSkip := 2; + FirstOf4: BytesToSkip := 3; + else BytesToSkip := 0; + end; + Inc(PCurrChar, BytesToSkip); + Inc(ByteIndex, BytesToSkip); + + // Figure out if we've moved into the next column + if CharIndex >= FColDefs[ColIndex].CharStart + FColDefs[ColIndex].CharLength then begin + FColDefs[ColIndex].ByteLength := ByteIndex - FColDefs[ColIndex].ByteStart; + + // Set aside the content + case ColIndex of + 2: begin // left-hand content + ContentLeft := Copy(FLineText, FColDefs[ColIndex].ByteStart, FColDefs[ColIndex].ByteLength); + ContentLeft := TrimRight(ContentLeft); + end; + 4: begin // diff marker + DiffType := Copy(FLineText, FColDefs[ColIndex].ByteStart, FColDefs[ColIndex].ByteLength); + end; + // There is no column 9, so we can only check for the right-hand content after the end of the loop + end; + + // Move to next column + if ColIndex < High(FColDefs) then begin + Inc(ColIndex); + FColDefs[ColIndex].ByteStart := ByteIndex; + end; + end; + + // Next byte please! + Inc(PCurrChar); + Inc(ByteIndex); + Inc(CharIndex); + end; + if ColIndex = 8 then begin // right-hand content + ContentRight := Copy(FLineText, FColDefs[ColIndex].ByteStart, FColDefs[ColIndex].ByteLength); + ContentRight := TrimRight(ContentRight); + end; + + case DiffType of + '<': begin + FColDefs[2].Style := hsContentDeleted; + FColDefs[4].Style := hsMarkerDeleted; + FColDefs[8].Style := hsContent; + end; + '>': begin + FColDefs[2].Style := hsContent; + FColDefs[4].Style := hsMarkerAdded; + FColDefs[8].Style := hsContentAdded; + end; + '|': begin + FColDefs[2].Style := hsContentEdited; + FColDefs[4].Style := hsMarkerEdited; + FColDefs[8].Style := hsContentEdited; + end + else begin + FColDefs[2].Style := hsContent; + FColDefs[4].Style := hsMarkerEdited; + FColDefs[8].Style := hsContent; + end; + end; + + if DiffType = '|' then begin + // compare left and right content, and adjust their respective subcols + FLineType := '|'; + CompareContent(ContentLeft, ContentRight); + end; + end; + else begin // unknown + FLineType := '?'; + // set the token to the entire line, and set the styler to UnknownAttri + SetToken(1, -1, hsUnknown); + end; + end; +end; + +procedure TSynDiffWideSyn.CompareContent(const Left, Right: string); + procedure DefineSubCols(const IsLeft: Boolean; const DiffStart, DiffEnd, MaxLength: Integer; const Style: THighlightStyle); + const + ColIndex: array[Boolean] of Integer = (8, 2); + begin + FSubColDefs[IsLeft, 0].ByteStart := FColDefs[ColIndex[IsLeft]].ByteStart; + FSubColDefs[IsLeft, 0].ByteLength := DiffStart - 1; + FSubColDefs[IsLeft, 0].Style := hsContent; + FSubColDefs[IsLeft, 1].ByteStart := FSubColDefs[IsLeft, 0].ByteStart + FSubColDefs[IsLeft, 0].ByteLength; + FSubColDefs[IsLeft, 1].ByteLength := DiffEnd - DiffStart + 1; + FSubColDefs[IsLeft, 1].Style := Style; + FSubColDefs[IsLeft, 2].ByteStart := FSubColDefs[IsLeft, 1].ByteStart + FSubColDefs[IsLeft, 1].ByteLength; + FSubColDefs[IsLeft, 2].ByteLength := MaxLength - DiffEnd + 1; + FSubColDefs[IsLeft, 2].Style := hsContent; + FSubColDefs[IsLeft, 3].ByteStart := FSubColDefs[IsLeft, 2].ByteStart + FSubColDefs[IsLeft, 2].ByteLength; + FSubColDefs[IsLeft, 3].ByteLength := FColDefs[ColIndex[IsLeft]].ByteLength - MaxLength - 1; + FSubColDefs[IsLeft, 3].Style := hsSpace; + end; +var + MinLast: Integer; + FirstDiff, RevFirstDiff, LastDiffLeft, LastDiffRight: Integer; + i: Integer; + LastLeft, LastRight: Integer; + StyleLeft, StyleRight: THighlightStyle; + LeftHasContent, RightHasContent: Boolean; +begin + // Scan Left and Right to see how far they're equal from the left; + LastLeft := Length(Left); + LastRight := Length(Right); + MinLast := Min(LastLeft, LastRight); + FirstDiff := MinLast + 1; + for i := 1 to MinLast do begin + if Left[i] <> Right[i] then begin + // We've found a different byte! + FirstDiff := FirstByteOfChar(Left, i); + Break; + end; + end; + + // Scan Left and Right to see how far they're equal from the right; + RevFirstDiff := MinLast - FirstDiff + 1; + for i := 0 to MinLast - FirstDiff do begin + if Left[LastLeft - i] <> Right[LastRight - i] then begin + // We've found a different byte! + RevFirstDiff := i; + Break; + end; + end; + LastDiffLeft := LastByteOfChar(Left, LastLeft - RevFirstDiff); + LastDiffRight := LastByteOfChar(Right, LastRight - RevFirstDiff); + + // Figure out if the diff part has content on either side, or not, + // and determine the styling based on that. + LeftHasContent := FirstDiff <= LastDiffLeft; + RightHasContent := FirstDiff <= LastDiffRight; + if LeftHasContent = RightHasContent then begin + StyleLeft := hsContentEdited; + StyleRight := hsContentEdited; + end else begin + StyleLeft := hsContentDeleted; + StyleRight := hsContentAdded; + end; + + if not LeftHasContent and not RightHasContent then begin + FLineType := ' '; + end else begin + // Split up the left and right contents into same|diff|same|trailing-whitespace + DefineSubCols(True, FirstDiff, LastDiffLeft, LastLeft, StyleLeft); + DefineSubCols(False, FirstDiff, LastDiffRight, LastRight, StyleRight); + end; +end; + +procedure TSynDiffWideSyn.Next; +begin + // 0:linenum[5], 1:space[2], 2:content[FContentWidth], 3:space[1], 4:marker[1], 5:space[1], 6:linenum[5], 7:space[2], 8:content[FContentWidth] + case FLineType of + ' ': begin + Inc(FColIndex); + if FColIndex < Length(FColDefs) then begin + SetToken(@FColDefs[FColIndex]); + end else begin + SetToken(Length(FLineText) + 1, 0, hsUnknown); + end; + end; + '|': begin + if (FColIndex in [2, 8]) and (FSubColIndex < 3) then begin + Inc(FSubColIndex); + end else begin + Inc(FColIndex); + FSubColIndex := 0; + end; + case FColIndex of + 2: begin // left content column + SetToken(@FSubColDefs[True, FSubColIndex]); + end; + 8: begin // right content column + SetToken(@FSubColDefs[False, FSubColIndex]); + end; + else begin // normal column(s) + if FColIndex < Length(FColDefs) then begin + SetToken(@FColDefs[FColIndex]); + end else begin + SetToken(Length(FLineText) + 1, 0, hsUnknown); + end; + end; + end; + end; + else + SetToken(Length(FLineText) + 1, 0, hsSpace); + end; +end; + +function TSynDiffWideSyn.GetEol: Boolean; +begin + Result := FTokenPos > Length(FLineText); +end; + +procedure TSynDiffWideSyn.GetTokenEx(out TokenStart: PChar; out TokenLength: Integer); +begin + TokenStart := @FLineText[FTokenPos]; + TokenLength := FTokenLength; +end; + +function TSynDiffWideSyn.GetEndOfLineAttribute: TSynHighlighterAttributes; +begin + Result := inherited GetEndOfLineAttribute; // TODO? +end; + +function TSynDiffWideSyn.GetTokenAttribute: TSynHighlighterAttributes; +begin + Result := FStyles[FTokenStyle]; +end; + +function TSynDiffWideSyn.GetToken: String; +begin + Result := Copy(FLineText, FTokenPos, FTokenLength); +end; + +function TSynDiffWideSyn.GetTokenPos: Integer; +begin + // return the token position (0-based) + Result := FTokenPos - 1; +end; + +function TSynDiffWideSyn.GetTokenKind: Integer; +begin + Result := Ord(FTokenStyle); +end; + +function TSynDiffWideSyn.GetDefaultAttribute(Index: Integer): TSynHighlighterAttributes; +begin + case Index of + SYN_ATTR_WHITESPACE: Result := Self.SpaceAttrib; + else + Result := nil; + end; +end; + +end. + ADDED src/u_fossil.pas Index: src/u_fossil.pas ================================================================== --- /dev/null +++ src/u_fossil.pas @@ -0,0 +1,1549 @@ +unit U_Fossil; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Contnrs, Graphics, + fgl; + +type + TFileStatus = (fsUnchanged, fsAdded, fsModified, fsDeleted, + fsMissing, fsMerged, fsConflict, fsIgnored, fsUntracked); + TFileStatuses = set of TFileStatus; +const + fsChanged: TFileStatuses = [fsAdded, fsModified, fsDeleted, fsMissing, fsMerged, fsConflict]; + +type + TFossilFileState = (ffsUnknown, ffsChanged, ffsUnchanged, ffsExtra, ffsIgnored); + TFossilFileStates = set of TFossilFileState; + +const + ffsPending = [ffsChanged, ffsExtra]; + +type + // forward declarations + TFossilObject = class; + TFossilRevision = class; + TFossilWorkdir = class; + TFileVersion = class; + + TFossilObjectClass = class of TFossilObject; + + { TFossil } + + TFossil = class + // TODO: this object represents a fossil executable, and all that can be + // done with it. It's a very low-level interface (returns strings, at most) + // Or does it just have a class var with fossil's path, and only class methods? + private + FExePath: TFileName; + FCurDir: TFileName; + FVersionInfo: string; + public + constructor Create(const AExecutable: TFileName; const ACurrentDir: TFileName = ''); + + function Run(const Command: string; const TrimTrailingSpaces: Boolean = True): string; + + property Executable: TFileName read FExePath; + property CurrentDir: TFileName read FCurDir write FCurDir; + property VersionInfo: string read FVersionInfo; + end; + + TFossilRevisionList = specialize TFPGList<TFossilRevision>; + + { TFossilUtilities } + + TFossilUtilities = class + private + FFossil: TFossil; + public + constructor Create(const Fossil: TFossil); + + function GetDefaultColor(const BranchName: string): TColor; + end; + + { TFossilCheckout } + + TFossilCheckout = class + // TODO: this object represents a entire checkout. It also manages all this checkout's objects + private + FFossil: TFossil; + FOwnFossil: Boolean; + FPath: TFileName; + FObjects: TFPObjectList; + FRevisions: TFossilRevisionList; + FWorkdir: TFossilWorkdir; + FInfo: TStringList; + FSettings: TStringList; + FCurrentRev: TFossilRevision; + FUtilities: TFossilUtilities; + + function GetCaseSensitive: Boolean; + function GetCurrentRevision: TFossilRevision; + function GetInfo: TStringList; + function GetRevisions: TFossilRevisionList; + function GetSettings: TStringList; + procedure SetCurrentRevision(AValue: TFossilRevision); + public + constructor Create(const Fossil: TFossil; Path: TFileName = ''); + destructor Destroy; override; + + function PathFromFossil(const Path: TFileName): TFileName; + function FindObjectByUUID(UUID: string; const ObjectClass: TFossilObjectClass = nil): TFossilObject; + + function LoadRevisions(Limit: Integer = 200; Offset: Integer = 0): Integer; + + property Exe: TFossil read FFossil; + property Path: TFileName read FPath write FPath; + property Workdir: TFossilWorkdir read FWorkdir; + property Revisions: TFossilRevisionList read GetRevisions; + property Info: TStringList read GetInfo; + property Settings: TStringList read GetSettings; + property CurrentRevision: TFossilRevision read GetCurrentRevision write SetCurrentRevision; + property Util: TFossilUtilities read FUtilities; + + // TODO + //property RepositoryPath: TFileName read; // the path of the repository + //property RemoteURL: string read write; // the synchronisation URL + + + property CaseSensitive: Boolean read GetCaseSensitive; + end; + + + { TFossilObject } + + TFossilObject = class + private + FUUID: string; + FCheckout: TFossilCheckout; + FInfo: TStringList; + protected + function GetInfo: TStringList; virtual; + public + constructor Create(const ACheckout: TFossilCheckout); virtual; + destructor Destroy; override; + + function CompareUUID(const OtherUUID: string): Integer; + + property Checkout: TFossilCheckout read FCheckout; + property UUID: string read FUUID write FUUID; + property Info: TStringList read GetInfo; + end; + + + { TFossilFileList } + + TFossilFileList = specialize TFPGObjectList<TFileVersion>; + + + { TFossilRevision } + + TFossilRevision = class(TFossilObject) + private + FParentUUID: string; + FFiles: TFossilFileList; + FTags: TStringList; + FDateTimeUTC: TDateTime; + FDateTime: TDateTime; + FUser: string; + FMessage: string; + FBranch: string; + + function GetCurrent: Boolean; virtual; + function GetTags: TStringList; + procedure SetCurrent(AValue: Boolean); virtual; // TODO: checkout? update? + procedure SetDateTime(AValue: TDateTime); + procedure SetDateTimeUTC(AValue: TDateTime); + protected + FLoadedStates: TFossilFileStates; + + function GetParentUUID: string; virtual; + function GetParent: TFossilRevision; virtual; + function GetBranch: string; virtual; + function GetFiles: TFossilFileList; virtual; + public + constructor Create(const ACheckout: TFossilCheckout); override; + destructor Destroy; override; + + function LoadFilesFromTimeline(const Timeline: TStrings; var AIndex: Integer; const LeaveExisting: Boolean): Integer; + + property UUID; + property ParentUUID: string read GetParentUUID write FParentUUID; + property Parent: TFossilRevision read GetParent; + property IsCurrent: Boolean read GetCurrent write SetCurrent; + property Files: TFossilFileList read GetFiles; + + property DateTimeUTC: TDateTime read FDateTimeUTC write SetDateTimeUTC; + property DateTimeLocal: TDateTime read FDateTime write SetDateTime; + property Message: string read FMessage write FMessage; + property User: string read FUser write FUser; + property Branch: string read GetBranch write FBranch; + property Tags: TStringList read GetTags; + public + function LoadFiles(const States: TFossilFileStates = ffsPending; const ForceRefresh: Boolean = False): Integer; virtual; + end; + + +type + TCommitFlag = (cfAllowConflict, cfAllowEmpty, cfAllowFork, cfAllowOlder, cfBaselineManifest, + cfDeltaManifest, cfDryRun, cfNoSign, cfNoWarnings, cfPrivate, cfSHA1Sum); + TCommitFlags = set of TCommitFlag; + TCommitOptions = packed record + Message: string; + ContentType: string; + BranchName: string; + BranchColor: TColor; + CloseBranch: Boolean; + Integrate: Boolean; + RevColor: TColor; + Flags: TCommitFlags; + end; + PCommitOptions = ^TCommitOptions; +const + cCommitFlagNames: array[TCommitFlag] of string = ('allow-conflict', 'allow-empty', 'allow-fork', + 'allow-older', 'baseline', 'delta', 'dry-run', + 'nosign', 'no-warnings', 'private', 'sha1sum'); + cDefaultCommitOptions: TCommitOptions = ( + Message: ''; + ContentType: ''; + BranchName: ''; + BranchColor: clNone; + CloseBranch: False; + Integrate: False; + RevColor: clNone; + Flags: [cfNoWarnings] + ); + +type + { TFossilWorkdir } + + TFossilWorkdir = class(TFossilRevision) + protected + function GetInfo: TStringList; override; + function GetParentUUID: string; override; + public + function LoadFiles(const States: TFossilFileStates = ffsPending; const ForceRefresh: Boolean = False): Integer; override; + + function GetCommitOptions(var Options: TCommitOptions): string; + function Commit(const Options: PCommitOptions; const ATags: TStrings = nil; const AFiles: TFossilFileList = nil): string; + + function MoveToStash(AMessage: string = ''; const AFiles: TFossilFileList = nil; const ACopy: Boolean = False): string; + end; + + +type + TDiffWhitespace = (dwsProcess, dwsIgnoreTrailing, dwsIgnoreAll); + TDiffOptions = packed record + External: Boolean; + SideBySide: Boolean; + Width: Integer; + ContextLines: Integer; + Whitespace: TDiffWhitespace; + end; + PDiffOptions = ^TDiffOptions; + +const + cDefaultDiffOptions: TDiffOptions = (External: False; + SideBySide: False; + Width: 0; + ContextLines: -1; + Whitespace: dwsProcess); + +type + + { TFileVersion } + + TFileVersion = class + private + FRevision: TFossilRevision; + FFullName: string; + FStatus: string; + + // Derived data + FName: string; + FPath: string; + FStatuses: TFileStatuses; + + // User data + FSelected: Boolean; + + function GetRealPath: string; + procedure SetFullName(AValue: string); + procedure SetStatus(AValue: string); + protected + function GetDiffInternal(const ToRevision: string; + const FromRevision: string; + var Options: TDiffOptions): string; virtual; + public + constructor Create(const ARevision: TFossilRevision); + destructor Destroy; override; + + function GetContents: TStream; virtual; + function GetDiff(var Options: TDiffOptions; const FromRevision: string = ''): string; virtual; + function GetAnnotated(const IncludeLog: Boolean): string; virtual; + + property Revision: TFossilRevision read FRevision; + property FullName: string read FFullName write SetFullName; + property Filename: string read FName; + property Path: string read FPath; + property Status: string read FStatus write SetStatus; + property Statuses: TFileStatuses read FStatuses; + + property Selected: Boolean read FSelected write FSelected; + + property RealPath: string read GetRealPath; + end; + + { TWorkFile } + + TWorkFile = class(TFileVersion) + private + function GetWorkdir: TFossilWorkdir; + public + function GetContents: TStream; override; + function GetDiff(var Options: TDiffOptions; const FromRevision: string = ''): string; override; + + property Workdir: TFossilWorkdir read GetWorkdir; + end; + +type + EFossilError = class(Exception); + ETimelineError = class(EFossilError); + + +//////////////////////////////////////////////////////////////////////////////// +implementation +uses + StrUtils, Pipes, utf8process, process, LazFileUtils; + + +{ TFossilUtilities } + +constructor TFossilUtilities.Create(const Fossil: TFossil); +begin + FFossil := Fossil; +end; + +function TFossilUtilities.GetDefaultColor(const BranchName: string): TColor; +var + Lines: TStringList; + Line, TagName, HexColor: string; + CharPos: Integer; +begin + // Figure out the branch color for the given branch name + Lines := TStringList.Create; + try + Lines.StrictDelimiter := True; + Lines.Text := FFossil.Run('test-hash-color ' + AnsiQuotedStr(BranchName, '"')); + for Line in Lines do begin + CharPos := Pos(': #', Line); + if CharPos > 0 then begin + TagName := Trim(Copy(Line, 1, CharPos - 1)); + if CompareText(TagName, BranchName) = 0 then begin + HexColor := TrimRight(Copy(Line, CharPos + 3, Length(Line))); + // convert hex color to TColor + Result := Hex2Dec(HexColor[5] + HexColor[6] + HexColor[3] + HexColor[4] + HexColor[1] + HexColor[2]); + Exit; + end; + end; + end; + finally + Lines.Free; + end; + Result := clNone; +end {TFossilUtilities.GetDefaultColor}; + + +{ TFossil } + +constructor TFossil.Create(const AExecutable: TFileName; + const ACurrentDir: TFileName); +begin + FExePath := AExecutable; + if ACurrentDir <> '' then + FCurDir := ACurrentDir + else + FCurDir := GetCurrentDir; + FVersionInfo := Run('version'); +end; + +{ ------------------------------------------------------------------------------------------------ } +function TFossil.Run(const Command: string; const TrimTrailingSpaces: Boolean = True): string; +const + READ_BYTES = 2048; + { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } + {$POINTERMATH ON} + function CacheStream(Input: TInputPipeStream; Cache: TMemoryStream; var BytesRead: LongInt): LongInt; + var + CacheMem: PByte; + begin + if Input.NumBytesAvailable > 0 then begin + // make sure we have room + Cache.SetSize(BytesRead + READ_BYTES); + + // try reading it + CacheMem := Cache.Memory; + Inc(CacheMem, BytesRead); + Result := Input.Read(CacheMem^, READ_BYTES); + if Result > 0 then begin + Inc(BytesRead, Result); + end; + end else begin + Result := 0; + end; + end{CacheStream}; + {$POINTERMATH OFF} + { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } +var + OMS, EMS: TMemoryStream; + S: TStringStream; + P: TProcessUTF8; + n: LongInt; + BytesRead, ErrBytesRead: LongInt; + Msg: string; +begin + // We cannot use poWaitOnExit here since we don't + // know the size of the output. On Linux the size of the + // output pipe is 2 kB. If the output data is more, we + // need to read the data. This isn't possible since we are + // waiting. So we get a deadlock here. + // + // A temp Memorystream is used to buffer the output + + BytesRead := 0; + OMS := TMemoryStream.Create; + ErrBytesRead := 0; + EMS := TMemoryStream.Create; + try + P := TProcessUTF8.Create(nil); + try + P.CurrentDirectory := FCurDir; + P.CommandLine := FExePath + ' ' + Command; + //P.Executable := FExePath; + //P.Parameters.Text := FExePath + ' ' + Command; + P.Options := P.Options + [poUsePipes]; + P.StartupOptions := [suoUseShowWindow]; + P.ShowWindow := swoHIDE; + + P.Execute; + while P.Running do begin + n := CacheStream(P.Output, OMS, BytesRead); + // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, False, OMS, n, P.Input); + Inc(n, CacheStream(P.Stderr, EMS, ErrBytesRead)); + // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, True, EMS, n, P.Input); + if n <= 0 then begin + // no data, wait 100 ms + Sleep(100); + end; + end; + // read last part + repeat + n := CacheStream(P.Output, OMS, BytesRead); + // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, False, OMS, n, P.Input); + Inc(n, CacheStream(P.Stderr, EMS, ErrBytesRead)); + // TODO: if Assigned(OnFossilOutput) then OnFossilOutput(Self, True, EMS, n, P.Input); + until n <= 0; + + OMS.SetSize(BytesRead); + EMS.SetSize(ErrBytesRead); + finally + P.Free; + end; + + S := TStringStream.Create(''); + try + S.CopyFrom(OMS, OMS.Size); + S.Position := 0; + Result := S.DataString; + finally + S.Free; + end; + + // MessageBoxFunction(PChar(FCurDir + '> TFossil.Run(' + Command + ')'), PChar(Result), 64); + + if EMS.Size > 0 then begin + S := TStringStream.Create(''); + try + S.CopyFrom(EMS, EMS.Size); + S.Position := 0; + Msg := S.DataString; + finally + S.Free; + end; + if SameFileName(Copy(Msg, 2, Length(FExePath)), FExePath) then begin + Msg := Copy(Msg, Length(FExePath) + 3, Length(Msg)); + end; + raise EFossilError.Create(Trim(Msg + sLineBreak + sLineBreak + Result)); + end; + finally + OMS.Free; + EMS.Free; + end; + + // Trim all whitespace, including tabs and newlines + if TrimTrailingSpaces then begin + for n := Length(Result) downto 1 do + if not (Result[n] in [' ', #13, #10, #9]) then begin + if n < Length(Result) then + SetLength(Result, n); + Break; + end; + end; +end {TFossil.Run}; + + +{ TFossilCheckout } + +constructor TFossilCheckout.Create(const Fossil: TFossil; Path: TFileName); +begin + inherited Create; + FObjects := TFPObjectList.Create(True); + FRevisions := TFossilRevisionList.Create; + if Assigned(Fossil) then begin + FFossil := Fossil; + FOwnFossil := False; + if Path <> '' then + FFossil.CurrentDir := Path; + end else begin + FFossil := TFossil.Create(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'fossil', Path); + FOwnFossil := True; + end; + FUtilities := TFossilUtilities.Create(FFossil); + + // query Fossil for its root path, so we don't have to worry about absolute and relative paths + FPath := IncludeTrailingPathDelimiter(PathFromFossil(Info.Values['local-root'])); + FFossil.CurrentDir := FPath; + + FWorkdir := TFossilWorkdir.Create(Self); +end; + +destructor TFossilCheckout.Destroy; +begin + if Assigned(FSettings) then + FSettings.Free; + if Assigned(FInfo) then + FInfo.Free; + FWorkdir.Free; + FRevisions.Free; + FObjects.Free; + FUtilities.Free; + if FOwnFossil then + FFossil.Free; + inherited Destroy; +end; + +function TFossilCheckout.PathFromFossil(const Path: TFileName): TFileName; +begin + if DirectorySeparator = '/' then + Result := Path + else + Result := StringReplace(Path, '/', DirectorySeparator, [rfReplaceAll]); +end; + +function TFossilCheckout.FindObjectByUUID(UUID: string; + const ObjectClass: TFossilObjectClass): TFossilObject; +var + i: Integer; +begin + // TODO: implement binary search, to speed this up? + // loop through our list of objects + Result := nil; + i := 0; + while (i < FObjects.Count - 1) do begin + case TFossilObject(FObjects[i]).CompareUUID(UUID) of + 0: begin + Result := TFossilObject(FObjects[i]); + Exit; + end; + 1: begin // that list is sorted; this means we're past where it would be + Break; + end; + end; + Inc(i); + end; + // Coming here means we haven't got it yet; which means we'll have to create it + if ObjectClass = nil then + Exit; + + // First, check if fossil knows that UUID (`fossil info UUID` will give an exception if it doesn't exist) + FFossil.Run('info ' + UUID); + + // TODO: check the object class, and use the appropriate constructor to create it? + Result := ObjectClass.Create(Self); + Result.UUID := UUID; + + // Insert the object to our list, at the expected index + FObjects.Insert(i, Result); +end {TFossilCheckout.FindObjectByUUID}; + +function TFossilCheckout.LoadRevisions(Limit: Integer; Offset: Integer): Integer; +const + DBFS: TFormatSettings = (CurrencyFormat: 0; NegCurrFormat: 0; ThousandSeparator: ','; + DecimalSeparator: '.'; CurrencyDecimals: 4; + DateSeparator: '-'; TimeSeparator: ':'; ListSeparator: ' '; + CurrencyString: '€'; + ShortDateFormat: 'YYYY-MM-dd'; LongDateFormat: 'YYYY-MM-dd'; + TimeAMString: ''; TimePMString: ''; + ShortTimeFormat: 'HH:nn:ss'; LongTimeFormat: 'HH:nn:ss'; + ShortMonthNames: ('','','','','','','','','','','',''); + LongMonthNames: ('','','','','','','','','','','',''); + ShortDayNames: ('','','','','','',''); + LongDayNames: ('','','','','','',''); + TwoDigitYearCenturyWindow: 30); +var + Timeline: TStringList; + i, CharPos: Integer; + Line, Marker: string; + CurDate: TDate; + RevTime: TTime; + RevUUID, Description, User: string; + NewRevision: TFossilRevision; +begin + Result := 0; + + Timeline := TStringList.Create; + try + // TODO: get the limit from a setting (defaulting to 100) + // TODO: take paging offset into account + Timeline.Text := FFossil.Run(Format('timeline --verbose --type ci --width 0 --limit %d --offset %d', [Limit, Offset])); + // --verbose so we get a list of the changed files + // --type ci so we only get the checkins + // -- width 0 so no wrapping occurs, and each revision is located on a single line + // --limit 100 to prevent having to wait for too long + // --offset n for paging + + // Parse the timeline: + // === YYYY-MM-dd === + // HH:mm:ss [UUID] *CURRENT* Description, all on one line. + // >>> >>> >>> this is where AddFilesFromTimeline should start <<< <<< <<< + // STATUS path/filename.pas + // STATUS path/filename.lfm + // --- entry limit (1) reached --- + // OR + // +++ no more data (1) +++ + i := 0; + while i < Timeline.Count do begin + Line := Timeline[i]; + case Line[1] of + '=': begin // New date + CurDate := StrToDate(Copy(Line, 5, 10), DBFS); + Inc(i); + end; + '0'..'2': begin // new time, ergo new revision + RevTime := StrToTime(Copy(Line, 1, 8), DBFS); + Delete(Line, 1, 10); + CharPos := Pos(']', Line); + Assert(CharPos > 0, 'No UUID found in timeline: ' + TimeLine[i]); + RevUUID := Copy(Line, 1, CharPos - 1); + Delete(Line, 1, CharPos + 1); + NewRevision := TFossilRevision(FindObjectByUUID(RevUUID, TFossilRevision)); + Inc(Result); + NewRevision.DateTimeUTC := Trunc(CurDate) + Frac(RevTime); + if Line[1] = '*' then begin + CharPos := PosEx('*', Line, 2); + Marker := Copy(Line, 2, CharPos - 2); + if Marker = 'CURRENT' then begin + Self.CurrentRevision := NewRevision; + end; // TODO: also remember other markers (like BRANCH and MERGE) + Delete(Line, 1, CharPos); + end; + + // TODO: extract user, branch?, and tags from the description line? + CharPos := LastDelimiter('(', Line); + // TODO: read user, branch (first tag) and other tags + Line := Copy(Line, 1, CharPos - 1).Trim(); + + NewRevision.Message := Line; + + // TODO: Check that it's not already present? + if Revisions.IndexOf(NewRevision) < 0 then + Revisions.Add(NewRevision); + + Inc(i); + NewRevision.LoadFilesFromTimeline(Timeline, i, NewRevision.Files.Count = 0); + end; + '-': begin // Limit reached; there may be more data available + // TODO + Break; + end; + '+': begin // End reached; no more data. + // TODO + Break; + end; + else begin + raise ETimelineError.CreateFmt('Error retrieving timeline: expected [=012-+], encountered "%s" of "%s"', [Line[1], Line]); + end; + end; + end; + finally + Timeline.Free; + end; + + // TODO: keep track of which section we've loaded (first, last) +end {TFossilCheckout.LoadRevisions}; + +function TFossilCheckout.GetInfo: TStringList; +var + i: Integer; +begin + if not Assigned(FInfo) then begin + FInfo := TStringList.Create; + FInfo.NameValueSeparator := ':'; + FInfo.Text := FFossil.Run('info'); + + // TODO: correctly process wrapped lines! + + for i := FInfo.Count - 1 downto 0 do begin + FInfo[i] := TrimRight(FInfo.Names[i]) + + FInfo.NameValueSeparator + + TrimLeft(FInfo.ValueFromIndex[i]); + end; + end; + Result := FInfo; +end; + +function TFossilCheckout.GetRevisions: TFossilRevisionList; +begin + if not Assigned(FRevisions) then begin + FRevisions := TFossilRevisionList.Create; + end; + Result := FRevisions; +end; + +function TFossilCheckout.GetSettings: TStringList; +var + Lines: TStringList; + Line, Name, Scope, Value: string; + i, CharPos: Integer; + iScope: NativeInt; + Index: Integer = -1; +begin + if not Assigned(FSettings) then begin + FSettings := TStringList.Create; + FSettings.CaseSensitive := True; + + Lines := TStringList.Create; + try + Lines.Text := FFossil.Run('settings'); + + // <setting-name> (local|global) <value> + // (overridden by contents of file .fossil-settings/<setting-name>) + + // Objects value: 0 = no value; 1 = global, 2 = local, 4 = file (so 5 = global overridden by file, 6 = local overridden by file) + for i := 0 to Lines.Count - 1 do begin + Line := TrimRight(Lines[i]); + if Length(Line) = 0 then + Continue; + if (Line[1] = ' ') then begin + if Index > -1 then + FSettings.Objects[Index] := TObject(4 or NativeInt(FSettings.Objects[Index])); + Continue; + end; + CharPos := Pos(' ', Line); + if CharPos = 0 then begin + Name := Line; + Scope := ''; + Value := ''; + end else begin + Name := Copy(Line, 1, CharPos - 1); + Line := TrimLeft(Copy(Line, CharPos + 1, Length(Line))); + CharPos := Pos(' ', Line); + if CharPos > 0 then begin + Scope := Copy(Line, 1, CharPos - 1); + Value := TrimLeft(Copy(Line, CharPos + 1, Length(Line))); + end else begin + Scope := Line; + Value := ''; + end; + FSettings.Values[Name] := Value; + Index := FSettings.IndexOfName(Name); + Assert((Scope = '') or (Scope = '(global)') or (Scope = '(local)'), 'Unexpected scope: "' + Scope + '"'); + if Scope = '' then + iScope := 0 + else if Scope = '(global)' then + iScope := 1 + else if Scope = '(local)' then + iScope := 2 + else + iScope := -1; + FSettings.Objects[Index] := TObject(iScope); + end; + end; + finally + Lines.Free; + end; + end; + Result := FSettings; +end; + +function TFossilCheckout.GetCaseSensitive: Boolean; +begin + Result := StrToBoolDef(Settings.Values['case-sensitive'], FileNameCaseSensitive); +end; + +function TFossilCheckout.GetCurrentRevision: TFossilRevision; +begin + Result := FCurrentRev; +end; + +procedure TFossilCheckout.SetCurrentRevision(AValue: TFossilRevision); +begin + FCurrentRev := AValue; +end; + + + +{ TFossilObject } + +constructor TFossilObject.Create(const ACheckout: TFossilCheckout); +begin + inherited Create; + FCheckout := ACheckout; +end; + +destructor TFossilObject.Destroy; +begin + if Assigned(FInfo) then + FInfo.Free; + inherited Destroy; +end; + +function TFossilObject.GetInfo: TStringList; +var + i: Integer; +begin + if not Assigned(FInfo) then begin + Assert(UUID <> '', 'No UUID known for this object!'); + FInfo := TStringList.Create; + FInfo.NameValueSeparator := ':'; + FInfo.Text := FCheckout.Exe.Run('info ' + UUID); + + // TODO: wrapped lines! + + for i := FInfo.Count - 1 downto 0 do begin + FInfo[i] := TrimRight(FInfo.Names[i]) + + FInfo.NameValueSeparator + + TrimLeft(FInfo.ValueFromIndex[i]); + end; + end; + Result := FInfo; +end; + +function TFossilObject.CompareUUID(const OtherUUID: string): Integer; +var count, count1, count2: integer; +begin + result := 0; + Count1 := Length(FUUID); + Count2 := Length(OtherUUID); + if Count1 > Count2 then + Count := Count2 + else + Count := Count1; + result := CompareMemRange(Pointer(FUUID), Pointer(OtherUUID), Count); +end; + + +{ TFossilRevision } + +constructor TFossilRevision.Create(const ACheckout: TFossilCheckout); +begin + inherited Create(ACheckout); + FTags := TStringList.Create; +end; + +destructor TFossilRevision.Destroy; +begin + if Assigned(FFiles) then + FFiles.Free; + FTags.Free; + inherited Destroy; +end; + +function TFossilRevision.GetParentUUID: string; +var + CharPos: Integer; +begin + if FParentUUID = '' then begin + FParentUUID := Info.Values['parent']; + CharPos := Pos(' ', FParentUUID); + if CharPos > 0 then + FParentUUID := Copy(FParentUUID, 1, CharPos - 1); + end; + Result := FParentUUID; +end; + +function TFossilRevision.GetParent: TFossilRevision; +var + FO: TFossilObject; +begin + FO := Checkout.FindObjectByUUID(ParentUUID, TFossilRevision); + Assert(not Assigned(FO) or (FO is TFossilRevision)); + Result := TFossilRevision(FO); +end; + +function TFossilRevision.GetFiles: TFossilFileList; +begin + if not Assigned(FFiles) then begin + FFiles := TFossilFileList.Create; + end; + Result := FFiles; +end; + +function TFossilRevision.GetCurrent: Boolean; +begin + Result := (FCheckout.CurrentRevision = Self); +end; + +function TFossilRevision.GetTags: TStringList; +begin + if not Assigned(FTags) then begin + FTags := TStringList.Create; + end; + if FTags.Count = 0 then begin + FTags.Delimiter := ','; + FTags.DelimitedText := Info.Values['tags']; + end; + Result := FTags; +end; + +function TFossilRevision.GetBranch: string; +begin + Result := Trim(Tags[0]); +end; + +procedure TFossilRevision.SetCurrent(AValue: Boolean); +begin + if AValue then + FCheckout.CurrentRevision := Self + else if IsCurrent then + FCheckout.CurrentRevision := nil; +end; + +procedure TFossilRevision.SetDateTime(AValue: TDateTime); +begin + if FDateTime = AValue then Exit; + FDateTime := AValue; + // TODO: calculate FDateTimeUTC +end; + +procedure TFossilRevision.SetDateTimeUTC(AValue: TDateTime); +begin + if FDateTimeUTC = AValue then Exit; + FDateTimeUTC := AValue; + // TODO: calculate FDateTime (local) +end; + +function TFossilRevision.LoadFilesFromTimeline(const Timeline: TStrings; var AIndex: Integer; const LeaveExisting: Boolean): Integer; +var + Line: string; + OldFile, NewFile: TFileVersion; + i, CharPos: Integer; + Existing: TStringList; + bReused: Boolean; +begin + Result := 0; + + // Parse the timeline: + // === YYYY-MM-dd === + // HH:mm:ss [UUID] Message, all on one line. + // >>> >>> >>> this is where LoadFilesFromTimeline should start <<< <<< <<< + // STATUS path/filename.pas + // STATUS path/filename.lfm + // --- entry limit (1) reached --- + // OR + // +++ <no more data (1)> +++ + + Existing := nil; + try + if LeaveExisting then begin + // Copy the files over to a sorted TStringList (for faster lookup), and move them back + // over when found. We can then free any remaining files in the TStringList. + Existing := TStringList.Create; + Existing.CaseSensitive := Checkout.CaseSensitive; + for i := Files.Count - 1 downto 0 do begin + OldFile := Files[i]; + // Extract it; delete would (probably?) Free it + Existing.AddObject(OldFile.FullName, Files.Extract(OldFile)); + end; + Existing.Sorted := True; + end; + while AIndex < Timeline.Count do begin + Line := Timeline[AIndex]; + case Line[1] of + '=': begin // new date; === <YYYY-MM-DD> === + Break; + end; + '0'..'2': begin // new revision; <HH:mm:ss> [<UUID>] <Message> + Break; + end; + ' ': begin // STATUS <filename> + bReused := False; + NewFile := TFileVersion.Create(Self); + try + Line := TrimLeft(Line); + CharPos := Pos(' ', Line); + if CharPos > 0 then begin + NewFile.Status := Copy(Line, 1, CharPos - 1); + NewFile.FullName := Trim(Copy(Line, CharPos + 1, Length(Line))); + end else begin + raise ETimelineError.CreateFmt('Unexpected data while parsing timeline. Expected: STATUS FILENAME; received: "%s"', [Timeline[0]]); + end; + except + NewFile.Free; + raise; + end; + if LeaveExisting then begin + i := Existing.IndexOf(NewFile.FullName); + if i > -1 then begin + OldFile := TFileVersion(Existing.Objects[i]); + OldFile.Status := NewFile.Status; + if not Existing.CaseSensitive then + OldFile.FullName := NewFile.FullName; + Existing.Delete(i); + // TODO: can we notify the file (or rather, its users) that it's about to be freed? + NewFile.Free; + NewFile := OldFile; + bReused := True; + end; + end; + + if not bReused then + NewFile.Selected := (NewFile.Statuses * (fsChanged + [fsUntracked])) <> []; + + Files.Add(NewFile); + Inc(Result); + end; + '-': begin // --- entry limit (<n>) reached ---; there may be more! + Break; + end; + '+': begin // +++ done +++ + Break; + end; + end; + + // 'Eat' the line we just read, and carry on + Inc(AIndex); + end; + + if LeaveExisting then begin + // Free any remaining old files + for i := Existing.Count - 1 downto 0 do begin + // TODO: notify the file('s users) of its imminent freedom? + Existing.Objects[i].Free; + end; + end; + + finally + Existing.Free; + end; +end {TFossilRevision.LoadFilesFromTimeline}; + +function TFossilRevision.LoadFiles(const States: TFossilFileStates; const ForceRefresh: Boolean): Integer; +var + Timeline: TStringList; + Index: Integer; +begin + Timeline := TStringList.Create; + try + Timeline.Text := FCheckout.Exe.Run('timeline ' + UUID + ' --limit 1 --width 0 --verbose'); + // --limit 1 only retrieve this revision's info + // --width 0 so the commit message only takes up a single line + // --verbose so we also get the list of changed files in this revision + + // Skip the header of the timeline, which describes the revision + Index := 2; + Result := LoadFilesFromTimeline(Timeline, Index, ForceRefresh or True); + finally + Timeline.Free; + end; + + FLoadedStates := States * [ffsChanged, ffsUnchanged]; +end {TFossilRevision.LoadFiles}; + + +{ TFossilWorkdir } + +function TFossilWorkdir.GetInfo: TStringList; +var + i: Integer; +begin + if not Assigned(FInfo) then begin + FInfo := TStringList.Create; + FInfo.NameValueSeparator := ':'; + FInfo.Text := FCheckout.Exe.Run('info'); + + // TODO: correctly process wrapped lines! + + // Remove extraneous spaces + for i := FInfo.Count - 1 downto 0 do begin + FInfo[i] := TrimRight(FInfo.Names[i]) + + FInfo.NameValueSeparator + + TrimLeft(FInfo.ValueFromIndex[i]); + end; + end; + Result := FInfo; +end; + +function TFossilWorkdir.GetParentUUID: string; +var + CharPos: Integer; +begin + if FParentUUID = '' then begin + FParentUUID := Checkout.Info.Values['checkout']; + CharPos := Pos(' ', FParentUUID); + if CharPos > 0 then + FParentUUID := Copy(FParentUUID, 1, CharPos - 1); + end; + Result := FParentUUID; +end; + +function TFossilWorkdir.LoadFiles(const States: TFossilFileStates; const ForceRefresh: Boolean): Integer; +var + NewStates: TFossilFileStates; + OldFile, NewFile: TWorkFile; + Existing, List, Extras, Ignored: TStringList; + Line: string; + i, CharPos: Integer; + { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } + procedure CheckOldFile(var NewFile: TWorkFile); + var + Index: Integer; + begin + Index := Existing.IndexOf(NewFile.FullName); + if Index > -1 then begin + OldFile := TWorkFile(Existing.Objects[Index]); + OldFile.Status := NewFile.Status; + if not Existing.CaseSensitive then + OldFile.FullName := NewFile.FullName; + Existing.Delete(Index); + // TODO: can we notify the file (or rather, its users) that it's about to be freed? + NewFile.Free; + NewFile := OldFile; + end else begin + NewFile.Selected := (NewFile.Statuses * (fsChanged + [fsUntracked])) <> []; + end; + end; + { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } +begin + Result := 0; + If ForceRefresh then begin + NewStates := States; + end else begin + NewStates := States - FLoadedStates; // don't re-request known files if we already know them + end; + + // Keep a list of all old files and their objects + Existing := TStringList.Create; + try + Existing.CaseSensitive := Checkout.CaseSensitive; + for i := Files.Count - 1 downto 0 do begin + OldFile := TWorkFile(Files[i]); + // Extract it; delete would (probably?) Free it + Existing.AddObject(OldFile.FullName, Files.Extract(OldFile)); + end; + Existing.Sorted := True; + + + // Depending on the requested states, either do + // fossil changes (CHANGED) + // fossil ls --verbose (CHANGED + UNCHANGED) + // fossil extras [--dotfiles] (EXTRA) + // fossil extras --ignore "" (EXTRA + IGNORED) + + List := nil; + if ffsUnchanged in NewStates then begin + Include(NewStates, ffsChanged); + + List := TStringList.Create; + List.Text := FCheckout.Exe.Run('ls --verbose'); + + end else if ffsChanged in NewStates then begin + + List := TStringList.Create; + List.Text := FCheckout.Exe.Run('changes'); + + end; + if Assigned(List) then + try + for i := 0 to List.Count - 1 do begin + Line := List[i]; + CharPos := Pos(' ', Line); + Assert(CharPos > 0, 'Expected space in list of versioned files: "' + Line + '"'); + NewFile := TWorkFile.Create(Self); + NewFile.Status := UpperCase(Copy(Line, 1, CharPos - 1)); + NewFile.FullName := TrimLeft(Copy(Line, CharPos + 1, Length(Line))); + CheckOldFile(NewFile); + Files.Add(NewFile); + Inc(Result); + end; + finally + List.Free; + end; + + if ([ffsExtra, ffsIgnored] * NewStates) <> [] then begin + Extras := TStringList.Create; + Ignored := nil; + try + Extras.CaseSensitive := Checkout.CaseSensitive; + Extras.Sorted := False; + + if ffsIgnored in NewStates then begin + Include(NewStates, ffsExtra); + Ignored := TStringList.Create; + Ignored.Text := FCheckout.Exe.Run('extras --dotfiles --ignore ""'); + end; + + Extras.Text := FCheckout.Exe.Run('extras'); + Extras.Sorted := True; // speeds up lookups later on + + if ffsIgnored in NewStates then begin + // all files present in Ignored but not in Extras are, indeed, ignored. + for i := 0 to Ignored.Count - 1 do begin + NewFile := TWorkFile.Create(Self); + NewFile.FullName := Ignored[i]; + if Extras.IndexOf(Ignored[i]) = -1 then + NewFile.Status := 'IGNORED' + else + NewFile.Status := 'EXTRA'; + CheckOldFile(NewFile); + Files.Add(NewFile); + Inc(Result); + end; + end else begin + // all files present in Extras are ...extra. + for i := 0 to Extras.Count - 1 do begin + NewFile := TWorkFile.Create(Self); + NewFile.FullName := Extras[i]; + NewFile.Status := 'EXTRA'; + CheckOldFile(NewFile); + Files.Add(NewFile); + Inc(Result); + end; + end; + finally + Extras.Free; + Ignored.Free; + end; + end; + + // Free any remaining old files + for i := Existing.Count - 1 downto 0 do begin + OldFile := TWorkFile(Existing.Objects[i]); + // TODO: if its status matches FLoadedStates but not NewStates, + // then we shouldn't free it, but add it to the list. +// if not ForceRefresh {and ...} then begin +// Files.Add(OldFile); +// end else begin + // TODO: notify the file('s users) of its imminent freedom? + OldFile.Free; +// end; + end; + finally + Existing.Free; + end; + + // keep track of the requested states, so we know to only request what's new when ForceRefresh = False + if ForceRefresh then + FLoadedStates := NewStates + else + FLoadedStates := FLoadedStates + NewStates; +end; + +function ColorToHex(const Color: TColor): string; +var + R, G, B: Byte; +begin + // return HTML hex-notation of Color (HTML has the colors in the inverse direction of Pascal) + RedGreenBlue(Color, R, G, B); + Result := '#' + HexStr(RGBToColor(G, B, R), 6); +end; + +function TFossilWorkdir.GetCommitOptions(var Options: TCommitOptions): string; +var + Flag: TCommitFlag; +begin + Result := ''; + + if Options.ContentType <> '' then + Result += ' --mimetype ' + Options.ContentType; + + if Options.BranchName <> '' then begin + Result += ' --branch ' + Options.BranchName; + if Options.BranchColor <> clNone then begin + Result += ' --branchcolor ' + ColorToHex(Options.BranchColor); + end; + end; + if Options.Integrate then begin + Result += ' --integrate'; + end else if Options.CloseBranch then begin + Result += ' --close'; + end; + + if Options.RevColor <> clNone then begin + Result += ' --bgcolor ' + ColorToHex(Options.RevColor); + end; + + for Flag := Low(TCommitFlag) to High(TCommitFlag) do begin + if Flag in Options.Flags then begin + Result += ' --' + cCommitFlagNames[Flag]; + end; + end; +end {TFossilWorkdir.GetCommitOptions}; + +function TFossilWorkdir.Commit(const Options: PCommitOptions; + const ATags: TStrings = nil; const AFiles: TFossilFileList = nil): string; +var + Cmd: string; + MsgFile: TFileName; + SS: TStringStream; + FS: TFileStream; + i: Integer; +begin + Cmd := 'commit'; + + // save the commit message to a temp file, and refer to that + MsgFile := GetTempFilenameUTF8(GetTempDir, 'msg'); + SS := TStringStream.Create(Options^.Message); + try + FS := TFileStream.Create(MsgFile, fmCreate or fmOpenWrite or fmShareDenyWrite); + try + FS.CopyFrom(SS, 0); + finally + FS.Free; + end; + finally + SS.Free; + end; + try + Cmd += ' --message-file ' + AnsiQuotedStr(MsgFile, '"'); + + Cmd += GetCommitOptions(Options^); + + if Assigned(ATags) and (ATags.Count > 0) then begin + for i := 0 to ATags.Count - 1 do begin + Cmd += ' --tag ' + AnsiQuotedStr(ATags[i], '"'); + end; + end; + + // Only for the given files (if requested) + if Assigned(AFiles) and (AFiles.Count > 0) then begin + for i := 0 to AFiles.Count - 1 do begin + Cmd += ' ' + AnsiQuotedStr(AFiles[i].FullName, '"'); + end; + end; + + // TODO: how do we handle Fossil asking questions? TFossil.Exec: TProcess! + try + Result := Checkout.Exe.Run(Cmd); + except + on E: EFossilError do begin + if E.Message.StartsWith('Warning:', True) then + Result := E.Message + else + raise; + end; + end; + finally + DeleteFile(MsgFile); + end; + + // TODO: clear/invalidate ParentUUID, files etc. + FParentUUID := ''; + // TODO: notify listeners that we've committed, and they might want to refresh! + +end {TFossilWorkdir.Commit}; + +function TFossilWorkdir.MoveToStash(AMessage: string; const AFiles: TFossilFileList; + const ACopy: Boolean): string; +var + Cmd: string; + oFile: TFileVersion; +begin + Cmd := 'stash '; + if ACopy then + Cmd += 'snapshot ' + else + Cmd += 'save '; + + Cmd += '--message ' + AnsiQuotedStr(ReplaceStr(AMessage, LineEnding, ' '), '"'); + + if Assigned(AFiles) then begin + for oFile in AFiles do begin + if oFile.Selected then begin + Cmd += ' ' + AnsiQuotedStr(oFile.FullName, '"'); + end; + end; + end; + + Result := Checkout.Exe.Run(Cmd); +end {TFossilWorkdir.MoveToStash}; + + +{ TFileVersion } + +constructor TFileVersion.Create(const ARevision: TFossilRevision); +begin + FRevision := ARevision; +end; + +destructor TFileVersion.Destroy; +begin + inherited Destroy; +end; + +procedure TFileVersion.SetFullName(AValue: string); +begin + FFullName := AValue; + FName := ExtractFileName(AValue); + FPath := ExtractFilePath(AValue); +end; + +function TFileVersion.GetRealPath: string; +var + Checkout: TFossilCheckout; +begin + Checkout := FRevision.Checkout; + Result := IncludeTrailingPathDelimiter(Checkout.Path) + Checkout.PathFromFossil(FFullName); +end; + +procedure TFileVersion.SetStatus(AValue: string); +const + // from src/checkin.c # 328, fossil checkout [d7d265502a660e1dc5ef41fbe6978f32f507a00e] of 2014-07-24 21:27:08 UTC + // http://fossil-scm.org/fossil/artifact/86d2e5cd9f361c988d9c01a8dfc9d12466d15587?ln=328-354 + cStatusNames: array[0..13] of string = ('ADDED', + 'DELETED', + 'NOT_A_FILE', + 'MISSING', + 'UPDATED_BY_MERGE', + 'ADDED_BY_MERGE', + 'UPDATED_BY_INTEGRATE', + 'ADDED_BY_INTEGRATE', + 'CONFLICT', + 'EDITED', + 'RENAMED', + 'UNCHANGED', + 'EXTRA', + 'IGNORED'); + cStatuses: array[0..13] of TFileStatuses = ( [fsAdded], + [fsDeleted], + [], + [fsMissing], + [fsModified, fsMerged], + [fsAdded, fsMerged], + [fsModified, fsMerged], + [fsAdded, fsMerged], + [fsConflict], + [fsModified], + [fsModified], // fsRenamed + [fsUnchanged], + [fsUntracked], + [fsUntracked, fsIgnored]); +var + i: Integer; +begin + if FStatus = AValue then Exit; + FStatus := UpperCase(AValue); + + for i := Low(cStatusNames) to High(cStatusNames) do begin + if FStatus = cStatusNames[i] then begin + FStatuses := cStatuses[i]; + Exit; + end; + end; + FStatuses := []; +end; + +function TFileVersion.GetContents: TStream; +var + Cmd: string; +begin + Cmd := 'fossil cat '+ AnsiQuotedStr(FFullName, '"') +' -r '+ Revision.UUID; + Result := TStringStream.Create(Revision.Checkout.Exe.Run(Cmd)); +end; + +function TFileVersion.GetDiffInternal(const ToRevision: string; + const FromRevision: string; var Options: TDiffOptions): string; +var + Cmd: string; +begin + // fossil diff <--internal|--tk> --verbose --to '+Revision.UUID+' [--from '+FromUUID+'] [--side-by-side --width <n>] + // [--context <n>] [--ignore-all-space] [--ignore-trailing-space] ?FILE1? ?FILE2? + + Cmd := 'diff --verbose'; + if Options.External then + Cmd += ' --tk' + else + Cmd += ' --internal'; + if ToRevision <> '' then + Cmd += ' --to ' + ToRevision; + if FromRevision <> '' then + Cmd += ' --from ' + FromRevision; + if Options.SideBySide then begin + Cmd += ' --side-by-side'; + if Options.Width > 0 then + Cmd += ' --width ' + IntToStr(Options.Width); + end; + if Options.ContextLines > -1 then + Cmd += ' --context ' + IntToStr(Options.ContextLines); + case Options.Whitespace of + dwsIgnoreTrailing: + Cmd += ' --ignore-trailing-space'; + dwsIgnoreAll: + Cmd += ' --ignore-all-space'; + end; + Cmd += ' ' + AnsiQuotedStr(FullName, '"'); + + Result := Revision.Checkout.Exe.Run(Cmd); + {$IFDEF MSWINDOWS} + Result := StringReplace(Result, #13#13#10, #13#10, [rfReplaceAll]); + {$ENDIF} +end {TFileVersion.GetDiffInternal}; + +function TFileVersion.GetDiff(var Options: TDiffOptions; const FromRevision: string): string; +begin + Result := GetDiffInternal(Revision.UUID, FromRevision, {var}Options); +end; + +function TFileVersion.GetAnnotated(const IncludeLog: Boolean): string; +var + Cmd: string; +begin + Cmd := 'praise --ignore-all-space '; + if IncludeLog then + Cmd += '--log '; + Result := Revision.Checkout.Exe.Run(Cmd + AnsiQuotedStr(FullName, '"')); +end; + + +{ TWorkFile } + +function TWorkFile.GetWorkdir: TFossilWorkdir; +begin + if Revision is TFossilWorkdir then + Result := TFossilWorkdir(Revision) + else + Result := nil; +end; + +function TWorkFile.GetContents: TStream; +var + sFile: TFileName; +begin + sFile := IncludeTrailingPathDelimiter(Revision.Checkout.Path) + Revision.Checkout.PathFromFossil(FullName); + Result := TFileStream.Create(sFile, fmOpenRead or fmShareDenyNone); +end; + +function TWorkFile.GetDiff(var Options: TDiffOptions; const FromRevision: string): string; +begin + // from fossil help diff: + // If there is no "--to" option then the (possibly edited) files in the current check-out are used. + Result := GetDiffInternal('', FromRevision, Options); +end; + + + +end. +