refonte du code, creation des fichiers manquants, avertissement à l'import

.gitignore

@@ -1,6 +1,15 @@
 *.komodoproject
 test\
+errors\*
 *.accdb
 *.laccdb
 *.accda
-*.old
+*.old
+
+#[ automatically added by VCS
+*.mdb
+*.ldb
+*.accde
+*.mde
+#]
+

source/forms/frm_vcs.bas

@@ -23,10 +23,10 @@ Begin Form
     Width =8163
     DatasheetFontHeight =11
     ItemSuffix =20
-    Left =3225
-    Top =2415
-    Right =20235
-    Bottom =10335
+    Left =-15975
+    Top =-1425
+    Right =-255
+    Bottom =10920
     DatasheetGridlinesColor =14806254
     RecSrcDt = Begin
         0x97e87bbff3d2e440
@@ -237,7 +237,7 @@ Begin Form
                     Overlaps =1
                 End
                 Begin Label
-                    OverlapFlags =93
+                    OverlapFlags =85
                     TextFontFamily =49
                     Left =165
                     Top =1185
@@ -303,72 +303,6 @@ Begin Form
                     ForeTint =100.0
                     ForeShade =50.0
                 End
-                Begin CommandButton
-                    OverlapFlags =87
-                    Left =170
-                    Top =1927
-                    Width =340
-                    Height =340
-                    TabIndex =3
-                    ForeColor =4210752
-                    Name ="cmd_config"
-                    OnClick ="[Event Procedure]"
-                    GridlineColor =10921638
-                    ImageData = Begin
-                        0x2800000010000000100000000100200000000000000000000000000000000000 ,
-                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
-                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
-                        0x0000000000000000c0a090ff604830ff604830ff604830ff604830ff604830ff ,
-                        0x604830ff604830ff604830ff604830ff604830ff604830ff0000000000000000 ,
-                        0x0000000000000000c0a890fffff8f0fffff0e0fff0e8e0fff0e0d0fff0d0c0ff ,
-                        0xf0c8b0ffe0c0a0ffe0b8a0ffe0b090ffe0a890ff604830ff0000000000000000 ,
-                        0x0000000000000000c0a8a0fffffff0ffc0a8a0ffb0a0a0fff0e8e0ffb0a090ff ,
-                        0xb09890ffb09890ffb09890ffb09890ffe0b090ff604830ff0000000000000000 ,
-                        0x0000000000000000c0a8a0fffffff0fffffff0fffff8f0fffff0e0fff0e8e0ff ,
-                        0xf0e0d0fff0d0c0fff0c8b0ffe0c0a0ffe0b8a0ff604830ff0000000000000000 ,
-                        0x0000000000000000c0a8a0fffffff0ffb0a8a0ffb0a0a0fffff8f0ffb0a090ff ,
-                        0xb09890ffb09890ffb09890ffb09890ffe0c0a0ff604830ff0000000000000000 ,
-                        0x0000000000000000c0b0a0fffffff0fffffff0fffffff0fffffff0fffff8f0ff ,
-                        0xfff0e0fff0e8e0fff0e0d0fff0d0c0fff0c8b0ff604830ff0000000000000000 ,
-                        0x0000000000000000c0b0a0fffffff0fffffff0fffffff0fffffff0fffffff0ff ,
-                        0xfff8f0ffc0c8c0ff406070fff0e0d0fff0d0c0ff604830ff0000000000000000 ,
-                        0x0000000040784010c0b0a0ffffffffffe0e8f0ff607880ffe0e0e0fffffff0ff ,
-                        0xc0c8d0ff506070ff30a8d0ff203840ffb0a0a0ff604830ff0000000000000000 ,
-                        0x40784070408050ffd0b0a0ffffffffff90a8b0ff80d0e0ff506070ffb0b8c0ff ,
-                        0x506070ff60c0e0ff506070ff30b8f0ff102830ff103040ff102830ff10203090 ,
-                        0x407840ff50a860ffd0b8a0ffffffffffd0d8e0ff90a8b0ff80e0f0ff506070ff ,
-                        0x80d0e0ff506070ff60d0f0ff406070ff30b0e0ff2098d0ff2088b0ff205070ff ,
-                        0x508860ff50b060ffd0b8a0ffd0b8a0ffd0b8a0ffb0b0a0ff90a8b0ff80e0f0ff ,
-                        0x506070ff80e0f0ff405870ff60d0f0ff50c8f0ff40c0f0ff20b0e0ff20a0d0ff ,
-                        0x609870ff50b870ff00000000000000000000000090a8b0ff2080a0ff90a8b0ff ,
-                        0x80e0f0ff405870ff80e0f0ff70d8f0ff60d0f0ff50c8f0ff40c0f0ff30b8f0ff ,
-                        0x70a880ff60c080ff00000000000000000000000090a8b09090a8b0ff2080a0ff ,
-                        0x90a8b0ff80e0f0ff80e0f0ff80e0f0ff70d8f0ff60d0f0ff60b0d0ff808890ff ,
-                        0xb0c0a0ff90d0a0ff000000000000000000000000000000000000000090a8b050 ,
-                        0x90a8b0b090a8b0ff90a0b0ff90a0a0ff8098a0ff8090a0ff808890ff80889080 ,
-                        0xa0b8a0ffb0c0a0ff000000000000000000000000000000000000000000000000 ,
-                        0x0000000000000000000000000000000000000000000000000000000000000000 ,
-                        0x0000000000000000
-                    End
-
-                    LayoutCachedLeft =170
-                    LayoutCachedTop =1927
-                    LayoutCachedWidth =510
-                    LayoutCachedHeight =2267
-                    UseTheme =0
-                    Gradient =0
-                    BackColor =14136213
-                    BorderColor =14136213
-                    HoverColor =15060409
-                    PressedColor =9592887
-                    HoverForeColor =4210752
-                    PressedForeColor =4210752
-                    WebImagePaddingLeft =2
-                    WebImagePaddingTop =2
-                    WebImagePaddingRight =1
-                    WebImagePaddingBottom =1
-                    Overlaps =1
-                End
             End
         End
     End
