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 @@'
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ '- '
+ '+ '
+ ' '
+ ' '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ '- '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ ' '
+ '- '
+ '+ '
+ ' '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ '+ '
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ '@@ -76,16 +164,16 @@'
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ '- '
+ '+ '
+ ' '
+ ' '
+ ' '
+ ' '
+ '- '
+ '+ '
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ )
+ 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 = '