projman/lib/git.tcl

######################################################
#                ProjMan 2
#        Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "SVK", 2022, https://nuk-svk.ru
######################################################
# Git module
# usage a system git command
#######################################################


namespace eval Git {
    variable gitCommand
    
    proc GetConfig {option} {
        global activeProject cfgVariables
        set confOptions {
            remote.origin.url
            user.user
            user.email
            init.defaultbranch
            branch.master.remote
        }
        if {$activeProject ne ""} {
            cd $activeProject
        }
        
        set cmd exec
        lappend cmd $cfgVariables(gitCommand)
        lappend cmd "config"
        switch $option {
            all {
                lappend cmd "-l"
            }
            default {
                lappend cmd "--get"
                lappend cmd "$option"
            }
        }
        # lappend cmd $activeProject
        catch $cmd pipe        
        foreach line [split $pipe "\n"] {
            lappend res $line
        }
        return $res
    }

    proc Checkout {opt {ent ".branch.entBranch"}} {
        global cfgVariables activeProject
        set cmd exec
        set d [pwd]
        if {$activeProject ne ""} {
            cd $activeProject
        }
        lappend cmd $cfgVariables(gitCommand)
        lappend cmd "checkout"
        # lappend cmd "-s"
        # lappend cmd "--"
        # lappend cmd $activeProject
        switch $opt {
            switchBranch {
                set branch [.branch.lBox get [.branch.lBox curselection]]
                lappend cmd "[string trim $branch]"
            }
            new {
                lappend cmd "-b"
                lappend cmd "[$ent get]"
                # puts "Branch [$ent get]"
            }
        }
        catch $cmd pipe
        puts $cmd
        puts $pipe
        if [regexp -nocase -- {^error:} $pipe match] {
            return 
        }
        foreach line [split $pipe "\n"] {
            lappend res $line
        }
        # cd $d
        
        .frmStatus.lblGit configure -text "[::msgcat::mc "Branch"]: [Git::Branches current]"
        if [info exists res] {
            return $res
        }
    }

    proc Branches {opt} {
        global cfgVariables activeProject
        set cmd exec
        set d [pwd]
        if {$activeProject ne ""} {
            cd $activeProject
        }
        lappend cmd $cfgVariables(gitCommand)
        lappend cmd "branch"
        # lappend cmd "-s"
        # lappend cmd "--"
        # lappend cmd $activeProject
        switch $opt {
            current {
                lappend cmd "--show-current"
            }
            list {
                lappend cmd "-l"
            }
        }
        catch $cmd pipe
        if [regexp -nocase -- {^fatal:} $pipe match] {
            return 
        }
        foreach line [split $pipe "\n"] {
            lappend res $line
        }
        cd $d
        if [info exists res] {
            return $res
        }
    }
    
    proc Status {} {
        global cfgVariables activeProject
        set cmd exec
        lappend cmd $cfgVariables(gitCommand)
        lappend cmd "status"
        lappend cmd "-s"
        lappend cmd "--"
        lappend cmd $activeProject
        catch $cmd pipe
        if [regexp -nocase -- {^fatal:} $pipe match] {
            return 
        }
        foreach line [split $pipe "\n"] {
            lappend res $line
        }
        if [info exists res] {
            return $res
        }
    }
    
    proc Diff {f} {
        global cfgVariables activeProject
        set cmd exec
        set res ""
        lappend cmd $cfgVariables(gitCommand)
        lappend cmd "diff"
        lappend cmd "--"
        lappend cmd [file join $activeProject [string trimleft $f "../"]]
        catch $cmd pipe
        puts $cmd
        if [regexp -nocase -- {^fatal:} $pipe match] {
            return 
        }
        foreach line [split $pipe "\n"] {
            lappend res $line
        }
        return $res
    }
    