@@ -388,28 +322,6 @@ Private Sub cb_command_Change()
 
 End Sub
 
-Private Sub cmd_config_Click()
-
-    If Not vcs_tbl_exists Then
-        If Not MsgBox("The configuration table 'ztbl_vcs' does not exist, " & _
-                        "do you want to create it?", vbYesNo) = vbNo Then
-            Exit Sub
-        End If
-
-        DoCmd.SetWarnings False
-        DoCmd.RunSQL "SELECT  INTO [ztbl_vcs] FROM [modele - ztbl_vcs];"
-        DoCmd.SetWarnings True
-    Else
-    
-        MsgBox "'ztl_vcs' already exists"
-    End If
-
-    'DoCmd.OpenForm "frm_config"
-
-End Sub
-
-
-
 Private Sub cmd_run_Click()
 
     Call run
@@ -437,12 +349,36 @@ Sub update()
 End Sub
 
 Sub run()
+    Dim result As Variant
 
     If Not Me.txt_args.Enabled Then
-        Application.run Me.cb_command.Column(1)
+        result = Application.run(Me.cb_command.Column(1))
     Else
-        Application.run Me.cb_command.Column(1), Nz(Me.txt_args, "")
+        result = Application.run(Me.cb_command.Column(1), Nz(Me.txt_args, ""))
     End If
-    MsgBox "Done"
+    
+    Call display_status(result)
+End Sub
 
+Private Sub display_status(result As Variant)
+    On Error GoTo err
+    Dim msg As String
+    msg = "Operation ended with status: " & vbNewLine
+    
+    Select Case CInt(result)
+        Case opCompleted
+            msg = msg & "> Done"
+        Case opInterrupted
+            msg = msg & "> Interrupted"
+        Case opCancelled
+            msg = msg & "> Cancelled"
+        Case Else
+            GoTo err
+    End Select
+    
+    MsgBox msg, vbInformation, "VCS"
+    
+    Exit Sub
+err:
+    MsgBox msg & "> (unable to read the returned status)", vbExclamation, "VCS"
 End Sub

source/modules/VCS_Git.bas

@@ -0,0 +1,66 @@
+Option Compare Database
+
+Public Function is_git_repo() As Boolean
+' returns True if current app dir is a git repository
+    is_git_repo = (dir(CurrentProject.Path & "\.git\", vbDirectory) <> "")
+    
+End Function
+
+Public Function gitcmd(args)
+' run a git command on windows (eg: `gitcmd("add *")` )
+
+    Call cmd("echo -- " & args & " -- & git " & args & "& pause", vbNormalFocus)
+
+End Function
+
+Public Function complete_gitignore()
+' creates or complete the .gitignore file of the repo
+
+    Dim gitignore_path, str_existing_keys, str As String
+    
+    Dim keys() As String
+    keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
+    
+    gitignore_path = CurrentProject.Path & "\.gitignore"
+    
+    Dim fso As Object
+    Set fso = CreateObject("Scripting.FileSystemObject")
+    
+    Dim oFile As Object
+    If Not fso.FileExists(gitignore_path) Then
+        Set oFile = fso.CreateTextFile(gitignore_path)
+    Else
+        Set oFile = fso.OpenTextFile(gitignore_path, ForReading)
+        str_existing_keys = ""
+        
+        While Not oFile.AtEndOfStream
+            str = oFile.readline
+            If Len(str_existing_keys) = 0 Then
+                str_existing_keys = str
+            Else
+                str_existing_keys = str_existing_keys & ";" & str
+            End If
+        Wend
+        oFile.Close
+        
+        Dim existing_keys() As String
+        existing_keys = Split(str_existing_keys, ";")
+        
+        Set oFile = fso.OpenTextFile(gitignore_path, ForAppending)
+    End If
+    
+    oFile.WriteBlankLines (2)
+    oFile.WriteLine ("#[ automatically added by VCS")
+    For Each key In keys
+        If Not IsInArray(key, existing_keys) Then
+            oFile.WriteLine key
+        End If
+    Next key
+    oFile.WriteLine "#]"
+    oFile.WriteBlankLines (2)
+    
+    oFile.Close
+    Set fso = Nothing
+    Set oFile = Nothing
+
+End Function

source/modules/VCS_ImportExport.bas

@@ -72,7 +72,6 @@ Public Sub ExportAllSource()
     source_path = VCS_Dir.ProjectPath() & "source\"
     VCS_Dir.MkDirIfNotExist source_path
 
-
     obj_path = source_path & "queries\"
     VCS_Dir.ClearTextFilesFromDir obj_path, "bas"
     

source/modules/VCS_Main.bas

@@ -0,0 +1,254 @@
+Option Compare Database
+
+'****
+'*
+'* Main methods for VCS add-in
+'*
+'****
+
+Public Const opInterrupted = 10
+Public Const opCancelled = 11
+Public Const opCompleted = 12
+
+'>> main function, called when addin is run
+Public Function vcsprompt()
+
+    DoCmd.OpenForm "frm_vcs"
+
+End Function
+
+
+Public Function make_sources(Optional ByVal options As String = "") As Integer
+'exports the source-code of the app
+On Error GoTo err
+Dim step As String
+
+    make_sources = opInterrupted
+    
+    step = "Initialization"
+    
+    ' backup of the sources date, in case of error
+    Dim old_sources_date As Date
+    old_sources_date = vcs_param("sources_date", #1/1/1900#)
+    
+    '*** If '-f' is not in the options: set the optimizer on
+    If Not InStr(options, "-f") > 0 Then
+        Dim msg As String
+        
+        If old_sources_date > #1/1/1900# Then
+
+            msg = msg_list_modified()
+            
+            If Not Len(msg) > 0 Then
+                msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Nothing new to export" & vbNewLine & _
+                            "Only the following will be exported:" & vbNewLine & _
+                            " - included table data" & vbNewLine & _
+                            " - relations" & vbNewLine & vbNewLine & _
+                            "TIP: use 'makesources -f' to force a complete export (could be long)."
+            Else
+                msg = "** VCS OPTIMIZER **" & vbNewLine & ">> Following objects will be exported:" & vbNewLine & msg
+            End If
+            
+            Call activate_optimizer
+        
+        Else
+            ' no sources date recorded, it may be the first export
+            msg = "FIRST EXPORT: " & vbNewLine & vbNewLine & _
+                  "Everything will be exported, it could be quite long..."
+        
+        End If
+        
+        If MsgBox(msg, vbOKCancel + vbExclamation, "Export") = vbCancel Then GoTo cancelOp
+        
+    End If
+
+
+    ' new sources date, before export so that date will be exported with tbl_vsc
+    step = "Updates sources date"
+    Debug.Print step
+    Call update_sources_date
+    Debug.Print "> done"
+
+    ' zip the app file
+    step = "Zip the app file"
+    Debug.Print step
+    Call zip_app_file
+    Debug.Print "> done"
+    
+    ' run the export
+    step = "Run VCS Export"
+    Debug.Print step
+    Call ExportAllSource
+    Debug.Print "> done"
+
+    make_sources = opCompleted
+    Exit Function
+err:
+    Call update_vcs_param("sources_date", CStr(old_sources_date))
+    MsgBox "make_sources - Unknown error at: " & step & vbNewLine & err.Description, vbCritical, "Error"
+    Exit Function
+cancelOp:
+    make_sources = opCancelled
+    Exit Function
+End Function
+
+
+Public Function update_from_sources(Optional ByVal options As String = "") As Integer
+'updates the application from the sources
+
+Dim backup As Boolean
+Dim step, msg As String
+
+update_from_sources = opInterrupted
+
+    step = "Creates a backup of the app file"
+    Debug.Print step
+    backup = make_backup()
+    
+    If backup Then
+        Debug.Print "> done"
+    Else
+        MsgBox "Error: unable to backup the app file, do it manually, then click OK", vbExclamation, "Backup"
+    End If
+
+    step = "Check for unexported work"
+    Debug.Print step
+    msg = msg_list_modified()
+    If Len(msg) > 0 Then
+        msg = "** IMPORT WARNING **" & vbNewLine & _
+                    UCase(CurrentProject.name) & " is going to be updated " & _
+                    "with the source files. " & vbNewLine & vbNewLine & _
+                    "FOLLOWING NON EXPORTED WORK WILL BE LOST: " & vbNewLine & _
+                    msg & vbNewLine & _
+                    "Are you sure you want to continue?"
+        If MsgBox(msg, vbOKCancel + vbExclamation, "Warning") = vbCancel Then GoTo cancelOp
+    End If
+
+    step = "Run VCS Import"
+    Debug.Print step
+    Call ImportAllSource
+    Debug.Print "> done"
+   
+    update_from_sources = opCompleted
+    Exit Function
+err:
+    MsgBox "update_from_sources - Unknown error at: " & vbNewLine & step & vbNewLine & err.Description, vbCritical, "Error"
+    Exit Function
+cancelOp:
+    update_from_sources = opCancelled
+    Exit Function
+End Function
+
+Public Function config_git_repo()
+'configure the application GIT repository for VCS use
+    
+    'verify that it is a git repository
+    If Not is_git_repo() Then
+        MsgBox "Not a git repository, please use 'git init on this directory first"
+        Exit Function
+    End If
+    
+    ' complete the gitignore file
+    Call complete_gitignore
+
+End Function
+
+Public Function sync()
+'[experimental] complete command to synchronize this app with the distant master branch
+
+    'verify that it is a git repository
+    If Not is_git_repo() Then
+        MsgBox "Not a git repository, please use 'git init on this directory first"
+        Exit Function
+    End If
+
+    'Call make_sources
+
+    Call cmd("echo --ADD FILES-- & git add *" & "& timeout 2", vbNormalFocus)
+    
+    Dim msg As String
+    msg = InputBox("Commit message:", "VCS")
+    If Not Len(msg) > 0 Then GoTo err_msg
+    
+    Call cmd("echo --COMMIT-- & git commit -a -m " & Chr(34) & msg & Chr(34) & "& timeout 2", vbNormalFocus)
+    
+    Call cmd("echo --PULL-- & git pull origin master & pause", vbNormalFocus)
+    
+    Call update_from_sources
+    
+    Call cmd("echo --PUSH-- & git push origin master" & "& timeout 2", vbNormalFocus)
+
+Exit Function
+err_msg:
+    MsgBox "Invalid value", vbExclamation
+End Function
+
+
+Public Function get_include_tables()
+    If CurrentProject.name = "VCS.accda" Then
+        get_include_tables = "tbl_commands,modele_ztbl_vcs"
+    Else
+        get_include_tables = vcs_param("include_tables")
+    End If
+End Function
+
+Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
+    vcs_param = default_value
+    On Error GoTo err_vcs_table
+    vcs_param = DFirst("val", "ztbl_vcs", "[key]='" & key & "'")
+err_vcs_table:
+End Function
+
+
+Public Function zip_app_file() As Boolean
+    On Error GoTo err
+    Dim command, shortname As String
+    
+    zip_app_file = False
+    
+    shortname = Split(CurrentProject.name, ".")(0)
+    
+    'run the shell comand
+    Call cmd("cd " & CurrentProject.Path & " & " & _
+             "zip tmp_" & shortname & ".zip " & CurrentProject.name & _
+             " & exit")
+    
+    'remove the old zip file
+    If dir(CurrentProject.Path & "\" & shortname & ".zip") <> "" Then
+        Kill CurrentProject.Path & "\" & shortname & ".zip"
+    End If
+    
+    'rename the temporary zip
+    Call cmd("cd " & CurrentProject.Path & " & " & _
+            "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
+            " & exit")
+    
+    
+    zip_app_file = True
+
+fin:
+    Exit Function
+UnknownErr:
+    MsgBox "Unknown error: unable to ZIP the app file, do it manually"
+    GoTo fin
+err:
+    MsgBox "Error while zipping file app: " & err.Description
+    GoTo fin
+End Function
+
+Public Function make_backup() As Boolean
+    On Error GoTo err
+    
+    make_backup = False
+    If dir(CurrentProject.Path & "\" & CurrentProject.name & ".old") <> "" Then
+        Kill CurrentProject.Path & "\" & CurrentProject.name & ".old"
+    End If
+
+    Call cmd("copy " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & Chr(34) & _
+             " " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & ".old" & Chr(34))
+    
+    make_backup = True
+    Exit Function
+err:
+        MsgBox "Error during backup: " & err.Description
+End Function

source/modules/optimizer.bas → source/modules/VCS_Optimizer.bas

@@ -7,6 +7,20 @@ Option Explicit
 '*
 '****
 
+' *** activates the optimizer
+Private p_optimizer As Boolean
+
+Public Sub activate_optimizer()
+    p_optimizer = True
+End Sub
+
+Public Function optimizer_activated()
+    optimizer_activated = p_optimizer
+End Function
+'***
+
+
+'*** main methods
 Public Function is_dirty(acType As Integer, name As String)
 ' has the object been modified since last export?
 
@@ -55,7 +69,7 @@ Public Function list_modified(acType As Integer)
     sources_date = get_sources_date()
     
     Dim rs As DAO.Recordset
-    Set rs = CurrentDb.OpenRecordset("SELECT * FROM MSysObjects WHERE " & typefilter(acType) & ";", _
+    Set rs = CurrentDb.OpenRecordset("SELECT * FROM MSysObjects WHERE " & msys_type_filter(acType) & ";", _
                                      dbOpenSnapshot)
     If rs.RecordCount = 0 Then GoTo emptylist
     
@@ -65,7 +79,7 @@ Public Function list_modified(acType As Integer)
         If Left$(rs![name], 4) <> "MSys" And _
             Left$(rs![name], 1) <> "~" Then
             
-            If rs![dateupdate] > sources_date Then
+            If get_last_update_date(acType, rs![name]) > sources_date Then
                 If Len(list_modified) > 0 Then
                     list_modified = list_modified & ";" & rs![name]
                 Else
@@ -106,7 +120,7 @@ Public Function msg_list_modified() As String
         If Len(lstmod) > 0 Then
             msg_list_modified = msg_list_modified & "** " & UCase(obj_type_label) & " **" & vbNewLine
             For Each objname In Split(lstmod, ";")
-                msg_list_modified = msg_list_modified & "    " & objname & vbNewLine
+                msg_list_modified = msg_list_modified & "   - " & objname & vbNewLine
             Next objname
         End If
     Next obj_type
@@ -118,18 +132,15 @@ End Function
 
 '*** sources_date is the date of the last export of the sources files
 Public Function get_sources_date() As Date
-
+' get the registered sources date
     get_sources_date = CDate(vcs_param("sources_date", "01/01/1900 00:00:00"))
 
 End Function
 
 Public Sub update_sources_date()
-
-If Not vcs_tbl_exists() Then
-    Call create_vcs_tbl
-End If
-
-Call update_vcs_param("sources_date", CStr(Now))
+    ' update the sources date with Now()
+    
+    Call update_vcs_param("sources_date", CStr(Now))
 
 End Sub
 '*****
@@ -178,7 +189,7 @@ Public Function CleanDirs(Optional ByVal sim As Boolean = False)
         
         For Each file In oFld.Files
             objectname = remove_ext(file.name)
-            rsSys.FindFirst (typefilter(obj_type_num) & " AND [name]='" & objectname & "'")
+            rsSys.FindFirst (msys_type_filter(obj_type_num) & " AND [name]='" & objectname & "'")
             
             If rsSys.NoMatch Then
                 'object doesn't exist anymore
@@ -194,75 +205,4 @@ next_obj_type:
     Next obj_type
 
 
-End Function
-
-
-Public Sub CleanObjects()
-
-
-
-
-End Sub
-
-'*** utilities
-Private Function typefilter(acType) As String
-'returns a sql filter string for the object type
-'NB: types in msysobjects table
-'-32768 = Form
-'-32766 = Macro
-'-32764 = Report
-'-32761 = Module
-'-32758  Users
-'-32757  Database Document
-'-32756  Data Access Pages
-'1   Table - Local Access Tables
-'2   Access Object - Database
-'3   Access Object - Containers
-'4   Table - Linked ODBC Tables
-'5   Queries
-'6   Table - Linked Access Tables
-'8   SubDataSheets
-
-    Select Case acType
-        Case acTable
-            typefilter = "([Type]=1 or [Type]=4 or [Type]=6)"
-        Case acQuery
-            typefilter = "[Type]=5"
-        Case acForm
-            typefilter = "[Type]=-32768"
-        Case acReport
-            typefilter = "[Type]=-32764"
-        Case acModule
-            typefilter = "[Type]=-32761"
-        Case acMacro
-            typefilter = "[Type]=-32766"
-        Case Else
-            GoTo typerror
-    End Select
-
-Exit Function
-typerror:
-    MsgBox "typerror:" & acType & " is not a valid object type"
-    typefilter = ""
-End Function
-
-
-
-Public Function remove_ext(ByVal filename As String) As String
-    ' removes the extension of a file name
-    If Not InStr(filename, ".") > 0 Then
-        remove_ext = filename
-        Exit Function
-    End If
-
-    Dim splitted_name As Variant
-    splitted_name = Split(filename, ".")
-
-    Dim i As Integer
-    remove_ext = ""
-    For i = 0 To (UBound(Split(filename, ".")) - 1)
-        If Len(remove_ext) > 0 Then remove_ext = remove_ext & "."
-        remove_ext = remove_ext & Split(filename, ".")(i)
-    Next i
-
 End Function

source/modules/Shell.bas → source/modules/VCS_ShellUtilities.bas

@@ -75,9 +75,6 @@ End Sub
 
 Public Function cmd(ByVal command As String, Optional WindowStyle As Long = vbHide, Optional in_dir As String = "")
 ' runs a comand with windows command line
-
     If Len(in_dir) = 0 Then in_dir = CurrentProject.Path
-
     Call ShellWait("cmd.exe /r cd " & in_dir & " & " & command, WindowStyle)
-
 End Function

source/modules/VCS_Utilities.bas

@@ -0,0 +1,103 @@
+Option Compare Database
+
+Public Function vcs_tbl_exists()
+' return True if the 'ztbl_vcs' table exists
+On Error GoTo err
+    vcs_tbl_exists = (CurrentDb.TableDefs("ztbl_vcs").name = "ztbl_vcs")
+Exit Function
+err:
+    If err.number = 3265 Then
+        vcs_tbl_exists = False
+    Else
+        MsgBox "Error: " & err.Description, vbCritical
+    End If
+End Function
+
+
+Public Function update_vcs_param(ByVal key As String, ByVal val As String)
+' create or update the parameter in ztbl_vcs
+
+    If Not vcs_tbl_exists() Then
+        Call create_vcs_tbl
+    End If
+
+    If DCount("key", "ztbl_vcs", "[key]='" & key & "'") = 1 Then
+        CurrentDb.execute "UPDATE ztbl_vcs SET ztbl_vcs.val = '" & val & "' " & _
+                            "WHERE (((ztbl_vcs.key)='" & key & "'));"
+    Else
+        CurrentDb.execute "INSERT INTO ztbl_vcs ( val, [key] ) " & _
+                           "SELECT '" & val & "' AS Expr1, '" & key & "' AS Expr2;"
+    End If
+
+End Function
+
+Public Function create_vcs_tbl()
+'creates the 'ztbl_vcs' table and hide it
+    CurrentDb.execute "SELECT 'include_tables' as key, 'ztbl_vcs' as val INTO ztbl_vcs;"
+    Application.SetHiddenAttribute acTable, "ztbl_vcs", True
+End Function
+
+Public Function IsInArray(ByVal stringToBeFound As String, ByRef arr As Variant) As Boolean
+' returns True if the string is in the array
+    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
+End Function
+
+Public Function msys_type_filter(acType) As String
+'returns a sql filter string for the object type
+'NB: types in msysobjects table
+'-32768 = Form
+'-32766 = Macro
+'-32764 = Report
+'32761 = Module
+'-32758  Users
+'-32757  Database Document
+'-32756  Data Access Pages
+'1   Table - Local Access Tables
+'2   Access Object - Database
+'3   Access Object - Containers
+'4   Table - Linked ODBC Tables
+'5   Queries
+'6   Table - Linked Access Tables
+'8   SubDataSheets
+
+    Select Case acType
+        Case acTable
+            msys_type_filter = "([Type]=1 or [Type]=4 or [Type]=6)"
+        Case acQuery
+            msys_type_filter = "[Type]=5"
+        Case acForm
+            msys_type_filter = "[Type]=-32768"
+        Case acReport
+            msys_type_filter = "[Type]=-32764"
+        Case acModule
+            msys_type_filter = "[Type]=-32761"
+        Case acMacro
+            msys_type_filter = "[Type]=-32766"
+        Case Else
+            GoTo typerror
+    End Select
+
+Exit Function
+typerror:
+    MsgBox "typerror:" & acType & " is not a valid object type"
+    msys_type_filter = ""
+End Function
+
+Public Function remove_ext(ByVal filename As String) As String
+    ' removes the extension of a file name
+    If Not InStr(filename, ".") > 0 Then
+        remove_ext = filename
+        Exit Function
+    End If
+
+    Dim splitted_name As Variant
+    splitted_name = Split(filename, ".")
+
+    Dim i As Integer
+    remove_ext = ""
+    For i = 0 To (UBound(Split(filename, ".")) - 1)
+        If Len(remove_ext) > 0 Then remove_ext = remove_ext & "."
+        remove_ext = remove_ext & Split(filename, ".")(i)
+    Next i
+
+End Function

source/modules/vcs.bas

@@ -1,307 +0,0 @@
-Option Compare Database
-Dim private_optimizer As Boolean
-
-'****
-'*
-'* Main methods for VCS add-in
-'*
-'****
-
-Public Function vcsprompt()
-
-    DoCmd.OpenForm "frm_vcs"
-
-End Function
-
-
-Public Function make_sources(Optional ByVal options As String = "")
-'exports the source-code of the app
-On Error GoTo err
-Dim step As String
-
-    step = "Initialization"
-    If Not InStr(options, "-f") > 0 Then
-        Dim msg As String
-        msg = msg_list_modified()
-        
-        If Not Len(msg) > 0 Then
-            msg = "Nothing new to export" & vbNewLine & _
-                        "Only the following will be exported:" & vbNewLine & _
-                        " - included table data" & vbNewLine & _
-                        " - relations" & vbNewLine & vbNewLine & _
-                        "TIP: use 'makesources -f' to force a complete export (could be long)."
-            If MsgBox(msg, vbOKCancel + vbExclamation, "Export") = vbCancel Then Exit Function
-        Else
-            msg = "** VCS OPTIMIZER **" & vbNewLine & "Seuls les objets suivant seront exportés:" & vbNewLine & msg
-            If MsgBox(msg, vbOKCancel) = vbCancel Then Exit Function
-        End If
-        
-        Call activate_optimizer
-    End If
-
-    step = "Updates sources date"
-    Debug.Print step
-    Call update_sources_date
-    Debug.Print "> done"
-
-    step = "Zip the app file"
-    Debug.Print step
-    Call zip_app_file
-    Debug.Print "> done"
-    
-    step = "Run VCS Export"
-    Debug.Print step
-    Call ExportAllSource
-    Debug.Print "> done"
-
-    Exit Function
-err:
-    MsgBox "makesources - Unknown error at: " & step & vbNewLine & err.Description
-End Function
-
-
-Public Function update_from_sources(Optional ByVal options As String = "")
-'updates the application from the sources
-Dim backup As Boolean
-
-    Debug.Print "Creates a backup of the app file"
-    backup = make_backup()
-    
-    If backup Then
-        Debug.Print "> done"
-    Else
-        MsgBox "Error: unable to backup the app file, do it manually, then click OK"
-    End If
-
-    If MsgBox("WARNING: the current application is going to be updated " & _
-                "with the source files. " & _
-                "Any non committed work would be lost, " & _
-                "are you sure you want to continue?" & _
-                "", vbOKCancel) = vbCancel Then Exit Function
-
-    Debug.Print "Run VCS Import"
-    Call ImportAllSource
-    Debug.Print "> done"
-    
-End Function
-
-Public Function config_git_repo()
-'configure the application GIT repository for VCS use
-    
-    'verify that it is a git repository
-    If Not is_git_repo() Then
-        MsgBox "Not a git repository, please use 'git init on this directory first"
-        Exit Function
-    End If
-    
-    ' complete the gitignore file
-    Call complete_gitignore
-
-End Function
-
-Public Function sync()
-'complete command to synchronize this app with the distant master branch
-
-    'verify that it is a git repository
-    If Not is_git_repo() Then
-        MsgBox "Not a git repository, please use 'git init on this directory first"
-        Exit Function
-    End If
-
-    'Call make_sources
-
-    Call cmd("echo --ADD FILES-- & git add *" & "& timeout 2", vbNormalFocus)
-    
-    Dim msg As String
-    msg = InputBox("Commit message:", "VCS")
-    If Not Len(msg) > 0 Then GoTo err_msg
-    
-    Call cmd("echo --COMMIT-- & git commit -a -m " & Chr(34) & msg & Chr(34) & "& timeout 2", vbNormalFocus)
-    
-    Call cmd("echo --PULL-- & git pull origin master & pause", vbNormalFocus)
-    
-    Call update_from_sources
-    
-    Call cmd("echo --PUSH-- & git push origin master" & "& timeout 2", vbNormalFocus)
-
-Exit Function
-err_msg:
-    MsgBox "Invalid value", vbExclamation
-End Function
-
-Public Function is_git_repo() As Boolean
-    is_git_repo = (dir(CurrentProject.Path & "\.git\", vbDirectory) <> "")
-End Function
-
-Public Function get_include_tables()
-
-If CurrentProject.name = "VCS.accda" Then
-    get_include_tables = "tbl_commands,modele_ztbl_vcs"
-Else
-    get_include_tables = vcs_param("include_tables")
-End If
-End Function
-
-Public Function vcs_param(ByVal key As String, Optional ByVal default_value As String = "") As String
-    vcs_param = default_value
-    On Error GoTo err_vcs_table
-        vcs_param = DFirst("val", "ztbl_vcs", "[key]='" & key & "'")
-err_vcs_table:
-End Function
-
-Public Function gitcmd(args)
-
-    Call cmd("echo -- " & args & " -- & git " & args & "& pause", vbNormalFocus)
-
-End Function
-
-Public Function zip_app_file() As Boolean
-    On Error GoTo err
-    Dim command, shortname As String
-    
-    zip_app_file = False
-    
-    shortname = Split(CurrentProject.name, ".")(0)
-    
-    'run the shell comand
-    Call cmd("cd " & CurrentProject.Path & " & " & _
-             "zip tmp_" & shortname & ".zip " & CurrentProject.name & _
-             " & exit")
-    
-    'remove the old zip file
-    If dir(CurrentProject.Path & "\" & shortname & ".zip") <> "" Then
-        Kill CurrentProject.Path & "\" & shortname & ".zip"
-    End If
-    
-    'rename the temporary zip
-    Call cmd("cd " & CurrentProject.Path & " & " & _
-            "ren tmp_" & shortname & ".zip" & " " & shortname & ".zip" & _
-            " & exit")
-    
-    
-    zip_app_file = True
-
-fin:
-    Exit Function
-UnknownErr:
-    MsgBox "Unknown error: unable to ZIP the app file, do it manually"
-    GoTo fin
-err:
-    MsgBox "Error while zipping file app: " & err.Description
-    GoTo fin
-End Function
-
-Public Function make_backup() As Boolean
-    On Error GoTo err
-    
-    make_backup = False
-    If dir(CurrentProject.Path & "\" & CurrentProject.name & ".old") <> "" Then
-        Kill CurrentProject.Path & "\" & CurrentProject.name & ".old"
-    End If
-    
-
-    'FileCopy CurrentProject.Path & "\" & CurrentProject.name, CurrentProject.Path & "\" & CurrentProject.name & ".old"
-    Call cmd("copy " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & Chr(34) & _
-             " " & Chr(34) & CurrentProject.Path & "\" & CurrentProject.name & ".old" & Chr(34))
-    
-    make_backup = True
-    Exit Function
-err:
-        MsgBox "Error during backup: " & err.Description
-End Function
-
-Public Function complete_gitignore()
-    ' creates or complete the .gitignore file of the repo
-    Dim gitignore_path, str_existing_keys, str As String
-    
-    Dim keys() As String
-    keys = Split("*.accdb;*.laccdb;*.mdb;*.ldb;*.accde;*.mde;*.accda", ";")
-    
-    gitignore_path = CurrentProject.Path & "\.gitignore"
-    
-    Dim fso As Object
-    Set fso = CreateObject("Scripting.FileSystemObject")
-    
-    Dim oFile As Object
-    If Not fso.FileExists(gitignore_path) Then
-        Set oFile = fso.CreateTextFile(gitignore_path)
-    Else
-        Set oFile = fso.OpenTextFile(gitignore_path, ForReading)
-        str_existing_keys = ""
-        
-        While Not oFile.AtEndOfStream
-            str = oFile.readline
-            If Len(str_existing_keys) = 0 Then
-                str_existing_keys = str
-            Else
-                str_existing_keys = str_existing_keys & ";" & str
-            End If
-        Wend
-        oFile.Close
-        
-        Dim existing_keys() As String
-        existing_keys = Split(str_existing_keys, ";")
-        
-        Set oFile = fso.OpenTextFile(gitignore_path, ForAppending)
-    End If
-    
-    oFile.WriteBlankLines (2)
-    oFile.WriteLine ("#[ automatically added by VCS")
-    For Each key In keys
-        If Not IsInArray(key, existing_keys) Then
-            oFile.WriteLine key
-        End If
-    Next key
-    oFile.WriteLine "#]"
-    oFile.WriteBlankLines (2)
-    
-    oFile.Close
-    Set fso = Nothing
-    Set oFile = Nothing
-
-End Function
-
-Private Function IsInArray(ByVal stringToBeFound As String, ByRef arr As Variant) As Boolean
-    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
-End Function
-
-Function vcs_tbl_exists()
-On Error GoTo err
-    vcs_tbl_exists = (CurrentDb.TableDefs("ztbl_vcs").name = "ztbl_vcs")
-Exit Function
-err:
-    If err.number = 3265 Then
-        vcs_tbl_exists = False
-    Else
-        MsgBox "Error: " & err.Description, vbCritical
-    End If
-End Function
-
-Public Function create_vcs_tbl()
-    CurrentDb.execute "SELECT 'include_tables' as key, '' as val INTO ztbl_vcs " & _
-                       "FROM modele_ztbl_vcs;"
-End Function
-
-Public Function update_vcs_param(ByVal key As String, ByVal val As String)
-
-    If DCount("key", "ztbl_vcs", "[key]='" & key & "'") = 1 Then
-        CurrentDb.execute "UPDATE ztbl_vcs SET ztbl_vcs.val = '" & val & "' " & _
-                            "WHERE (((ztbl_vcs.key)='" & key & "'));"
-    Else
-        CurrentDb.execute "INSERT INTO ztbl_vcs ( val, [key] ) " & _
-                           "SELECT '" & val & "' AS Expr1, '" & key & "' AS Expr2;"
-    End If
-
-End Function
-
-Public Sub activate_optimizer()
-
-    private_optimizer = True
-
-End Sub
-
-Public Function optimizer_activated()
-
-    optimizer_activated = private_optimizer
-
-End Function

source/tables/tbl_commands.txt

@@ -1,5 +1,4 @@
 cmd_name	function	description	order	with_args
 configure_git_repo	config_git_repo	Configure an existing Git repository to be used with VCS	3	Faux
-gitcmd	gitcmd	Runs a git command	4	Vrai
 make_sources	make_sources	Makes the source-code files from the current project (-f to force a complete export)	1	Vrai
 update_from_sources	update_from_sources	Update the current project within the source-code files (-f to force a complete export)	2	Vrai

source/tables/ztbl_vcs.txt

@@ -0,0 +1,3 @@
+key	val
+include_tables	ztbl_vcs,tbl_commands
+sources_date	17/10/2016 18:10:20