    proc Commit {w} {
        global cfgVariables activeProject
        set txt [string trim [$w get 0.0 end]]
        puts $txt
        set cmd exec
        append cmd " $cfgVariables(gitCommand)"
        append cmd " commit"
        append cmd " -m"
        append cmd " \"$txt\""
        append cmd " --"
        append cmd " $activeProject"
        if {$txt eq ""} {
            set answer [tk_messageBox -message [::msgcat::mc "Empty commit description"] \
                -icon info -type ok \
                -detail [::msgcat::mc "You must enter a commit description"]]
            switch $answer {
                ok {return "cancel"}
            }
        } else {
            puts $cmd
            catch $cmd pipe
            puts $pipe
            if [regexp -nocase -- {^fatal:} $pipe match] {
                return 
            }
            foreach line [split $pipe "\n"] {
                lappend res $line
            }
            return $res
        }
    }
    
    proc Pull {} {
        global cfgVariables activeProject
    }
    
    # Вызов диалога авторизации если ссылка на репу по http
    # Если ссылка по ssh то вызов Push
    proc PushPrepare {} {
        global cfgVariables activeProject gitUser gitPassword
        # set cmd exec
        cd $activeProject
        set url [Git::GetConfig remote.origin.url]
        puts $url
        if [regexp -nocase -all -- {^(http|https)://(.+)} $url match proto address] {
            Git::AuthorizationDialog "[::msgcat::mc "Authorization required"] [::msgcat::mc "for"] Git" $url
        } else {
            Git::Push $url
        }
    }
    
    # /usr/bin/git push https://user:pass@git.nuk-svk.ru/repo.git
    # /usr/bin/git push ssh://git@git.nuk-svk.ru/repo.git
    proc Push {url} {
        global cfgVariables activeProject gitUser gitPassword
        set cmd exec
        lappend cmd "$cfgVariables(gitCommand)"
        cd $activeProject       
        lappend cmd "push"
        lappend cmd "$url"
        # lappend cmd "$activeProject"
        # puts "$cmd"
        catch $cmd pipe
        puts $pipe
        foreach line [split $pipe "\n"] {
            # puts "$line"
            lappend res $line
        }
        return $res
    }
        
    proc Merge {} {
        global cfgVariables activeProject
    }

    proc Reflog {} {
        global cfgVariables activeProject
        set cmd exec
        lappend cmd "$cfgVariables(gitCommand)"
        lappend cmd "reflog"
        lappend cmd "--"
        lappend cmd "$activeProject"
        # if [regexp -nocase -- {^fatal:} $pipe match] {
            # return 
        # }
        puts $cmd
        catch $cmd pipe
        # puts $pipe
        foreach line [split $pipe "\n"] {
            # puts "$line"
            lappend res $line
        }
        return $res
    }
    
    #  git show --pretty=format:"%h;%ad;%s"
    proc Show {w} {
        global cfgVariables activeProject
        set commitString [$w.body.lLog get [$w.body.lLog curselection]]
        set hash [string trim [lindex [split $commitString " "] 0]]
        $w.body.t delete 1.0 end
        $w.body.tCommit delete 1.0 end
        set cmd exec
        lappend cmd "$cfgVariables(gitCommand)"
        lappend cmd "show"
        lappend cmd "--pretty=format:\"%H;%an;%ae;%ad;%s\""
        lappend cmd $hash
        lappend cmd "--"
        lappend cmd "$activeProject"

        puts $cmd
        catch $cmd pipe
        # puts $pipe
        set i 0
        foreach line [split $pipe "\n"] {
            if {$i == 0} {
                set str [split $line ";"]
                $w.body.tCommit inser end "Hash: [string trimleft [lindex $str 0] "\""]\n"
                $w.body.tCommit inser end "Author: [lindex $str 1]\n"
                $w.body.tCommit inser end "Email: [lindex $str 2]\n"
                $w.body.tCommit inser end "Date: [lindex $str 3]\n"
                $w.body.tCommit inser end "Description: [string trimright [lindex $str 4] "\""]\n"
            } else {
                # puts "$line"
                $w.body.t inser end "$line\n"
            }
            incr i
            # lappend res $line
        }
        $w.body.t highlight 1.0 end
        $w.body.tCommit highlight 1.0 end
        # return $res
    }
    
    proc ListBoxPress {w} {
        if {[$w.body.lBox curselection] ne ""} {
            set fileName [$w.body.lBox get [$w.body.lBox curselection]]
        } else {
            return
        }
        # puts $values
        $w.body.t delete 1.0 end
        set i 0
        foreach line [Git::Diff $fileName] {
            puts $line
            if {$i > 3} {
                $w.body.t inser end "$line\n"
            }
            incr i
        }
        $w.body.t highlight 1.0 end
    }
    proc CommitAdd {w} {
        global activeProject cfgVariables
        set fileName [$w.body.lBox get [$w.body.lBox curselection]]
        # puts $values
        set cmd exec
        lappend cmd $cfgVariables(gitCommand)
        lappend cmd "add"
        lappend cmd [file join $activeProject $fileName]
        catch $cmd pipe
        puts $cmd
        $w.body.lCommit insert end $fileName
        $w.body.lBox delete [$w.body.lBox curselection]
    }
    proc Key {k fr} {
        # puts [Editor::Key $k]
        switch $k {
            Up {
               Git::ListBoxPress $fr
            }
            Down {
                Git::ListBoxPress $fr
            }
        }
    }
    
    proc DialogUpdate {w} {
        global activeProject
        # Git repo status
        set lblText "$activeProject | [::msgcat::mc "Branch"]: [Git::Branches current]"
        $w.header.lblGit configure -text $lblText
        $w.body.t delete 1.0 end
        $w.body.tCommit delete 1.0 end
        $w.body.lCommit delete 0 end
        $w.body.lBox delete 0 end
        $w.body.lLog delete 0 end
        foreach { word } [Git::Status] {
            puts ">>$word"
            if [regexp -nocase -- {([\w\s]+)([\s\w?]+)\s(../|)(.+?)} $word match v1 v2 v3 fileName] {
                puts "$v1 $v2 $fileName"
                # $fr.body.t delete 1.0 end
                if {$v1 ne " "} {
                    $w.body.lCommit insert end $fileName
                }
                if {$v2 ne " "} {
                    $w.body.lBox insert end $fileName
                }
            }
        }
        
        # Git commit history
        foreach { line } [Git::Reflog] {
            # puts $line
            $w.body.lLog insert end $line
        }         
        # End Git commit history
    }
    
    proc AddToplevel {lbl img {win_name .auth}} {
        set cmd "destroy $win_name"
        if [winfo exists $win_name] {destroy $win_name}
        toplevel $win_name
        wm transient $win_name .
        wm title $win_name [::msgcat::mc "Add record"]
        # wm iconphoto $win_name tcl
        ttk::label $win_name.lbl -image $img -anchor nw
        
        set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
        grid columnconfigure $frm 0 -weight 1
        grid rowconfigure $frm 0 -weight 1
        set frm_btn [ttk::frame $win_name.frm_btn ]
        ttk::button $frm_btn.btn_ok -image done_20x20 -command { }
        ttk::button $frm_btn.btn_cancel -command $cmd -image cancel_20x20 
        grid $win_name.lbl -row 0 -column 0 -sticky nsw -padx 0 -pady 1 -rowspan 2 
        grid $frm -row 0 -column 1 -sticky nw -padx 2 -pady 2
        grid $frm_btn -row 1 -column 1 -sticky sew -padx 0 -pady 0
        pack  $frm_btn.btn_cancel $frm_btn.btn_ok -side right -padx 5 -pady 5
        #pack  $frm_btn.btn_ok  -side right -padx 2
        bind $win_name <Escape> $cmd
        return $frm
    }
    proc GetAuthData {url} {
        global gitUser gitPassword
        # puts [.auth_win.frm.ent_name get]
        # puts [.auth_win.frm.ent_pwd get]	
        set gitUser [.auth_win.frm.ent_name get]
        set gitPassword [.auth_win.frm.ent_pwd get]
        if [regexp -nocase -all -- {^(http|https)://(.+)} $url match proto address] {
    
            # puts $gitUser
            # puts $gitPassword
            if {$gitUser ne ""} {
                append repoUrl "$proto"
                append repoUrl "://"
                append repoUrl "$gitUser"
            }
            if {$gitPassword ne ""} {
                append repoUrl ":$gitPassword"
                append repoUrl "@$address"
            }
            # puts $repoUrl
            Git::Push $repoUrl    
        }
        destroy .auth_win
    }
    proc AuthorizationDialog {txt url} {
        global gitUser gitPassword
        set frm [Git::AddToplevel "$txt" key_64x64 .auth_win]
        wm title .auth_win [::msgcat::mc "Authorization"]
        ttk::label $frm.lbl_name -text [::msgcat::mc "User name"]
        ttk::entry  $frm.ent_name
        ttk::label $frm.lbl_pwd -text [::msgcat::mc "Password"]
        ttk::entry $frm.ent_pwd
        
        grid $frm.lbl_name -row 0 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_name -row 0 -column 1 -sticky nsew -padx 5 -pady 5
        grid $frm.lbl_pwd -row 1 -column 0 -sticky nw -padx 5 -pady 5
        grid $frm.ent_pwd -row 1 -column 1 -sticky nsew -padx 5 -pady 5
        grid columnconfigure $frm 0 -weight 1
        grid rowconfigure $frm 0 -weight 1
        #set frm_btn [frame .add.frm_btn -border 0]
        .auth_win.frm_btn.btn_ok configure -command "Git::GetAuthData $url"
    }
    
    proc BranchDialog {x y} {
        global editors lexers newBranchName
        variable win
        # set txt $w.frmText.t
        set win .branch
        # set x [winfo rootx .frmWork]
        # set y [winfo rooty .frmWork]
        
        if { [winfo exists $win] } { destroy $win }
        toplevel $win
        wm transient $win .
        wm overrideredirect $win 1
        ttk::button $win.bAdd -image new_14x14 -compound left -text "[::msgcat::mc "Add new branch"]" \
            -command {
                grid forget .branch.lBox .branch.yscroll
                grid .branch.entBranch
                bind .branch <Return> "Git::Checkout new .branch.entBranch; destroy .branch"
            }
        ttk::entry $win.entBranch -textvariable newBranchName
        
        listbox $win.lBox -width 30 -border 2 -yscrollcommand "$win.yscroll set" -border 1
        ttk::scrollbar $win.yscroll -orient vertical -command  "$win.lBox yview"
        # pack $win.lBox -expand true -fill y -side left
        # pack $win.yscroll -side left -expand false -fill y
        grid $win.bAdd -column 0 -row 0 -columnspan 2 -sticky new
        grid $win.lBox -column 0 -row 1
        grid $win.yscroll -column 1 -row 1 -sticky nsw
        
        set lst [Git::Branches all]
        foreach { word } $lst {
            $win.lBox insert end $word
        }
        
        focus -force $win.lBox
        catch { $win.lBox activate 0 ; $win.lBox selection set 0 0 }
        
        if { [set height [llength $lst]] > 10 } { set height 10 }
        $win.lBox configure -height $height

        bind $win <Escape> { 
            destroy .branch
            break
        }
        bind $win.lBox <Escape> {
            destroy .branch
            break
        }
        bind $win.lBox <Return> {
            Git::Checkout switchBranch
            .frmStatus.lblGit configure -text "[::msgcat::mc "Branch"]: [Git::Branches current]"
            destroy .branch
        }
        bind $win.lBox <Any-Key> {}
        bind $win.lBox <Double-Button-1> {
            Git::Checkout switchBranch
            .frmStatus.lblGit configure -text "[::msgcat::mc "Branch"]: [Git::Branches current]"
            destroy .branch
        }
        
        # Определям расстояние до края экрана (основного окна) и если
        # оно меньше размера окна со списком то сдвигаем его вверх
        set winGeom [winfo reqheight $win]
        set topHeight [winfo height .]
        # puts "$x, $y, $winGeom, $topHeight"
        if [expr [expr $topHeight - $y] < $winGeom] {
            set y [expr $topHeight - $winGeom]
        }
        wm geom $win +$x+$y
    }
    
    proc Dialog {} {
        global cfgVariables activeProject nbEditor
        variable fr
        if [winfo exists $nbEditor.git_browse] {
            $nbEditor select $nbEditor.git_browse
            return
        }
        if {[info exists activeProject] == 0} {
            return
        }
        set fr [NB::InsertItem $nbEditor git_browse "git"]
        ttk::frame $fr.header
        set lblText "$activeProject | [::msgcat::mc "Branch"]: [Git::Branches current]"
        ttk::label $fr.header.lblGit -text $lblText -justify right
        pack $fr.header.lblGit -side right -expand true -fill x
        pack $fr.header -side top -fill x  -padx 3

        ttk::frame $fr.body
        pack $fr.body -side top -expand true -fill both -padx 3
        
        ttk::label $fr.body.lblUnindexed -justify left -padding {3 3} \
            -text "[::msgcat::mc "Unindexed changes"]:"
        
    		listbox $fr.body.lBox -border 0 -yscrollcommand "$fr.body.yscroll set" -width 10
        ttk::scrollbar $fr.body.yscroll -orient vertical -command  "$fr.body.lBox yview"

        # pack [ttk::scrollbar $fr.body.v -command "$fr.body.t yview"] -side right -fill y
        ttk::scrollbar $fr.body.v -orient vertical -command "$fr.body.t yview"
        ttk::scrollbar $fr.body.h -orient horizontal -command "$fr.body.t xview"
        ctext $fr.body.t -xscrollcommand "$fr.body.h set" -yscrollcommand "$fr.body.v set" \
            -font $cfgVariables(font) -relief flat -wrap none -linemap 0 \
            -tabs "[expr {4 * [font measure $cfgVariables(font) 0]}] left" \
            -tabstyle tabular -undo true -width 10
        
        ttk::button $fr.body.bAdd -image forward_20x20 -compound center \
            -command "Git::CommitAdd $fr"
        ttk::button $fr.body.bRemove -compound center -image backward_20x20
        ttk::label $fr.body.lblCommitText -padding {3 3} \
            -text "[::msgcat::mc "Commit description"]:"
            
      		listbox $fr.body.lCommit -border 0 -yscrollcommand "$fr.body.vlCommit set"
        ttk::scrollbar $fr.body.vlCommit -orient vertical -command  "$fr.body.lCommit yview"
        ttk::scrollbar $fr.body.vCommit -command "$fr.body.tCommit yview"
        # ttk::scrollbar $fr.body.hCommit -orient horizontal -command "$fr.body.tCommit xview"
        ctext $fr.body.tCommit -tabstyle tabular -undo true \
            -yscrollcommand "$fr.body.vCommit set" \
            -font $cfgVariables(font) -relief flat -wrap word -linemap 0

        ttk::button $fr.body.bCommit -image done_20x20 -compound left \
            -text "[::msgcat::mc "Commit changes"]" \
            -command "Git::Commit $fr.body.tCommit; Git::DialogUpdate $fr"
        ttk::button $fr.body.bPush -image doneall_20x20 -compound left \
            -text "[::msgcat::mc "Push changes"]" \
            -command "Git::PushPrepare; Git::DialogUpdate $fr"
        
        ttk::label $fr.body.lblLog -padding {3 3} -text "[::msgcat::mc "Commit history"]:"
    		listbox $fr.body.lLog -border 0 \
                		-yscrollcommand "$fr.body.vLog set"	-xscrollcommand "$fr.body.hLog set"
        ttk::scrollbar $fr.body.vLog -orient vertical -command  "$fr.body.lLog yview"
        ttk::scrollbar $fr.body.hLog -orient horizontal -command  "$fr.body.lLog xview"


        # pack $txt -fill both -expand 1
        # pack $fr.body.h -side bottom -fill x

        grid $fr.body.lblUnindexed -column 0 -row 0 -sticky new -columnspan 4
        
        grid $fr.body.lBox    -column 0 -row 1 -sticky nsew -rowspan 2 -columnspan 2
        grid $fr.body.yscroll -column 2 -row 1 -sticky nsw -rowspan 2
        grid $fr.body.t -column	3 -row 1 -sticky nsew -columnspan 2
        grid $fr.body.v -column 5 -row 1 -sticky nsw
        grid $fr.body.h -column 3 -row 2 -sticky new -columnspan 2

        grid $fr.body.bAdd          -column 0 -row 3 -sticky nsw
        grid $fr.body.bRemove       -column 1 -row 3 -sticky nsw
        grid $fr.body.lblCommitText -column 3 -row 3 -sticky nsew -columnspan 2
        
        grid $fr.body.lCommit  -column 0 -row 4 -sticky nsw -rowspan 3 -columnspan 2
        grid $fr.body.vlCommit -column 2 -row 4 -sticky nsw -rowspan 3
        grid $fr.body.tCommit  -column 3 -row 4 -sticky nsew -columnspan 2 
        grid $fr.body.vCommit  -column 5 -row 4 -sticky nsw
        # grid $fr.body.hCommit  -column 3 -row 5 -sticky new -columnspan 2
        grid $fr.body.bCommit  -column 3 -row 6 -sticky new
        grid $fr.body.bPush    -column 4 -row 6 -sticky new

        grid $fr.body.lblLog -column 0 -row 7 -sticky nsw -columnspan 5
        grid $fr.body.lLog   -column 0 -row 8 -sticky nsew -columnspan 5
        grid $fr.body.vLog   -column 5 -row 8 -sticky nsw
        grid $fr.body.hLog   -column 0 -row 9 -sticky new -columnspan 5

        grid rowconfigure $fr.body $fr.body.t -weight 1
        grid columnconfigure $fr.body $fr.body.t -weight 1
        grid rowconfigure $fr.body $fr.body.tCommit -weight 1
        grid columnconfigure $fr.body $fr.body.tCommit -weight 1
        # grid rowconfigure $fr.body $fr.body.lLog -weight 1
        # grid columnconfigure $fr.body $fr.body.lLog -weight 1

        # Git repo status
        foreach { word } [Git::Status] {
            # puts $word
            if [regexp -nocase -- {([\w\s])([\s\w?]+)\s../(.+?)} $word match v1 v2 fileName] {
                # puts "$v1 $v2 $fileName"
                # $fr.unindexed.t delete 1.0 end
                if {$v1 ne " "} {
                    $fr.body.lCommit insert end $fileName
                }
                if {$v2 ne " "} {
                    $fr.body.lBox insert end $fileName
                }
            }
        }        
        
        catch { $fr.body.lBox activate 0 ; $fr.body.lBox selection set 0 0 }

        bind $fr.header.lblGit <Button-1><ButtonRelease-1> {
            Git::BranchDialog %X %Y
            Git::DialogUpdate $Git::fr
        }
        bind $fr.body.lBox <Return> "Git::CommitAdd $fr"
        bind $fr.body.lBox <Double-Button-1> "catch {Git::CommitAdd $fr}"
        bind $fr.body.lBox <Button-1><ButtonRelease-1> "Git::ListBoxPress $fr"
        bind $fr.body.lBox <KeyRelease> "Git::Key %K $fr"

        bind $fr.body.lLog <Double-Button-1> "Git::Show $fr"
        bind $fr.body.lLog <Return> "Git::Show $fr"
        
        focus -force $fr.body.lBox
        catch {
            $fr.body.lBox activate 0
            $fr.body.lBox selection set 0 0
            Git::ListBoxPress $fr
        }
        
        # Git commit history
        foreach { line } [Git::Reflog] {
            # puts $line
            $fr.body.lLog insert end $line
        }         
        # End Git commit history
        
        ctext::addHighlightClassForRegexp $fr.body.t paths #19a2a6 {@@.+@@}
        ctext::addHighlightClassForRegexp $fr.body.t add green {^\+.*$}
        ctext::addHighlightClassForRegexp $fr.body.t gremove grey {^\-.*$}
        $fr.body.t highlight 1.0 end
        
        ctext::addHighlightClassForRegexp $fr.body.tCommit stackControl lightblue {^[\w]+:}
    }
}