diff options
Diffstat (limited to 'lib')
41 files changed, 0 insertions, 12247 deletions
diff --git a/lib/about.tcl b/lib/about.tcl deleted file mode 100644 index cfa50fca87..0000000000 --- a/lib/about.tcl +++ /dev/null @@ -1,70 +0,0 @@ -# git-gui about git-gui dialog -# Copyright (C) 2006, 2007 Shawn Pearce - -proc do_about {} { - global appvers copyright oguilib - global tcl_patchLevel tk_patchLevel - global ui_comm_spell NS use_ttk - - set w .about_dialog - Dialog $w - wm geometry $w "+[winfo rootx .]+[winfo rooty .]" - - pack [git_logo $w.git_logo] -side left -fill y -padx 10 -pady 10 - ${NS}::label $w.header -text [mc "About %s" [appname]] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.close -text {Close} \ - -default active \ - -command [list destroy $w] - pack $w.buttons.close -side right - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - paddedlabel $w.desc \ - -text "[mc "git-gui - a graphical user interface for Git."]\n$copyright" - pack $w.desc -side top -fill x -padx 5 -pady 5 - - set v {} - append v "git-gui version $appvers\n" - append v "[git version]\n" - append v "\n" - if {$tcl_patchLevel eq $tk_patchLevel} { - append v "Tcl/Tk version $tcl_patchLevel" - } else { - append v "Tcl version $tcl_patchLevel" - append v ", Tk version $tk_patchLevel" - } - if {[info exists ui_comm_spell] - && [$ui_comm_spell version] ne {}} { - append v "\n" - append v [$ui_comm_spell version] - } - - set d {} - append d "git wrapper: $::_git\n" - append d "git exec dir: [gitexec]\n" - append d "git-gui lib: $oguilib" - - paddedlabel $w.vers -text $v - pack $w.vers -side top -fill x -padx 5 -pady 5 - - paddedlabel $w.dirs -text $d - pack $w.dirs -side top -fill x -padx 5 -pady 5 - - menu $w.ctxm -tearoff 0 - $w.ctxm add command \ - -label {Copy} \ - -command " - clipboard clear - clipboard append -format STRING -type STRING -- \[$w.vers cget -text\] - " - - bind $w <Visibility> "grab $w; focus $w.buttons.close" - bind $w <Key-Escape> "destroy $w" - bind $w <Key-Return> "destroy $w" - bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w" - wm title $w "About [appname]" - tkwait window $w -} diff --git a/lib/blame.tcl b/lib/blame.tcl deleted file mode 100644 index b1d15f4621..0000000000 --- a/lib/blame.tcl +++ /dev/null @@ -1,1363 +0,0 @@ -# git-gui blame viewer -# Copyright (C) 2006, 2007 Shawn Pearce - -class blame { - -image create photo ::blame::img_back_arrow -data {R0lGODlhGAAYAIUAAPwCBEzKXFTSZIz+nGzmhGzqfGTidIT+nEzGXHTqhGzmfGzifFzadETCVES+VARWDFzWbHzyjAReDGTadFTOZDSyRDyyTCymPARaFGTedFzSbDy2TCyqRCyqPARaDAyCHES6VDy6VCyiPAR6HCSeNByWLARyFARiDARqFGTifARiFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAYABgAAAajQIBwSCwaj8ikcsk0BppJwRPqHEypQwHBis0WDAdEFyBIKBaMAKLBdjQeSkFBYTBAIvgEoS6JmhUTEwIUDQ4VFhcMGEhyCgoZExoUaxsWHB0THkgfAXUGAhoBDSAVFR0XBnCbDRmgog0hpSIiDJpJIyEQhBUcJCIlwA22SSYVogknEg8eD82qSigdDSknY0IqJQXPYxIl1dZCGNvWw+Dm510GQQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7} - -# Persistent data (survives loads) -# -field history {}; # viewer history: {commit path} -field header ; # array commit,key -> header field - -# Tk UI control paths -# -field w ; # top window in this viewer -field w_back ; # our back button -field w_path ; # label showing the current file path -field w_columns ; # list of all column widgets in the viewer -field w_line ; # text column: all line numbers -field w_amov ; # text column: annotations + move tracking -field w_asim ; # text column: annotations (simple computation) -field w_file ; # text column: actual file data -field w_cviewer ; # pane showing commit message -field finder ; # find mini-dialog frame -field gotoline ; # line goto mini-dialog frame -field status ; # status mega-widget instance -field old_height ; # last known height of $w.file_pane - - -# Tk UI colors -# -variable active_color #c0edc5 -variable group_colors { - #d6d6d6 - #e1e1e1 - #ececec -} - -# Current blame data; cleared/reset on each load -# -field commit ; # input commit to blame -field path ; # input filename to view in $commit - -field current_fd {} ; # background process running -field highlight_line -1 ; # current line selected -field highlight_column {} ; # current commit column selected -field highlight_commit {} ; # sha1 of commit selected - -field total_lines 0 ; # total length of file -field blame_lines 0 ; # number of lines computed -field amov_data ; # list of {commit origfile origline} -field asim_data ; # list of {commit origfile origline} - -field r_commit ; # commit currently being parsed -field r_orig_line ; # original line number -field r_final_line ; # final line number -field r_line_count ; # lines in this region - -field tooltip_wm {} ; # Current tooltip toplevel, if open -field tooltip_t {} ; # Text widget in $tooltip_wm -field tooltip_timer {} ; # Current timer event for our tooltip -field tooltip_commit {} ; # Commit(s) in tooltip - -constructor new {i_commit i_path i_jump} { - global cursor_ptr M1B M1T have_tk85 use_ttk NS - variable active_color - variable group_colors - - set commit $i_commit - set path $i_path - - make_toplevel top w - wm title $top [append "[appname] ([reponame]): " [mc "File Viewer"]] - - set font_w [font measure font_diff "0"] - - gold_frame $w.header - tlabel $w.header.commit_l \ - -text [mc "Commit:"] \ - -background gold \ - -foreground black \ - -anchor w \ - -justify left - set w_back $w.header.commit_b - tlabel $w_back \ - -image ::blame::img_back_arrow \ - -borderwidth 0 \ - -relief flat \ - -state disabled \ - -background gold \ - -foreground black \ - -activebackground gold - bind $w_back <Button-1> " - if {\[$w_back cget -state\] eq {normal}} { - [cb _history_menu] - } - " - tlabel $w.header.commit \ - -textvariable @commit \ - -background gold \ - -foreground black \ - -anchor w \ - -justify left - tlabel $w.header.path_l \ - -text [mc "File:"] \ - -background gold \ - -foreground black \ - -anchor w \ - -justify left - set w_path $w.header.path - tlabel $w_path \ - -background gold \ - -foreground black \ - -anchor w \ - -justify left - pack $w.header.commit_l -side left - pack $w_back -side left - pack $w.header.commit -side left - pack $w_path -fill x -side right - pack $w.header.path_l -side right - - panedwindow $w.file_pane -orient vertical -borderwidth 0 -sashwidth 3 - frame $w.file_pane.out -relief flat -borderwidth 1 - frame $w.file_pane.cm -relief sunken -borderwidth 1 - $w.file_pane add $w.file_pane.out \ - -sticky nsew \ - -minsize 100 \ - -height 100 \ - -width 100 - $w.file_pane add $w.file_pane.cm \ - -sticky nsew \ - -minsize 25 \ - -height 25 \ - -width 100 - - set w_line $w.file_pane.out.linenumber_t - text $w_line \ - -takefocus 0 \ - -highlightthickness 0 \ - -padx 0 -pady 0 \ - -background white \ - -foreground black \ - -borderwidth 0 \ - -state disabled \ - -wrap none \ - -height 40 \ - -width 6 \ - -font font_diff - $w_line tag conf linenumber -justify right -rmargin 5 - - set w_amov $w.file_pane.out.amove_t - text $w_amov \ - -takefocus 0 \ - -highlightthickness 0 \ - -padx 0 -pady 0 \ - -background white \ - -foreground black \ - -borderwidth 0 \ - -state disabled \ - -wrap none \ - -height 40 \ - -width 5 \ - -font font_diff - $w_amov tag conf author_abbr -justify right -rmargin 5 - $w_amov tag conf curr_commit - $w_amov tag conf prior_commit -foreground blue -underline 1 - $w_amov tag bind prior_commit \ - <Button-1> \ - "[cb _load_commit $w_amov @amov_data @%x,%y];break" - - set w_asim $w.file_pane.out.asimple_t - text $w_asim \ - -takefocus 0 \ - -highlightthickness 0 \ - -padx 0 -pady 0 \ - -background white \ - -foreground black \ - -borderwidth 0 \ - -state disabled \ - -wrap none \ - -height 40 \ - -width 4 \ - -font font_diff - $w_asim tag conf author_abbr -justify right - $w_asim tag conf curr_commit - $w_asim tag conf prior_commit -foreground blue -underline 1 - $w_asim tag bind prior_commit \ - <Button-1> \ - "[cb _load_commit $w_asim @asim_data @%x,%y];break" - - set w_file $w.file_pane.out.file_t - text $w_file \ - -takefocus 0 \ - -highlightthickness 0 \ - -padx 0 -pady 0 \ - -background white \ - -foreground black \ - -borderwidth 0 \ - -state disabled \ - -wrap none \ - -height 40 \ - -width 80 \ - -xscrollcommand [list $w.file_pane.out.sbx set] \ - -font font_diff - if {$have_tk85} { - $w_file configure -inactiveselectbackground darkblue - } - $w_file tag conf found \ - -background yellow - - set w_columns [list $w_amov $w_asim $w_line $w_file] - - ${NS}::scrollbar $w.file_pane.out.sbx \ - -orient h \ - -command [list $w_file xview] - ${NS}::scrollbar $w.file_pane.out.sby \ - -orient v \ - -command [list scrollbar2many $w_columns yview] - eval grid $w_columns $w.file_pane.out.sby -sticky nsew - grid conf \ - $w.file_pane.out.sbx \ - -column 0 \ - -columnspan [expr {[llength $w_columns] + 1}] \ - -sticky we - grid columnconfigure \ - $w.file_pane.out \ - [expr {[llength $w_columns] - 1}] \ - -weight 1 - grid rowconfigure $w.file_pane.out 0 -weight 1 - - set finder [::searchbar::new \ - $w.file_pane.out.ff $w_file \ - -column 0 \ - -columnspan [expr {[llength $w_columns] + 1}] \ - ] - - set gotoline [::linebar::new \ - $w.file_pane.out.lf $w_file \ - -column 0 \ - -columnspan [expr {[llength $w_columns] + 1}] \ - ] - - set w_cviewer $w.file_pane.cm.t - text $w_cviewer \ - -background white \ - -foreground black \ - -borderwidth 0 \ - -state disabled \ - -wrap none \ - -height 10 \ - -width 80 \ - -xscrollcommand [list $w.file_pane.cm.sbx set] \ - -yscrollcommand [list $w.file_pane.cm.sby set] \ - -font font_diff - $w_cviewer tag conf still_loading \ - -font font_uiitalic \ - -justify center - $w_cviewer tag conf header_key \ - -tabs {3c} \ - -background $active_color \ - -font font_uibold - $w_cviewer tag conf header_val \ - -background $active_color \ - -font font_ui - $w_cviewer tag raise sel - ${NS}::scrollbar $w.file_pane.cm.sbx \ - -orient h \ - -command [list $w_cviewer xview] - ${NS}::scrollbar $w.file_pane.cm.sby \ - -orient v \ - -command [list $w_cviewer yview] - pack $w.file_pane.cm.sby -side right -fill y - pack $w.file_pane.cm.sbx -side bottom -fill x - pack $w_cviewer -expand 1 -fill both - - set status [::status_bar::new $w.status] - - menu $w.ctxm -tearoff 0 - $w.ctxm add command \ - -label [mc "Copy Commit"] \ - -command [cb _copycommit] - $w.ctxm add separator - $w.ctxm add command \ - -label [mc "Find Text..."] \ - -accelerator F7 \ - -command [cb _show_finder] - $w.ctxm add command \ - -label [mc "Goto Line..."] \ - -accelerator "Ctrl-G" \ - -command [cb _show_linebar] - menu $w.ctxm.enc - build_encoding_menu $w.ctxm.enc [cb _setencoding] - $w.ctxm add cascade \ - -label [mc "Encoding"] \ - -menu $w.ctxm.enc - $w.ctxm add command \ - -label [mc "Do Full Copy Detection"] \ - -command [cb _fullcopyblame] - $w.ctxm add separator - $w.ctxm add command \ - -label [mc "Show History Context"] \ - -command [cb _gitkcommit] - $w.ctxm add command \ - -label [mc "Blame Parent Commit"] \ - -command [cb _blameparent] - - foreach i $w_columns { - for {set g 0} {$g < [llength $group_colors]} {incr g} { - $i tag conf color$g -background [lindex $group_colors $g] - } - - if {$i eq $w_file} { - $w_file tag raise found - } - $i tag raise sel - - $i conf -cursor $cursor_ptr - $i conf -yscrollcommand \ - "[list ::searchbar::scrolled $finder] - [list many2scrollbar $w_columns yview $w.file_pane.out.sby]" - bind $i <Button-1> " - [cb _hide_tooltip] - [cb _click $i @%x,%y] - focus $i - " - bind $i <Any-Motion> [cb _show_tooltip $i @%x,%y] - bind $i <Any-Enter> [cb _hide_tooltip] - bind $i <Any-Leave> [cb _hide_tooltip] - bind_button3 $i " - [cb _hide_tooltip] - set cursorX %x - set cursorY %y - set cursorW %W - tk_popup $w.ctxm %X %Y - " - bind $i <Shift-Tab> "[list focus $w_cviewer];break" - bind $i <Tab> "[cb _focus_search $w_cviewer];break" - } - - foreach i [concat $w_columns $w_cviewer] { - bind $i <Key-Up> {catch {%W yview scroll -1 units};break} - bind $i <Key-Down> {catch {%W yview scroll 1 units};break} - bind $i <Key-Left> {catch {%W xview scroll -1 units};break} - bind $i <Key-Right> {catch {%W xview scroll 1 units};break} - bind $i <Key-k> {catch {%W yview scroll -1 units};break} - bind $i <Key-j> {catch {%W yview scroll 1 units};break} - bind $i <Key-h> {catch {%W xview scroll -1 units};break} - bind $i <Key-l> {catch {%W xview scroll 1 units};break} - bind $i <Control-Key-b> {catch {%W yview scroll -1 pages};break} - bind $i <Control-Key-f> {catch {%W yview scroll 1 pages};break} - } - - bind $w_cviewer <Shift-Tab> "[cb _focus_search $w_file];break" - bind $w_cviewer <Tab> "[list focus $w_file];break" - bind $w_cviewer <Button-1> [list focus $w_cviewer] - bind $w_file <Visibility> [cb _focus_search $w_file] - bind $top <F7> [cb _show_finder] - bind $top <Key-slash> [cb _show_finder] - bind $top <Control-Key-s> [cb _show_finder] - bind $top <Escape> [list searchbar::hide $finder] - bind $top <F3> [list searchbar::find_next $finder] - bind $top <Shift-F3> [list searchbar::find_prev $finder] - bind $top <Control-Key-g> [cb _show_linebar] - catch { bind $top <Shift-Key-XF86_Switch_VT_3> [list searchbar::find_prev $finder] } - - grid configure $w.header -sticky ew - grid configure $w.file_pane -sticky nsew - grid configure $w.status -sticky ew - grid columnconfigure $top 0 -weight 1 - grid rowconfigure $top 0 -weight 0 - grid rowconfigure $top 1 -weight 1 - grid rowconfigure $top 2 -weight 0 - - set req_w [winfo reqwidth $top] - set req_h [winfo reqheight $top] - set scr_w [expr {[winfo screenwidth $top] - 40}] - set scr_h [expr {[winfo screenheight $top] - 120}] - set opt_w [expr {$font_w * (80 + 5*3 + 3)}] - if {$req_w < $opt_w} {set req_w $opt_w} - if {$req_w > $scr_w} {set req_w $scr_w} - set opt_h [expr {$req_w*4/3}] - if {$req_h < $scr_h} {set req_h $scr_h} - if {$req_h > $opt_h} {set req_h $opt_h} - set g "${req_w}x${req_h}" - wm geometry $top $g - update - - set old_height [winfo height $w.file_pane] - $w.file_pane sash place 0 \ - [lindex [$w.file_pane sash coord 0] 0] \ - [expr {int($old_height * 0.80)}] - bind $w.file_pane <Configure> \ - "if {{$w.file_pane} eq {%W}} {[cb _resize %h]}" - - wm protocol $top WM_DELETE_WINDOW "destroy $top" - bind $top <Destroy> [cb _handle_destroy %W] - - _load $this $i_jump -} - -method _focus_search {win} { - if {[searchbar::visible $finder]} { - focus [searchbar::editor $finder] - } else { - focus $win - } -} - -method _handle_destroy {win} { - if {$win eq $w} { - _kill $this - delete_this - } -} - -method _kill {} { - if {$current_fd ne {}} { - kill_file_process $current_fd - catch {close $current_fd} - set current_fd {} - } -} - -method _load {jump} { - variable group_colors - - _hide_tooltip $this - - if {$total_lines != 0 || $current_fd ne {}} { - _kill $this - - foreach i $w_columns { - $i conf -state normal - $i delete 0.0 end - foreach g [$i tag names] { - if {[regexp {^g[0-9a-f]{40}$} $g]} { - $i tag delete $g - } - } - $i conf -state disabled - } - - $w_cviewer conf -state normal - $w_cviewer delete 0.0 end - $w_cviewer conf -state disabled - - set highlight_line -1 - set highlight_column {} - set highlight_commit {} - set total_lines 0 - } - - if {$history eq {}} { - $w_back conf -state disabled - } else { - $w_back conf -state normal - } - - # Index 0 is always empty. There is never line 0 as - # we use only 1 based lines, as that matches both with - # git-blame output and with Tk's text widget. - # - set amov_data [list [list]] - set asim_data [list [list]] - - $status show [mc "Reading %s..." "$commit:[escape_path $path]"] - $w_path conf -text [escape_path $path] - - set do_textconv 0 - if {![is_config_false gui.textconv] && [git-version >= 1.7.2]} { - set filter [gitattr $path diff set] - set textconv [get_config [join [list diff $filter textconv] .]] - if {$filter ne {set} && $textconv ne {}} { - set do_textconv 1 - } - } - if {$commit eq {}} { - if {$do_textconv ne 0} { - set fd [open_cmd_pipe $textconv $path] - } else { - set fd [open $path r] - } - fconfigure $fd -eofchar {} - } else { - if {$do_textconv ne 0} { - set fd [git_read cat-file --textconv "$commit:$path"] - } else { - set fd [git_read cat-file blob "$commit:$path"] - } - } - fconfigure $fd \ - -blocking 0 \ - -translation lf \ - -encoding [get_path_encoding $path] - fileevent $fd readable [cb _read_file $fd $jump] - set current_fd $fd -} - -method _history_menu {} { - set m $w.backmenu - if {[winfo exists $m]} { - $m delete 0 end - } else { - menu $m -tearoff 0 - } - - for {set i [expr {[llength $history] - 1}] - } {$i >= 0} {incr i -1} { - set e [lindex $history $i] - set c [lindex $e 0] - set f [lindex $e 1] - - if {[regexp {^[0-9a-f]{40}$} $c]} { - set t [string range $c 0 8]... - } elseif {$c eq {}} { - set t {Working Directory} - } else { - set t $c - } - if {![catch {set summary $header($c,summary)}]} { - append t " $summary" - if {[string length $t] > 70} { - set t [string range $t 0 66]... - } - } - - $m add command -label $t -command [cb _goback $i] - } - set X [winfo rootx $w_back] - set Y [expr {[winfo rooty $w_back] + [winfo height $w_back]}] - tk_popup $m $X $Y -} - -method _goback {i} { - set dat [lindex $history $i] - set history [lrange $history 0 [expr {$i - 1}]] - set commit [lindex $dat 0] - set path [lindex $dat 1] - _load $this [lrange $dat 2 5] -} - -method _read_file {fd jump} { - if {$fd ne $current_fd} { - catch {close $fd} - return - } - - foreach i $w_columns {$i conf -state normal} - while {[gets $fd line] >= 0} { - regsub "\r\$" $line {} line - incr total_lines - lappend amov_data {} - lappend asim_data {} - - if {$total_lines > 1} { - foreach i $w_columns {$i insert end "\n"} - } - - $w_line insert end "$total_lines" linenumber - $w_file insert end "$line" - } - - set ln_wc [expr {[string length $total_lines] + 2}] - if {[$w_line cget -width] < $ln_wc} { - $w_line conf -width $ln_wc - } - - foreach i $w_columns {$i conf -state disabled} - - if {[eof $fd]} { - fconfigure $fd -blocking 1; # enable error reporting on close - if {[catch {close $fd} err]} { - tk_messageBox -icon error -title [mc Error] \ - -message $err - } - - # If we don't force Tk to update the widgets *right now* - # none of our jump commands will cause a change in the UI. - # - update - - if {[llength $jump] == 1} { - set highlight_line [lindex $jump 0] - $w_file see "$highlight_line.0" - } elseif {[llength $jump] == 4} { - set highlight_column [lindex $jump 0] - set highlight_line [lindex $jump 1] - $w_file xview moveto [lindex $jump 2] - $w_file yview moveto [lindex $jump 3] - } - - _exec_blame $this $w_asim @asim_data \ - [list] \ - [mc "Loading copy/move tracking annotations..."] - } -} ifdeleted { catch {close $fd} } - -method _exec_blame {cur_w cur_d options cur_s} { - lappend options --incremental --encoding=utf-8 - if {$commit eq {}} { - lappend options --contents $path - } else { - lappend options $commit - } - lappend options -- $path - set fd [eval git_read --nice blame $options] - fconfigure $fd -blocking 0 -translation lf -encoding utf-8 - fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d] - set current_fd $fd - set blame_lines 0 - - $status start \ - $cur_s \ - [mc "lines annotated"] -} - -method _read_blame {fd cur_w cur_d} { - upvar #0 $cur_d line_data - variable group_colors - - if {$fd ne $current_fd} { - catch {close $fd} - return - } - - $cur_w conf -state normal - while {[gets $fd line] >= 0} { - if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \ - cmit original_line final_line line_count]} { - set r_commit $cmit - set r_orig_line $original_line - set r_final_line $final_line - set r_line_count $line_count - } elseif {[string match {filename *} $line]} { - set file [string range $line 9 end] - set n $r_line_count - set lno $r_final_line - set oln $r_orig_line - set cmit $r_commit - - if {[regexp {^0{40}$} $cmit]} { - set commit_abbr work - set commit_type curr_commit - } elseif {$cmit eq $commit} { - set commit_abbr this - set commit_type curr_commit - } else { - set commit_type prior_commit - set commit_abbr [string range $cmit 0 3] - } - - set author_abbr {} - set a_name {} - catch {set a_name $header($cmit,author)} - while {$a_name ne {}} { - if {$author_abbr ne {} - && [string index $a_name 0] eq {'}} { - regsub {^'[^']+'\s+} $a_name {} a_name - } - if {![regexp {^([[:upper:]])} $a_name _a]} break - append author_abbr $_a - unset _a - if {![regsub \ - {^[[:upper:]][^\s]*\s+} \ - $a_name {} a_name ]} break - } - if {$author_abbr eq {}} { - set author_abbr { |} - } else { - set author_abbr [string range $author_abbr 0 3] - } - unset a_name - - set first_lno $lno - while { - $first_lno > 1 - && $cmit eq [lindex $line_data [expr {$first_lno - 1}] 0] - && $file eq [lindex $line_data [expr {$first_lno - 1}] 1] - } { - incr first_lno -1 - } - - set color {} - if {$first_lno < $lno} { - foreach g [$w_file tag names $first_lno.0] { - if {[regexp {^color[0-9]+$} $g]} { - set color $g - break - } - } - } else { - set i [lsort [concat \ - [$w_file tag names "[expr {$first_lno - 1}].0"] \ - [$w_file tag names "[expr {$lno + $n}].0"] \ - ]] - for {set g 0} {$g < [llength $group_colors]} {incr g} { - if {[lsearch -sorted -exact $i color$g] == -1} { - set color color$g - break - } - } - } - if {$color eq {}} { - set color color0 - } - - while {$n > 0} { - set lno_e "$lno.0 lineend + 1c" - if {[lindex $line_data $lno] ne {}} { - set g [lindex $line_data $lno 0] - foreach i $w_columns { - $i tag remove g$g $lno.0 $lno_e - } - } - lset line_data $lno [list $cmit $file $oln] - - $cur_w delete $lno.0 "$lno.0 lineend" - if {$lno == $first_lno} { - $cur_w insert $lno.0 $commit_abbr $commit_type - } elseif {$lno == [expr {$first_lno + 1}]} { - $cur_w insert $lno.0 $author_abbr author_abbr - } else { - $cur_w insert $lno.0 { |} - } - - foreach i $w_columns { - if {$cur_w eq $w_amov} { - for {set g 0} \ - {$g < [llength $group_colors]} \ - {incr g} { - $i tag remove color$g $lno.0 $lno_e - } - $i tag add $color $lno.0 $lno_e - } - $i tag add g$cmit $lno.0 $lno_e - } - - if {$highlight_column eq $cur_w} { - if {$highlight_line == -1 - && [lindex [$w_file yview] 0] == 0} { - $w_file see $lno.0 - set highlight_line $lno - } - if {$highlight_line == $lno} { - _showcommit $this $cur_w $lno - } - } - - incr n -1 - incr lno - incr oln - incr blame_lines - } - - while { - $cmit eq [lindex $line_data $lno 0] - && $file eq [lindex $line_data $lno 1] - } { - $cur_w delete $lno.0 "$lno.0 lineend" - - if {$lno == $first_lno} { - $cur_w insert $lno.0 $commit_abbr $commit_type - } elseif {$lno == [expr {$first_lno + 1}]} { - $cur_w insert $lno.0 $author_abbr author_abbr - } else { - $cur_w insert $lno.0 { |} - } - - if {$cur_w eq $w_amov} { - foreach i $w_columns { - for {set g 0} \ - {$g < [llength $group_colors]} \ - {incr g} { - $i tag remove color$g $lno.0 $lno_e - } - $i tag add $color $lno.0 $lno_e - } - } - - incr lno - } - - } elseif {[regexp {^([a-z-]+) (.*)$} $line line key data]} { - set header($r_commit,$key) $data - } - } - $cur_w conf -state disabled - - if {[eof $fd]} { - close $fd - if {$cur_w eq $w_asim} { - # Switches for original location detection - set threshold [get_config gui.copyblamethreshold] - set original_options [list "-C$threshold"] - - if {![is_config_true gui.fastcopyblame]} { - # thorough copy search; insert before the threshold - set original_options [linsert $original_options 0 -C] - } - if {[git-version >= 1.5.3]} { - lappend original_options -w ; # ignore indentation changes - } - - _exec_blame $this $w_amov @amov_data \ - $original_options \ - [mc "Loading original location annotations..."] - } else { - set current_fd {} - $status stop [mc "Annotation complete."] - } - } else { - $status update $blame_lines $total_lines - } -} ifdeleted { catch {close $fd} } - -method _find_commit_bound {data_list start_idx delta} { - upvar #0 $data_list line_data - set pos $start_idx - set limit [expr {[llength $line_data] - 1}] - set base_commit [lindex $line_data $pos 0] - - while {$pos > 0 && $pos < $limit} { - set new_pos [expr {$pos + $delta}] - if {[lindex $line_data $new_pos 0] ne $base_commit} { - return $pos - } - - set pos $new_pos - } - - return $pos -} - -method _fullcopyblame {} { - if {$current_fd ne {}} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [mc "Busy"] \ - -message [mc "Annotation process is already running."] - - return - } - - # Switches for original location detection - set threshold [get_config gui.copyblamethreshold] - set original_options [list -C -C "-C$threshold"] - - if {[git-version >= 1.5.3]} { - lappend original_options -w ; # ignore indentation changes - } - - # Find the line range - set pos @$::cursorX,$::cursorY - set lno [lindex [split [$::cursorW index $pos] .] 0] - set min_amov_lno [_find_commit_bound $this @amov_data $lno -1] - set max_amov_lno [_find_commit_bound $this @amov_data $lno 1] - set min_asim_lno [_find_commit_bound $this @asim_data $lno -1] - set max_asim_lno [_find_commit_bound $this @asim_data $lno 1] - - if {$min_asim_lno < $min_amov_lno} { - set min_amov_lno $min_asim_lno - } - - if {$max_asim_lno > $max_amov_lno} { - set max_amov_lno $max_asim_lno - } - - lappend original_options -L "$min_amov_lno,$max_amov_lno" - - # Clear lines - for {set i $min_amov_lno} {$i <= $max_amov_lno} {incr i} { - lset amov_data $i [list ] - } - - # Start the back-end process - _exec_blame $this $w_amov @amov_data \ - $original_options \ - [mc "Running thorough copy detection..."] -} - -method _click {cur_w pos} { - set lno [lindex [split [$cur_w index $pos] .] 0] - _showcommit $this $cur_w $lno -} - -method _setencoding {enc} { - force_path_encoding $path $enc - _load $this [list \ - $highlight_column \ - $highlight_line \ - [lindex [$w_file xview] 0] \ - [lindex [$w_file yview] 0] \ - ] -} - -method _load_commit {cur_w cur_d pos} { - upvar #0 $cur_d line_data - set lno [lindex [split [$cur_w index $pos] .] 0] - set dat [lindex $line_data $lno] - if {$dat ne {}} { - _load_new_commit $this \ - [lindex $dat 0] \ - [lindex $dat 1] \ - [list [lindex $dat 2]] - } -} - -method _load_new_commit {new_commit new_path jump} { - lappend history [list \ - $commit $path \ - $highlight_column \ - $highlight_line \ - [lindex [$w_file xview] 0] \ - [lindex [$w_file yview] 0] \ - ] - - set commit $new_commit - set path $new_path - _load $this $jump -} - -method _showcommit {cur_w lno} { - global repo_config - variable active_color - - if {$highlight_commit ne {}} { - foreach i $w_columns { - $i tag conf g$highlight_commit -background {} - $i tag lower g$highlight_commit - } - } - - if {$cur_w eq $w_asim} { - set dat [lindex $asim_data $lno] - set highlight_column $w_asim - } else { - set dat [lindex $amov_data $lno] - set highlight_column $w_amov - } - - $w_cviewer conf -state normal - $w_cviewer delete 0.0 end - - if {$dat eq {}} { - set cmit {} - $w_cviewer insert end [mc "Loading annotation..."] still_loading - } else { - set cmit [lindex $dat 0] - set file [lindex $dat 1] - - foreach i $w_columns { - $i tag conf g$cmit -background $active_color - $i tag raise g$cmit - if {$i eq $w_file} { - $w_file tag raise found - } - $i tag raise sel - } - - set author_name {} - set author_email {} - set author_time {} - catch {set author_name $header($cmit,author)} - catch {set author_email $header($cmit,author-mail)} - catch {set author_time [format_date $header($cmit,author-time)]} - - set committer_name {} - set committer_email {} - set committer_time {} - catch {set committer_name $header($cmit,committer)} - catch {set committer_email $header($cmit,committer-mail)} - catch {set committer_time [format_date $header($cmit,committer-time)]} - - if {[catch {set msg $header($cmit,message)}]} { - set msg {} - catch { - set fd [git_read cat-file commit $cmit] - fconfigure $fd -encoding binary -translation lf - # By default commits are assumed to be in utf-8 - set enc utf-8 - while {[gets $fd line] > 0} { - if {[string match {encoding *} $line]} { - set enc [string tolower [string range $line 9 end]] - } - } - set msg [read $fd] - close $fd - - set enc [tcl_encoding $enc] - if {$enc ne {}} { - set msg [encoding convertfrom $enc $msg] - } - set msg [string trim $msg] - } - set header($cmit,message) $msg - } - - $w_cviewer insert end "commit $cmit\n" header_key - $w_cviewer insert end [strcat [mc "Author:"] "\t"] header_key - $w_cviewer insert end "$author_name $author_email" header_val - $w_cviewer insert end " $author_time\n" header_val - - $w_cviewer insert end [strcat [mc "Committer:"] "\t"] header_key - $w_cviewer insert end "$committer_name $committer_email" header_val - $w_cviewer insert end " $committer_time\n" header_val - - if {$file ne $path} { - $w_cviewer insert end [strcat [mc "Original File:"] "\t"] header_key - $w_cviewer insert end "[escape_path $file]\n" header_val - } - - $w_cviewer insert end "\n$msg" - } - $w_cviewer conf -state disabled - - set highlight_line $lno - set highlight_commit $cmit - - if {[lsearch -exact $tooltip_commit $highlight_commit] != -1} { - _hide_tooltip $this - } -} - -method _get_click_amov_info {} { - set pos @$::cursorX,$::cursorY - set lno [lindex [split [$::cursorW index $pos] .] 0] - return [lindex $amov_data $lno] -} - -method _copycommit {} { - set dat [_get_click_amov_info $this] - if {$dat ne {}} { - clipboard clear - clipboard append \ - -format STRING \ - -type STRING \ - -- [lindex $dat 0] - } -} - -method _format_offset_date {base offset} { - set exval [expr {$base + $offset*24*60*60}] - return [clock format $exval -format {%Y-%m-%d}] -} - -method _gitkcommit {} { - global nullid - - set dat [_get_click_amov_info $this] - if {$dat ne {}} { - set cmit [lindex $dat 0] - - # If the line belongs to the working copy, use HEAD instead - if {$cmit eq $nullid} { - if {[catch {set cmit [git rev-parse --verify HEAD]} err]} { - error_popup [strcat [mc "Cannot find HEAD commit:"] "\n\n$err"] - return; - } - } - - set radius [get_config gui.blamehistoryctx] - set cmdline [list --select-commit=$cmit] - - if {$radius > 0} { - set author_time {} - set committer_time {} - - catch {set author_time $header($cmit,author-time)} - catch {set committer_time $header($cmit,committer-time)} - - if {$committer_time eq {}} { - set committer_time $author_time - } - - set after_time [_format_offset_date $this $committer_time [expr {-$radius}]] - set before_time [_format_offset_date $this $committer_time $radius] - - lappend cmdline --after=$after_time --before=$before_time - } - - lappend cmdline $cmit - - set base_rev "HEAD" - if {$commit ne {}} { - set base_rev $commit - } - - if {$base_rev ne $cmit} { - lappend cmdline $base_rev - } - - do_gitk $cmdline - } -} - -method _blameparent {} { - global nullid - - set dat [_get_click_amov_info $this] - if {$dat ne {}} { - set cmit [lindex $dat 0] - set new_path [lindex $dat 1] - - # Allow using Blame Parent on lines modified in the working copy - if {$cmit eq $nullid} { - set parent_ref "HEAD" - } else { - set parent_ref "$cmit^" - } - if {[catch {set cparent [git rev-parse --verify $parent_ref]} err]} { - error_popup [strcat [mc "Cannot find parent commit:"] "\n\n$err"] - return; - } - - _kill $this - - # Generate a diff between the commit and its parent, - # and use the hunks to update the line number. - # Request zero context to simplify calculations. - if {$cmit eq $nullid} { - set diffcmd [list diff-index --unified=0 $cparent -- $new_path] - } else { - set diffcmd [list diff-tree --unified=0 $cparent $cmit -- $new_path] - } - if {[catch {set fd [eval git_read $diffcmd]} err]} { - $status stop [mc "Unable to display parent"] - error_popup [strcat [mc "Error loading diff:"] "\n\n$err"] - return - } - - set r_orig_line [lindex $dat 2] - - fconfigure $fd \ - -blocking 0 \ - -encoding binary \ - -translation binary - fileevent $fd readable [cb _read_diff_load_commit \ - $fd $cparent $new_path $r_orig_line] - set current_fd $fd - } -} - -method _read_diff_load_commit {fd cparent new_path tline} { - if {$fd ne $current_fd} { - catch {close $fd} - return - } - - while {[gets $fd line] >= 0} { - if {[regexp {^@@ -(\d+)(,(\d+))? \+(\d+)(,(\d+))? @@} $line line \ - old_line osz old_size new_line nsz new_size]} { - - if {$osz eq {}} { set old_size 1 } - if {$nsz eq {}} { set new_size 1 } - - if {$new_line <= $tline} { - if {[expr {$new_line + $new_size}] > $tline} { - # Target line within the hunk - set line_shift [expr { - ($new_size-$old_size)*($tline-$new_line)/$new_size - }] - } else { - set line_shift [expr {$new_size-$old_size}] - } - - set r_orig_line [expr {$r_orig_line - $line_shift}] - } - } - } - - if {[eof $fd]} { - close $fd - set current_fd {} - - _load_new_commit $this \ - $cparent \ - $new_path \ - [list $r_orig_line] - } -} ifdeleted { catch {close $fd} } - -method _show_tooltip {cur_w pos} { - if {$tooltip_wm ne {}} { - _open_tooltip $this $cur_w - } elseif {$tooltip_timer eq {}} { - set tooltip_timer [after 1000 [cb _open_tooltip $cur_w]] - } -} - -method _open_tooltip {cur_w} { - set tooltip_timer {} - set pos_x [winfo pointerx $cur_w] - set pos_y [winfo pointery $cur_w] - if {[winfo containing $pos_x $pos_y] ne $cur_w} { - _hide_tooltip $this - return - } - - if {$tooltip_wm ne "$cur_w.tooltip"} { - _hide_tooltip $this - - set tooltip_wm [toplevel $cur_w.tooltip -borderwidth 1] - catch {wm attributes $tooltip_wm -type tooltip} - wm overrideredirect $tooltip_wm 1 - wm transient $tooltip_wm [winfo toplevel $cur_w] - set tooltip_t $tooltip_wm.label - text $tooltip_t \ - -takefocus 0 \ - -highlightthickness 0 \ - -relief flat \ - -borderwidth 0 \ - -wrap none \ - -background lightyellow \ - -foreground black - $tooltip_t tag conf section_header -font font_uibold - pack $tooltip_t - } else { - $tooltip_t conf -state normal - $tooltip_t delete 0.0 end - } - - set pos @[join [list \ - [expr {$pos_x - [winfo rootx $cur_w]}] \ - [expr {$pos_y - [winfo rooty $cur_w]}]] ,] - set lno [lindex [split [$cur_w index $pos] .] 0] - if {$cur_w eq $w_amov} { - set dat [lindex $amov_data $lno] - set org {} - } else { - set dat [lindex $asim_data $lno] - set org [lindex $amov_data $lno] - } - - if {$dat eq {}} { - _hide_tooltip $this - return - } - - set cmit [lindex $dat 0] - set tooltip_commit [list $cmit] - - set author_name {} - set summary {} - set author_time {} - catch {set author_name $header($cmit,author)} - catch {set summary $header($cmit,summary)} - catch {set author_time [format_date $header($cmit,author-time)]} - - $tooltip_t insert end "commit $cmit\n" - $tooltip_t insert end "$author_name $author_time\n" - $tooltip_t insert end "$summary" - - if {$org ne {} && [lindex $org 0] ne $cmit} { - set save [$tooltip_t get 0.0 end] - $tooltip_t delete 0.0 end - - set cmit [lindex $org 0] - set file [lindex $org 1] - lappend tooltip_commit $cmit - - set author_name {} - set summary {} - set author_time {} - catch {set author_name $header($cmit,author)} - catch {set summary $header($cmit,summary)} - catch {set author_time [format_date $header($cmit,author-time)]} - - $tooltip_t insert end [strcat [mc "Originally By:"] "\n"] section_header - $tooltip_t insert end "commit $cmit\n" - $tooltip_t insert end "$author_name $author_time\n" - $tooltip_t insert end "$summary\n" - - if {$file ne $path} { - $tooltip_t insert end [strcat [mc "In File:"] " "] section_header - $tooltip_t insert end "$file\n" - } - - $tooltip_t insert end "\n" - $tooltip_t insert end [strcat [mc "Copied Or Moved Here By:"] "\n"] section_header - $tooltip_t insert end $save - } - - $tooltip_t conf -state disabled - _position_tooltip $this - - # On MacOS raising a window causes it to acquire focus. - # Tk 8.5 on MacOS seems to properly support wm transient, - # so we can safely counter the effect there. - if {$::have_tk85 && [is_MacOSX]} { - update - if {$w eq {}} { - raise . - } else { - raise $w - } - } -} - -method _position_tooltip {} { - set max_h [lindex [split [$tooltip_t index end] .] 0] - set max_w 0 - for {set i 1} {$i <= $max_h} {incr i} { - set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1] - if {$c > $max_w} {set max_w $c} - } - $tooltip_t conf -width $max_w -height $max_h - - set req_w [winfo reqwidth $tooltip_t] - set req_h [winfo reqheight $tooltip_t] - set pos_x [expr {[winfo pointerx .] + 5}] - set pos_y [expr {[winfo pointery .] + 10}] - - set g "${req_w}x${req_h}" - if {[tk windowingsystem] eq "win32" || $pos_x >= 0} {append g +} - append g $pos_x - if {[tk windowingsystem] eq "win32" || $pos_y >= 0} {append g +} - append g $pos_y - - wm geometry $tooltip_wm $g - if {![is_MacOSX]} { - raise $tooltip_wm - } -} - -method _hide_tooltip {} { - if {$tooltip_wm ne {}} { - destroy $tooltip_wm - set tooltip_wm {} - set tooltip_commit {} - } - if {$tooltip_timer ne {}} { - after cancel $tooltip_timer - set tooltip_timer {} - } -} - -method _resize {new_height} { - set diff [expr {$new_height - $old_height}] - if {$diff == 0} return - - set my [expr {[winfo height $w.file_pane] - 25}] - set o [$w.file_pane sash coord 0] - set ox [lindex $o 0] - set oy [expr {[lindex $o 1] + $diff}] - if {$oy < 0} {set oy 0} - if {$oy > $my} {set oy $my} - $w.file_pane sash place 0 $ox $oy - - set old_height $new_height -} - -method _show_finder {} { - linebar::hide $gotoline - searchbar::show $finder -} - -method _show_linebar {} { - searchbar::hide $finder - linebar::show $gotoline -} - -} diff --git a/lib/branch.tcl b/lib/branch.tcl deleted file mode 100644 index 777eeb79c1..0000000000 --- a/lib/branch.tcl +++ /dev/null @@ -1,38 +0,0 @@ -# git-gui branch (create/delete) support -# Copyright (C) 2006, 2007 Shawn Pearce - -proc load_all_heads {} { - global some_heads_tracking - - set rh refs/heads - set rh_len [expr {[string length $rh] + 1}] - set all_heads [list] - set fd [git_read for-each-ref --format=%(refname) $rh] - while {[gets $fd line] > 0} { - if {!$some_heads_tracking || ![is_tracking_branch $line]} { - lappend all_heads [string range $line $rh_len end] - } - } - close $fd - - return [lsort $all_heads] -} - -proc load_all_tags {} { - set all_tags [list] - set fd [git_read for-each-ref \ - --sort=-taggerdate \ - --format=%(refname) \ - refs/tags] - while {[gets $fd line] > 0} { - if {![regsub ^refs/tags/ $line {} name]} continue - lappend all_tags $name - } - close $fd - return $all_tags -} - -proc radio_selector {varname value args} { - upvar #0 $varname var - set var $value -} diff --git a/lib/branch_checkout.tcl b/lib/branch_checkout.tcl deleted file mode 100644 index 2e459a8297..0000000000 --- a/lib/branch_checkout.tcl +++ /dev/null @@ -1,93 +0,0 @@ -# git-gui branch checkout support -# Copyright (C) 2007 Shawn Pearce - -class branch_checkout { - -field w ; # widget path -field w_rev ; # mega-widget to pick the initial revision - -field opt_fetch 1; # refetch tracking branch if used? -field opt_detach 0; # force a detached head case? - -constructor dialog {} { - global use_ttk NS - make_dialog top w - wm withdraw $w - wm title $top [append "[appname] ([reponame]): " [mc "Checkout Branch"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - ${NS}::label $w.header -text [mc "Checkout Branch"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.create -text [mc Checkout] \ - -default active \ - -command [cb _checkout] - pack $w.buttons.create -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - set w_rev [::choose_rev::new $w.rev [mc Revision]] - $w_rev bind_listbox <Double-Button-1> [cb _checkout] - pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5 - - ${NS}::labelframe $w.options -text [mc Options] - - ${NS}::checkbutton $w.options.fetch \ - -text [mc "Fetch Tracking Branch"] \ - -variable @opt_fetch - pack $w.options.fetch -anchor nw - - ${NS}::checkbutton $w.options.detach \ - -text [mc "Detach From Local Branch"] \ - -variable @opt_detach - pack $w.options.detach -anchor nw - - pack $w.options -anchor nw -fill x -pady 5 -padx 5 - - bind $w <Visibility> [cb _visible] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _checkout]\;break - wm deiconify $w - tkwait window $w -} - -method _checkout {} { - set spec [$w_rev get_tracking_branch] - if {$spec ne {} && $opt_fetch} { - set new {} - } elseif {[catch {set new [$w_rev commit_or_die]}]} { - return - } - - if {$opt_detach} { - set ref {} - } else { - set ref [$w_rev get_local_branch] - } - - set co [::checkout_op::new [$w_rev get] $new $ref] - $co parent $w - $co enable_checkout 1 - if {$spec ne {} && $opt_fetch} { - $co enable_fetch $spec - } - - if {[$co run]} { - destroy $w - } else { - $w_rev focus_filter - } -} - -method _visible {} { - grab $w - $w_rev focus_filter -} - -} diff --git a/lib/branch_create.tcl b/lib/branch_create.tcl deleted file mode 100644 index 4bb907705c..0000000000 --- a/lib/branch_create.tcl +++ /dev/null @@ -1,224 +0,0 @@ -# git-gui branch create support -# Copyright (C) 2006, 2007 Shawn Pearce - -class branch_create { - -field w ; # widget path -field w_rev ; # mega-widget to pick the initial revision -field w_name ; # new branch name widget - -field name {}; # name of the branch the user has chosen -field name_type user; # type of branch name to use - -field opt_merge ff; # type of merge to apply to existing branch -field opt_checkout 1; # automatically checkout the new branch? -field opt_fetch 1; # refetch tracking branch if used? -field reset_ok 0; # did the user agree to reset? - -constructor dialog {} { - global repo_config use_ttk NS - - make_dialog top w - wm withdraw $w - wm title $top [append "[appname] ([reponame]): " [mc "Create Branch"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - ${NS}::label $w.header -text [mc "Create New Branch"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.create -text [mc Create] \ - -default active \ - -command [cb _create] - pack $w.buttons.create -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.desc -text [mc "Branch Name"] - ${NS}::radiobutton $w.desc.name_r \ - -text [mc "Name:"] \ - -value user \ - -variable @name_type - if {!$use_ttk} {$w.desc.name_r configure -anchor w} - set w_name $w.desc.name_t - ${NS}::entry $w_name \ - -width 40 \ - -textvariable @name \ - -validate key \ - -validatecommand [cb _validate %d %S] - grid $w.desc.name_r $w_name -sticky we -padx {0 5} - - ${NS}::radiobutton $w.desc.match_r \ - -text [mc "Match Tracking Branch Name"] \ - -value match \ - -variable @name_type - if {!$use_ttk} {$w.desc.match_r configure -anchor w} - grid $w.desc.match_r -sticky we -padx {0 5} -columnspan 2 - - grid columnconfigure $w.desc 1 -weight 1 - pack $w.desc -anchor nw -fill x -pady 5 -padx 5 - - set w_rev [::choose_rev::new $w.rev [mc "Starting Revision"]] - pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5 - - ${NS}::labelframe $w.options -text [mc Options] - - ${NS}::frame $w.options.merge - ${NS}::label $w.options.merge.l -text [mc "Update Existing Branch:"] - pack $w.options.merge.l -side left - ${NS}::radiobutton $w.options.merge.no \ - -text [mc No] \ - -value none \ - -variable @opt_merge - pack $w.options.merge.no -side left - ${NS}::radiobutton $w.options.merge.ff \ - -text [mc "Fast Forward Only"] \ - -value ff \ - -variable @opt_merge - pack $w.options.merge.ff -side left - ${NS}::radiobutton $w.options.merge.reset \ - -text [mc Reset] \ - -value reset \ - -variable @opt_merge - pack $w.options.merge.reset -side left - pack $w.options.merge -anchor nw - - ${NS}::checkbutton $w.options.fetch \ - -text [mc "Fetch Tracking Branch"] \ - -variable @opt_fetch - pack $w.options.fetch -anchor nw - - ${NS}::checkbutton $w.options.checkout \ - -text [mc "Checkout After Creation"] \ - -variable @opt_checkout - pack $w.options.checkout -anchor nw - pack $w.options -anchor nw -fill x -pady 5 -padx 5 - - trace add variable @name_type write [cb _select] - - set name $repo_config(gui.newbranchtemplate) - if {[is_config_true gui.matchtrackingbranch]} { - set name_type match - } - - bind $w <Visibility> [cb _visible] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _create]\;break - wm deiconify $w - tkwait window $w -} - -method _create {} { - global repo_config - global M1B - - set spec [$w_rev get_tracking_branch] - switch -- $name_type { - user { - set newbranch $name - } - match { - if {$spec eq {}} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Please select a tracking branch."] - return - } - if {![regsub ^refs/heads/ [lindex $spec 2] {} newbranch]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Tracking branch %s is not a branch in the remote repository." [$w get]] - return - } - } - } - - if {$newbranch eq {} - || $newbranch eq $repo_config(gui.newbranchtemplate)} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Please supply a branch name."] - focus $w_name - return - } - - if {[catch {git check-ref-format "heads/$newbranch"}]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "'%s' is not an acceptable branch name." $newbranch] - focus $w_name - return - } - - if {$spec ne {} && $opt_fetch} { - set new {} - } elseif {[catch {set new [$w_rev commit_or_die]}]} { - return - } - - set co [::checkout_op::new \ - [$w_rev get] \ - $new \ - refs/heads/$newbranch] - $co parent $w - $co enable_create 1 - $co enable_merge $opt_merge - $co enable_checkout $opt_checkout - if {$spec ne {} && $opt_fetch} { - $co enable_fetch $spec - } - if {$spec ne {}} { - $co remote_source $spec - } - - if {[$co run]} { - destroy $w - } else { - focus $w_name - } -} - -method _validate {d S} { - if {$d == 1} { - if {[regexp {[~^:?*\[\0- ]} $S]} { - return 0 - } - if {[string length $S] > 0} { - set name_type user - } - } - return 1 -} - -method _select {args} { - if {$name_type eq {match}} { - $w_rev pick_tracking_branch - } -} - -method _visible {} { - grab $w - if {$name_type eq {user}} { - $w_name icursor end - focus $w_name - } -} - -} diff --git a/lib/branch_delete.tcl b/lib/branch_delete.tcl deleted file mode 100644 index 867938ec6a..0000000000 --- a/lib/branch_delete.tcl +++ /dev/null @@ -1,147 +0,0 @@ -# git-gui branch delete support -# Copyright (C) 2007 Shawn Pearce - -class branch_delete { - -field w ; # widget path -field w_heads ; # listbox of local head names -field w_check ; # revision picker for merge test -field w_delete ; # delete button - -constructor dialog {} { - global current_branch use_ttk NS - - make_dialog top w - wm withdraw $w - wm title $top [append "[appname] ([reponame]): " [mc "Delete Branch"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - ${NS}::label $w.header -text [mc "Delete Local Branch"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - set w_delete $w.buttons.delete - ${NS}::button $w_delete \ - -text [mc Delete] \ - -default active \ - -state disabled \ - -command [cb _delete] - pack $w_delete -side right - ${NS}::button $w.buttons.cancel \ - -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.list -text [mc "Local Branches"] - set w_heads $w.list.l - slistbox $w_heads \ - -height 10 \ - -width 70 \ - -selectmode extended \ - -exportselection false - pack $w.list.l -side left -fill both -expand 1 - pack $w.list -fill both -expand 1 -pady 5 -padx 5 - - set w_check [choose_rev::new \ - $w.check \ - [mc "Delete Only If Merged Into"] \ - ] - $w_check none [mc "Always (Do not perform merge checks)"] - pack $w.check -anchor nw -fill x -pady 5 -padx 5 - - foreach h [load_all_heads] { - if {$h ne $current_branch} { - $w_heads insert end $h - } - } - - bind $w_heads <<ListboxSelect>> [cb _select] - bind $w <Visibility> " - grab $w - focus $w - " - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _delete]\;break - wm deiconify $w - tkwait window $w -} - -method _select {} { - if {[$w_heads curselection] eq {}} { - $w_delete configure -state disabled - } else { - $w_delete configure -state normal - } -} - -method _delete {} { - if {[catch {set check_cmt [$w_check commit_or_die]}]} { - return - } - - set to_delete [list] - set not_merged [list] - foreach i [$w_heads curselection] { - set b [$w_heads get $i] - if {[catch { - set o [git rev-parse --verify "refs/heads/$b"] - }]} continue - if {$check_cmt ne {}} { - if {[catch {set m [git merge-base $o $check_cmt]}]} continue - if {$o ne $m} { - lappend not_merged $b - continue - } - } - lappend to_delete [list $b $o] - } - if {$not_merged ne {}} { - set msg "[mc "The following branches are not completely merged into %s:" [$w_check get]] - - - [join $not_merged "\n - "]" - tk_messageBox \ - -icon info \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message $msg - } - if {$to_delete eq {}} return - if {$check_cmt eq {}} { - set msg [mc "Recovering deleted branches is difficult.\n\nDelete the selected branches?"] - if {[tk_messageBox \ - -icon warning \ - -type yesno \ - -title [wm title $w] \ - -parent $w \ - -message $msg] ne yes} { - return - } - } - - set failed {} - foreach i $to_delete { - set b [lindex $i 0] - set o [lindex $i 1] - if {[catch {git branch -D $b} err]} { - append failed " - $b: $err\n" - } - } - - if {$failed ne {}} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Failed to delete branches:\n%s" $failed] - } - - destroy $w -} - -} diff --git a/lib/branch_rename.tcl b/lib/branch_rename.tcl deleted file mode 100644 index 6e510ec2e3..0000000000 --- a/lib/branch_rename.tcl +++ /dev/null @@ -1,134 +0,0 @@ -# git-gui branch rename support -# Copyright (C) 2007 Shawn Pearce - -class branch_rename { - -field w -field oldname -field newname - -constructor dialog {} { - global current_branch use_ttk NS - - make_dialog top w - wm withdraw $w - wm title $top [append "[appname] ([reponame]): " [mc "Rename Branch"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - set oldname $current_branch - set newname [get_config gui.newbranchtemplate] - - ${NS}::label $w.header -text [mc "Rename Branch"]\ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.rename -text [mc Rename] \ - -default active \ - -command [cb _rename] - pack $w.buttons.rename -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::frame $w.rename - ${NS}::label $w.rename.oldname_l -text [mc "Branch:"] - if {$use_ttk} { - ttk::combobox $w.rename.oldname_m -textvariable @oldname \ - -values [load_all_heads] -state readonly - } else { - eval tk_optionMenu $w.rename.oldname_m @oldname [load_all_heads] - } - - ${NS}::label $w.rename.newname_l -text [mc "New Name:"] - ${NS}::entry $w.rename.newname_t \ - -width 40 \ - -textvariable @newname \ - -validate key \ - -validatecommand { - if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0} - return 1 - } - - grid $w.rename.oldname_l $w.rename.oldname_m -sticky we -padx {0 5} - grid $w.rename.newname_l $w.rename.newname_t -sticky we -padx {0 5} - grid columnconfigure $w.rename 1 -weight 1 - pack $w.rename -anchor nw -fill x -pady 5 -padx 5 - - bind $w <Key-Return> [cb _rename] - bind $w <Key-Escape> [list destroy $w] - bind $w <Visibility> " - grab $w - $w.rename.newname_t icursor end - focus $w.rename.newname_t - " - wm deiconify $w - tkwait window $w -} - -method _rename {} { - global current_branch - - if {$oldname eq {}} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Please select a branch to rename."] - focus $w.rename.oldname_m - return - } - if {$newname eq {} - || $newname eq [get_config gui.newbranchtemplate]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Please supply a branch name."] - focus $w.rename.newname_t - return - } - if {![catch {git show-ref --verify -- "refs/heads/$newname"}]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Branch '%s' already exists." $newname] - focus $w.rename.newname_t - return - } - if {[catch {git check-ref-format "heads/$newname"}]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "'%s' is not an acceptable branch name." $newname] - focus $w.rename.newname_t - return - } - - if {[catch {git branch -m $oldname $newname} err]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [strcat [mc "Failed to rename '%s'." $oldname] "\n\n$err"] - return - } - - if {$current_branch eq $oldname} { - set current_branch $newname - } - - destroy $w -} - -} diff --git a/lib/browser.tcl b/lib/browser.tcl deleted file mode 100644 index 0328338fda..0000000000 --- a/lib/browser.tcl +++ /dev/null @@ -1,322 +0,0 @@ -# git-gui tree browser -# Copyright (C) 2006, 2007 Shawn Pearce - -class browser { - -image create photo ::browser::img_parent -data {R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=} -image create photo ::browser::img_rblob -data {R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJSWjPz+/Ozq7GxqbJyanPT29HRydMzOzDQyNIyKjERCROTi3Pz69PTy7Pzy7PTu5Ozm3LyqlJyWlJSSjJSOhOzi1LyulPz27PTq3PTm1OzezLyqjIyKhJSKfOzaxPz29OzizLyidIyGdIyCdOTOpLymhOzavOTStMTCtMS+rMS6pMSynMSulLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaQQIAQECgajcNkQMBkDgKEQFK4LFgLhkMBIVUKroWEYlEgMLxbBKLQUBwc52HgAQ4LBo049atWQyIPA3pEdFcQEhMUFYNVagQWFxgZGoxfYRsTHB0eH5UJCJAYICEinUoPIxIcHCQkIiIllQYEGCEhJicoKYwPmiQeKisrKLFKLCwtLi8wHyUlMYwM0tPUDH5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=} -image create photo ::browser::img_xblob -data {R0lGODlhEAAQAIYAAPwCBFRWVFxaXNza3OTi3Nze3Ly2tJyanPz+/Ozq7GxubNzSxMzOzMTGxHRybDQyNLy+vHRydHx6fKSipISChIyKjGxqbERCRCwuLLy6vGRiZExKTCQiJAwKDLSytLy2rJSSlHx+fDw6PKyqrBQWFPTu5Ozm3LyulLS2tCQmJAQCBPTq3Ozi1MSynCwqLAQGBOTazOzizOzezLyqjBweHNzSvOzaxKyurHRuZNzOtLymhDw+PIyCdOzWvOTOpLyidNzKtOTStLyifMTCtMS+rLyedAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfZgACCAAEChYeGg4oCAwQFjgYBBwGKggEECJkICQoIkwADCwwNDY2mDA4Lng8QDhESsLARExQVDhYXGBkWExIaGw8cHR4SCQQfFQ8eFgUgIQEiwiMSBMYfGB4atwEXDyQd0wQlJicPKAHoFyIpJCoeDgMrLC0YKBsX6i4kL+4OMDEyZijr5oLGNxUqUCioEcPGDAwjPNyI6MEDChQjcOSwsUDHgw07RIgI4KCkAgs8cvTw8eOBogAxQtXIASTISiEuBwUYMoRIixYnZggpUgTDywdIkWJIitRPIAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7} -image create photo ::browser::img_tree -data {R0lGODlhEAAQAIYAAPwCBAQCBExKTBwWHMzKzOzq7ERCRExGTCwqLARqnAQ+ZHR2dKyqrNTOzHx2fCQiJMTi9NTu9HzC3AxmnAQ+XPTm7Dy67DymzITC3IzG5AxypHRydKymrMzOzOzu7BweHByy9AyGtFyy1IzG3NTu/ARupFRSVByazBR6rAyGvFyuzJTK3MTm9BR+tAxWhHS61MTi7Pz+/IymvCxulBRelAx2rHS63Pz6/PTy9PTu9Nza3ISitBRupFSixNTS1CxqnDQyNMzGzOTi5MTCxMTGxGxubGxqbLy2vLSutGRiZLy6vLSytKyurDQuNFxaXKSipDw6PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAfDgACCAAECg4eIAAMEBQYHCImDBgkKCwwNBQIBBw4Bhw8QERITFJYEFQUFnoIPFhcYoRkaFBscHR4Ggh8gIRciEiMQJBkltCa6JyUoKSkXKhIrLCQYuQAPLS4TEyUhKb0qLzDVAjEFMjMuNBMoNcw21QY3ODkFOjs82RM1PfDzFRU3fOggcM7Fj2pAgggRokOHDx9DhhAZUqQaISBGhjwMEvEIkiIHEgUAkgSJkiNLmFSMJChAEydPGBSBwvJQgAc0/QQCACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=} -image create photo ::browser::img_symlink -data {R0lGODlhEAAQAIQAAPwCBCwqLLSytLy+vERGRFRWVDQ2NKSmpAQCBKyurMTGxISChJyanHR2dIyKjGxubHRydGRmZIyOjFxeXHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVbICACwWieY1CibCCsrBkMb0zchSEcNYskCtqBBzshFkOGQFk0IRqOxqPBODRHCMhCQKteRc9FI/KQWGOIyFYgkDC+gPR4snCcfRGKOIKIgSMQE31+f4OEYCZ+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7} -image create photo ::browser::img_unknown -data {R0lGODlhEAAQAIUAAPwCBFxaXIyKjNTW1Nze3LS2tJyanER2RGS+VPz+/PTu5GxqbPz69BQ6BCxeLFSqRPT29HRydMzOzDQyNERmPKSypCRWHIyKhERCRDyGPKz2nESiLBxGHCyCHGxubPz6/PTy7Ozi1Ly2rKSipOzm3LyqlKSWhCRyFOzizLymhNTKtNzOvOzaxOTStPz27OzWvOTOpLSupLyedMS+rMS6pMSulLyqjLymfLyifAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAamQIAQECgajcOkYEBoDgoBQyAJOCCuiENCsWBIh9aGw9F4HCARiXciRDQoBUnlYRlcIgsMG5CxXAgMGhscBRAEBRd7AB0eBBoIgxUfICEiikSPgyMMIAokJZcBkBybJgomIaBJAZoMpyCmqkMBFCcVCrgKKAwpoSorKqchKCwtvasIFBIhLiYvLzDHsxQNMcMKLDAwMqEz3jQ1NTY3ONyrE+jp6hN+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7} - -field w -field browser_commit -field browser_path -field browser_files {} -field browser_status [mc "Starting..."] -field browser_stack {} -field browser_busy 1 - -field ls_buf {}; # Buffered record output from ls-tree - -constructor new {commit {path {}}} { - global cursor_ptr M1B use_ttk NS - make_dialog top w - wm withdraw $top - wm title $top [append "[appname] ([reponame]): " [mc "File Browser"]] - - if {$path ne {}} { - if {[string index $path end] ne {/}} { - append path / - } - } - - set browser_commit $commit - set browser_path "$browser_commit:[escape_path $path]" - - ${NS}::label $w.path \ - -textvariable @browser_path \ - -anchor w \ - -justify left \ - -font font_uibold - if {!$use_ttk} { $w.path configure -borderwidth 1 -relief sunken} - pack $w.path -anchor w -side top -fill x - - ${NS}::frame $w.list - set w_list $w.list.l - text $w_list -background white -foreground black \ - -borderwidth 0 \ - -cursor $cursor_ptr \ - -state disabled \ - -wrap none \ - -height 20 \ - -width 70 \ - -xscrollcommand [list $w.list.sbx set] \ - -yscrollcommand [list $w.list.sby set] - rmsel_tag $w_list - ${NS}::scrollbar $w.list.sbx -orient h -command [list $w_list xview] - ${NS}::scrollbar $w.list.sby -orient v -command [list $w_list yview] - pack $w.list.sbx -side bottom -fill x - pack $w.list.sby -side right -fill y - pack $w_list -side left -fill both -expand 1 - pack $w.list -side top -fill both -expand 1 - - ${NS}::label $w.status \ - -textvariable @browser_status \ - -anchor w \ - -justify left - if {!$use_ttk} { $w.status configure -borderwidth 1 -relief sunken} - pack $w.status -anchor w -side bottom -fill x - - bind $w_list <Button-1> "[cb _click 0 @%x,%y];break" - bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break" - bind $w_list <$M1B-Up> "[cb _parent] ;break" - bind $w_list <$M1B-Left> "[cb _parent] ;break" - bind $w_list <Up> "[cb _move -1] ;break" - bind $w_list <Down> "[cb _move 1] ;break" - bind $w_list <$M1B-Right> "[cb _enter] ;break" - bind $w_list <Return> "[cb _enter] ;break" - bind $w_list <Prior> "[cb _page -1] ;break" - bind $w_list <Next> "[cb _page 1] ;break" - bind $w_list <Left> break - bind $w_list <Right> break - - bind $w_list <Visibility> [list focus $w_list] - wm deiconify $top - set w $w_list - if {$path ne {}} { - _ls $this $browser_commit:$path $path - } else { - _ls $this $browser_commit $path - } - return $this -} - -method _move {dir} { - if {$browser_busy} return - set lno [lindex [split [$w index in_sel.first] .] 0] - incr lno $dir - if {[lindex $browser_files [expr {$lno - 1}]] ne {}} { - $w tag remove in_sel 0.0 end - $w tag add in_sel $lno.0 [expr {$lno + 1}].0 - $w see $lno.0 - } -} - -method _page {dir} { - if {$browser_busy} return - $w yview scroll $dir pages - set lno [expr {int( - [lindex [$w yview] 0] - * [llength $browser_files] - + 1)}] - if {[lindex $browser_files [expr {$lno - 1}]] ne {}} { - $w tag remove in_sel 0.0 end - $w tag add in_sel $lno.0 [expr {$lno + 1}].0 - $w see $lno.0 - } -} - -method _parent {} { - if {$browser_busy} return - set info [lindex $browser_files 0] - if {[lindex $info 0] eq {parent}} { - set parent [lindex $browser_stack end-1] - set browser_stack [lrange $browser_stack 0 end-2] - if {$browser_stack eq {}} { - regsub {:.*$} $browser_path {:} browser_path - } else { - regsub {/[^/]+/$} $browser_path {/} browser_path - } - set browser_status [mc "Loading %s..." $browser_path] - _ls $this [lindex $parent 0] [lindex $parent 1] - } -} - -method _enter {} { - if {$browser_busy} return - set lno [lindex [split [$w index in_sel.first] .] 0] - set info [lindex $browser_files [expr {$lno - 1}]] - if {$info ne {}} { - switch -- [lindex $info 0] { - parent { - _parent $this - } - tree { - set name [lindex $info 2] - set escn [escape_path $name] - set browser_status [mc "Loading %s..." $escn] - append browser_path $escn - _ls $this [lindex $info 1] $name - } - blob { - set name [lindex $info 2] - set p {} - foreach n $browser_stack { - append p [lindex $n 1] - } - append p $name - blame::new $browser_commit $p {} - } - } - } -} - -method _click {was_double_click pos} { - if {$browser_busy} return - set lno [lindex [split [$w index $pos] .] 0] - focus $w - - if {[lindex $browser_files [expr {$lno - 1}]] ne {}} { - $w tag remove in_sel 0.0 end - $w tag add in_sel $lno.0 [expr {$lno + 1}].0 - if {$was_double_click} { - _enter $this - } - } -} - -method _ls {tree_id {name {}}} { - set ls_buf {} - set browser_files {} - set browser_busy 1 - - $w conf -state normal - $w tag remove in_sel 0.0 end - $w delete 0.0 end - if {$browser_stack ne {}} { - $w image create end \ - -align center -padx 5 -pady 1 \ - -name icon0 \ - -image ::browser::img_parent - $w insert end [mc "\[Up To Parent\]"] - lappend browser_files parent - } - lappend browser_stack [list $tree_id $name] - $w conf -state disabled - - set fd [git_read ls-tree -z $tree_id] - fconfigure $fd -blocking 0 -translation binary -encoding binary - fileevent $fd readable [cb _read $fd] -} - -method _read {fd} { - append ls_buf [read $fd] - set pck [split $ls_buf "\0"] - set ls_buf [lindex $pck end] - - set n [llength $browser_files] - $w conf -state normal - foreach p [lrange $pck 0 end-1] { - set tab [string first "\t" $p] - if {$tab == -1} continue - - set info [split [string range $p 0 [expr {$tab - 1}]] { }] - set path [string range $p [expr {$tab + 1}] end] - set type [lindex $info 1] - set object [lindex $info 2] - - switch -- $type { - blob { - scan [lindex $info 0] %o mode - if {$mode == 0120000} { - set image ::browser::img_symlink - } elseif {($mode & 0100) != 0} { - set image ::browser::img_xblob - } else { - set image ::browser::img_rblob - } - } - tree { - set image ::browser::img_tree - append path / - } - default { - set image ::browser::img_unknown - } - } - - if {$n > 0} {$w insert end "\n"} - $w image create end \ - -align center -padx 5 -pady 1 \ - -name icon[incr n] \ - -image $image - $w insert end [escape_path $path] - lappend browser_files [list $type $object $path] - } - $w conf -state disabled - - if {[eof $fd]} { - close $fd - set browser_status [mc "Ready."] - set browser_busy 0 - set ls_buf {} - if {$n > 0} { - $w tag add in_sel 1.0 2.0 - focus -force $w - } - } -} ifdeleted { - catch {close $fd} -} - -} - -class browser_open { - -field w ; # widget path -field w_rev ; # mega-widget to pick the initial revision - -constructor dialog {} { - global use_ttk NS - make_dialog top w - wm withdraw $top - wm title $top [append "[appname] ([reponame]): " [mc "Browse Branch Files"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - wm transient $top . - } - - ${NS}::label $w.header \ - -text [mc "Browse Branch Files"] \ - -font font_uibold \ - -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.browse -text [mc Browse] \ - -default active \ - -command [cb _open] - pack $w.buttons.browse -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - set w_rev [::choose_rev::new $w.rev [mc Revision]] - $w_rev bind_listbox <Double-Button-1> [cb _open] - pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5 - - bind $w <Visibility> [cb _visible] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _open]\;break - wm deiconify $top - tkwait window $w -} - -method _open {} { - if {[catch {$w_rev commit_or_die} err]} { - return - } - set name [$w_rev get] - destroy $w - browser::new $name -} - -method _visible {} { - grab $w - $w_rev focus_filter -} - -} diff --git a/lib/checkout_op.tcl b/lib/checkout_op.tcl deleted file mode 100644 index 9e7412c446..0000000000 --- a/lib/checkout_op.tcl +++ /dev/null @@ -1,645 +0,0 @@ -# git-gui commit checkout support -# Copyright (C) 2007 Shawn Pearce - -class checkout_op { - -field w {}; # our window (if we have one) -field w_cons {}; # embedded console window object - -field new_expr ; # expression the user saw/thinks this is -field new_hash ; # commit SHA-1 we are switching to -field new_ref ; # ref we are updating/creating -field old_hash ; # commit SHA-1 that was checked out when we started - -field parent_w .; # window that started us -field merge_type none; # type of merge to apply to existing branch -field merge_base {}; # merge base if we have another ref involved -field fetch_spec {}; # refetch tracking branch if used? -field checkout 1; # actually checkout the branch? -field create 0; # create the branch if it doesn't exist? -field remote_source {}; # same as fetch_spec, to setup tracking - -field reset_ok 0; # did the user agree to reset? -field fetch_ok 0; # did the fetch succeed? - -field readtree_d {}; # buffered output from read-tree -field update_old {}; # was the update-ref call deferred? -field reflog_msg {}; # log message for the update-ref call - -constructor new {expr hash {ref {}}} { - set new_expr $expr - set new_hash $hash - set new_ref $ref - - return $this -} - -method parent {path} { - set parent_w [winfo toplevel $path] -} - -method enable_merge {type} { - set merge_type $type -} - -method enable_fetch {spec} { - set fetch_spec $spec -} - -method remote_source {spec} { - set remote_source $spec -} - -method enable_checkout {co} { - set checkout $co -} - -method enable_create {co} { - set create $co -} - -method run {} { - if {$fetch_spec ne {}} { - global M1B - - # We were asked to refresh a single tracking branch - # before we get to work. We should do that before we - # consider any ref updating. - # - set fetch_ok 0 - set l_trck [lindex $fetch_spec 0] - set remote [lindex $fetch_spec 1] - set r_head [lindex $fetch_spec 2] - regsub ^refs/heads/ $r_head {} r_name - - set cmd [list git fetch $remote] - if {$l_trck ne {}} { - lappend cmd +$r_head:$l_trck - } else { - lappend cmd $r_head - } - - _toplevel $this {Refreshing Tracking Branch} - set w_cons [::console::embed \ - $w.console \ - [mc "Fetching %s from %s" $r_name $remote]] - pack $w.console -fill both -expand 1 - $w_cons exec $cmd [cb _finish_fetch] - - bind $w <$M1B-Key-w> break - bind $w <$M1B-Key-W> break - bind $w <Visibility> " - [list grab $w] - [list focus $w] - " - wm protocol $w WM_DELETE_WINDOW [cb _noop] - tkwait window $w - - if {!$fetch_ok} { - delete_this - return 0 - } - } - - if {$new_ref ne {}} { - # If we have a ref we need to update it before we can - # proceed with a checkout (if one was enabled). - # - if {![_update_ref $this]} { - delete_this - return 0 - } - } - - if {$checkout} { - _checkout $this - return 1 - } - - delete_this - return 1 -} - -method _noop {} {} - -method _finish_fetch {ok} { - if {$ok} { - set l_trck [lindex $fetch_spec 0] - if {$l_trck eq {}} { - set l_trck FETCH_HEAD - } - if {[catch {set new_hash [git rev-parse --verify "$l_trck^0"]} err]} { - set ok 0 - $w_cons insert [mc "fatal: Cannot resolve %s" $l_trck] - $w_cons insert $err - } - } - - $w_cons done $ok - set w_cons {} - wm protocol $w WM_DELETE_WINDOW {} - - if {$ok} { - destroy $w - set w {} - } else { - button $w.close -text [mc Close] -command [list destroy $w] - pack $w.close -side bottom -anchor e -padx 10 -pady 10 - } - - set fetch_ok $ok -} - -method _update_ref {} { - global null_sha1 current_branch repo_config - - set ref $new_ref - set new $new_hash - - set is_current 0 - set rh refs/heads/ - set rn [string length $rh] - if {[string equal -length $rn $rh $ref]} { - set newbranch [string range $ref $rn end] - if {$current_branch eq $newbranch} { - set is_current 1 - } - } else { - set newbranch $ref - } - - if {[catch {set cur [git rev-parse --verify "$ref^0"]}]} { - # Assume it does not exist, and that is what the error was. - # - if {!$create} { - _error $this [mc "Branch '%s' does not exist." $newbranch] - return 0 - } - - set reflog_msg "branch: Created from $new_expr" - set cur $null_sha1 - - if {($repo_config(branch.autosetupmerge) eq {true} - || $repo_config(branch.autosetupmerge) eq {always}) - && $remote_source ne {} - && "refs/heads/$newbranch" eq $ref} { - - set c_remote [lindex $remote_source 1] - set c_merge [lindex $remote_source 2] - if {[catch { - git config branch.$newbranch.remote $c_remote - git config branch.$newbranch.merge $c_merge - } err]} { - _error $this [strcat \ - [mc "Failed to configure simplified git-pull for '%s'." $newbranch] \ - "\n\n$err"] - } - } - } elseif {$create && $merge_type eq {none}} { - # We were told to create it, but not do a merge. - # Bad. Name shouldn't have existed. - # - _error $this [mc "Branch '%s' already exists." $newbranch] - return 0 - } elseif {!$create && $merge_type eq {none}} { - # We aren't creating, it exists and we don't merge. - # We are probably just a simple branch switch. - # Use whatever value we just read. - # - set new $cur - set new_hash $cur - } elseif {$new eq $cur} { - # No merge would be required, don't compute anything. - # - } else { - catch {set merge_base [git merge-base $new $cur]} - if {$merge_base eq $cur} { - # The current branch is older. - # - set reflog_msg "merge $new_expr: Fast-forward" - } else { - switch -- $merge_type { - ff { - if {$merge_base eq $new} { - # The current branch is actually newer. - # - set new $cur - set new_hash $cur - } else { - _error $this [mc "Branch '%s' already exists.\n\nIt cannot fast-forward to %s.\nA merge is required." $newbranch $new_expr] - return 0 - } - } - reset { - # The current branch will lose things. - # - if {[_confirm_reset $this $cur]} { - set reflog_msg "reset $new_expr" - } else { - return 0 - } - } - default { - _error $this [mc "Merge strategy '%s' not supported." $merge_type] - return 0 - } - } - } - } - - if {$new ne $cur} { - if {$is_current} { - # No so fast. We should defer this in case - # we cannot update the working directory. - # - set update_old $cur - return 1 - } - - if {[catch { - git update-ref -m $reflog_msg $ref $new $cur - } err]} { - _error $this [strcat [mc "Failed to update '%s'." $newbranch] "\n\n$err"] - return 0 - } - } - - return 1 -} - -method _checkout {} { - if {[lock_index checkout_op]} { - after idle [cb _start_checkout] - } else { - _error $this [mc "Staging area (index) is already locked."] - delete_this - } -} - -method _start_checkout {} { - global HEAD commit_type - - # -- Our in memory state should match the repository. - # - repository_state curType old_hash curMERGE_HEAD - if {[string match amend* $commit_type] - && $curType eq {normal} - && $old_hash eq $HEAD} { - } elseif {$commit_type ne $curType || $HEAD ne $old_hash} { - info_popup [mc "Last scanned state does not match repository state. - -Another Git program has modified this repository since the last scan. A rescan must be performed before the current branch can be changed. - -The rescan will be automatically started now. -"] - unlock_index - rescan ui_ready - delete_this - return - } - - if {$old_hash eq $new_hash} { - _after_readtree $this - } elseif {[is_config_true gui.trustmtime]} { - _readtree $this - } else { - ui_status [mc "Refreshing file status..."] - set fd [git_read update-index \ - -q \ - --unmerged \ - --ignore-missing \ - --refresh \ - ] - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [cb _refresh_wait $fd] - } -} - -method _refresh_wait {fd} { - read $fd - if {[eof $fd]} { - close $fd - _readtree $this - } -} - -method _name {} { - if {$new_ref eq {}} { - return [string range $new_hash 0 7] - } - - set rh refs/heads/ - set rn [string length $rh] - if {[string equal -length $rn $rh $new_ref]} { - return [string range $new_ref $rn end] - } else { - return $new_ref - } -} - -method _readtree {} { - global HEAD - - set readtree_d {} - $::main_status start \ - [mc "Updating working directory to '%s'..." [_name $this]] \ - [mc "files checked out"] - - set fd [git_read --stderr read-tree \ - -m \ - -u \ - -v \ - --exclude-per-directory=.gitignore \ - $HEAD \ - $new_hash \ - ] - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [cb _readtree_wait $fd] -} - -method _readtree_wait {fd} { - global current_branch - - set buf [read $fd] - $::main_status update_meter $buf - append readtree_d $buf - - fconfigure $fd -blocking 1 - if {![eof $fd]} { - fconfigure $fd -blocking 0 - return - } - - if {[catch {close $fd}]} { - set err $readtree_d - regsub {^fatal: } $err {} err - $::main_status stop [mc "Aborted checkout of '%s' (file level merging is required)." [_name $this]] - warn_popup [strcat [mc "File level merge required."] " - -$err - -" [mc "Staying on branch '%s'." $current_branch]] - unlock_index - delete_this - return - } - - $::main_status stop - _after_readtree $this -} - -method _after_readtree {} { - global selected_commit_type commit_type HEAD MERGE_HEAD PARENT - global current_branch is_detached - global ui_comm - - set name [_name $this] - set log "checkout: moving" - if {!$is_detached} { - append log " from $current_branch" - } - - # -- Move/create HEAD as a symbolic ref. Core git does not - # even check for failure here, it Just Works(tm). If it - # doesn't we are in some really ugly state that is difficult - # to recover from within git-gui. - # - set rh refs/heads/ - set rn [string length $rh] - if {[string equal -length $rn $rh $new_ref]} { - set new_branch [string range $new_ref $rn end] - if {$is_detached || $current_branch ne $new_branch} { - append log " to $new_branch" - if {[catch { - git symbolic-ref -m $log HEAD $new_ref - } err]} { - _fatal $this $err - } - set current_branch $new_branch - set is_detached 0 - } - } else { - if {!$is_detached || $new_hash ne $HEAD} { - append log " to $new_expr" - if {[catch { - _detach_HEAD $log $new_hash - } err]} { - _fatal $this $err - } - } - set current_branch HEAD - set is_detached 1 - } - - # -- We had to defer updating the branch itself until we - # knew the working directory would update. So now we - # need to finish that work. If it fails we're in big - # trouble. - # - if {$update_old ne {}} { - if {[catch { - git update-ref \ - -m $reflog_msg \ - $new_ref \ - $new_hash \ - $update_old - } err]} { - _fatal $this $err - } - } - - if {$is_detached} { - info_popup [mc "You are no longer on a local branch. - -If you wanted to be on a branch, create one now starting from 'This Detached Checkout'."] - } - - # -- Run the post-checkout hook. - # - set fd_ph [githook_read post-checkout $old_hash $new_hash 1] - if {$fd_ph ne {}} { - global pch_error - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph] - } else { - _update_repo_state $this - } -} - -method _postcheckout_wait {fd_ph} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - hook_failed_popup post-checkout $pch_error 0 - } - unset pch_error - _update_repo_state $this - return - } - fconfigure $fd_ph -blocking 0 -} - -method _update_repo_state {} { - # -- Update our repository state. If we were previously in - # amend mode we need to toss the current buffer and do a - # full rescan to update our file lists. If we weren't in - # amend mode our file lists are accurate and we can avoid - # the rescan. - # - global selected_commit_type commit_type HEAD MERGE_HEAD PARENT - global ui_comm - - unlock_index - set name [_name $this] - set selected_commit_type new - if {[string match amend* $commit_type]} { - $ui_comm delete 0.0 end - $ui_comm edit reset - $ui_comm edit modified false - rescan [list ui_status [mc "Checked out '%s'." $name]] - } else { - repository_state commit_type HEAD MERGE_HEAD - set PARENT $HEAD - ui_status [mc "Checked out '%s'." $name] - } - delete_this -} - -git-version proc _detach_HEAD {log new} { - >= 1.5.3 { - git update-ref --no-deref -m $log HEAD $new - } - default { - set p [gitdir HEAD] - file delete $p - set fd [open $p w] - fconfigure $fd -translation lf -encoding utf-8 - puts $fd $new - close $fd - } -} - -method _confirm_reset {cur} { - set reset_ok 0 - set name [_name $this] - set gitk [list do_gitk [list $cur ^$new_hash]] - - _toplevel $this {Confirm Branch Reset} - pack [label $w.msg1 \ - -anchor w \ - -justify left \ - -text [mc "Resetting '%s' to '%s' will lose the following commits:" $name $new_expr]\ - ] -anchor w - - set list $w.list.l - frame $w.list - text $list \ - -font font_diff \ - -width 80 \ - -height 10 \ - -wrap none \ - -xscrollcommand [list $w.list.sbx set] \ - -yscrollcommand [list $w.list.sby set] - scrollbar $w.list.sbx -orient h -command [list $list xview] - scrollbar $w.list.sby -orient v -command [list $list yview] - pack $w.list.sbx -fill x -side bottom - pack $w.list.sby -fill y -side right - pack $list -fill both -expand 1 - pack $w.list -fill both -expand 1 -padx 5 -pady 5 - - pack [label $w.msg2 \ - -anchor w \ - -justify left \ - -text [mc "Recovering lost commits may not be easy."] \ - ] - pack [label $w.msg3 \ - -anchor w \ - -justify left \ - -text [mc "Reset '%s'?" $name] \ - ] - - frame $w.buttons - button $w.buttons.visualize \ - -text [mc Visualize] \ - -command $gitk - pack $w.buttons.visualize -side left - button $w.buttons.reset \ - -text [mc Reset] \ - -command " - set @reset_ok 1 - destroy $w - " - pack $w.buttons.reset -side right - button $w.buttons.cancel \ - -default active \ - -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - set fd [git_read rev-list --pretty=oneline $cur ^$new_hash] - while {[gets $fd line] > 0} { - set abbr [string range $line 0 7] - set subj [string range $line 41 end] - $list insert end "$abbr $subj\n" - } - close $fd - $list configure -state disabled - - bind $w <Key-v> $gitk - bind $w <Visibility> " - grab $w - focus $w.buttons.cancel - " - bind $w <Key-Return> [list destroy $w] - bind $w <Key-Escape> [list destroy $w] - tkwait window $w - return $reset_ok -} - -method _error {msg} { - if {[winfo ismapped $parent_w]} { - set p $parent_w - } else { - set p . - } - - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $p] \ - -parent $p \ - -message $msg -} - -method _toplevel {title} { - regsub -all {::} $this {__} w - set w .$w - - if {[winfo ismapped $parent_w]} { - set p $parent_w - } else { - set p . - } - - toplevel $w - wm title $w $title - wm geometry $w "+[winfo rootx $p]+[winfo rooty $p]" -} - -method _fatal {err} { - error_popup [strcat [mc "Failed to set current branch. - -This working directory is only partially switched. We successfully updated your files, but failed to update an internal Git file. - -This should not have occurred. %s will now close and give up." [appname]] " - -$err"] - exit 1 -} - -} diff --git a/lib/choose_font.tcl b/lib/choose_font.tcl deleted file mode 100644 index ebe50bd7d0..0000000000 --- a/lib/choose_font.tcl +++ /dev/null @@ -1,171 +0,0 @@ -# git-gui font chooser -# Copyright (C) 2007 Shawn Pearce - -class choose_font { - -field w -field w_family ; # UI widget of all known family names -field w_example ; # Example to showcase the chosen font - -field f_family ; # Currently chosen family name -field f_size ; # Currently chosen point size - -field v_family ; # Name of global variable for family -field v_size ; # Name of global variable for size - -variable all_families [list] ; # All fonts known to Tk - -constructor pick {path title a_family a_size} { - variable all_families - global use_ttk NS - - set v_family $a_family - set v_size $a_size - - upvar #0 $v_family pv_family - upvar #0 $v_size pv_size - - set f_family $pv_family - set f_size $pv_size - - make_dialog top w - wm withdraw $top - wm title $top "[appname] ([reponame]): $title" - wm geometry $top "+[winfo rootx $path]+[winfo rooty $path]" - - ${NS}::label $w.header -text $title -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.select \ - -text [mc Select] \ - -default active \ - -command [cb _select] - ${NS}::button $w.buttons.cancel \ - -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.select -side right - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::frame $w.inner - - ${NS}::frame $w.inner.family - ${NS}::label $w.inner.family.l \ - -text [mc "Font Family"] \ - -anchor w - set w_family $w.inner.family.v - text $w_family \ - -background white \ - -foreground black \ - -borderwidth 1 \ - -relief sunken \ - -cursor $::cursor_ptr \ - -wrap none \ - -width 30 \ - -height 10 \ - -yscrollcommand [list $w.inner.family.sby set] - rmsel_tag $w_family - ${NS}::scrollbar $w.inner.family.sby -command [list $w_family yview] - pack $w.inner.family.l -side top -fill x - pack $w.inner.family.sby -side right -fill y - pack $w_family -fill both -expand 1 - - ${NS}::frame $w.inner.size - ${NS}::label $w.inner.size.l \ - -text [mc "Font Size"] \ - -anchor w - tspinbox $w.inner.size.v \ - -textvariable @f_size \ - -from 2 -to 80 -increment 1 \ - -width 3 - bind $w.inner.size.v <FocusIn> {%W selection range 0 end} - pack $w.inner.size.l -fill x -side top - pack $w.inner.size.v -fill x -padx 2 - - grid configure $w.inner.family $w.inner.size -sticky nsew - grid rowconfigure $w.inner 0 -weight 1 - grid columnconfigure $w.inner 0 -weight 1 - pack $w.inner -fill both -expand 1 -padx 5 -pady 5 - - ${NS}::frame $w.example - ${NS}::label $w.example.l \ - -text [mc "Font Example"] \ - -anchor w - set w_example $w.example.t - text $w_example \ - -background white \ - -foreground black \ - -borderwidth 1 \ - -relief sunken \ - -height 3 \ - -width 40 - rmsel_tag $w_example - $w_example tag conf example -justify center - $w_example insert end [mc "This is example text.\nIf you like this text, it can be your font."] example - $w_example conf -state disabled - pack $w.example.l -fill x - pack $w_example -fill x - pack $w.example -fill x -padx 5 - - if {$all_families eq {}} { - set all_families [lsort [font families]] - } - - $w_family tag conf pick - $w_family tag bind pick <Button-1> [cb _pick_family %x %y]\;break - foreach f $all_families { - set sel [list pick] - if {$f eq $f_family} { - lappend sel in_sel - } - $w_family insert end "$f\n" $sel - } - $w_family conf -state disabled - _update $this - - trace add variable @f_size write [cb _update] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _select]\;break - bind $w <Visibility> " - grab $w - focus $w - " - wm deiconify $w - tkwait window $w -} - -method _select {} { - upvar #0 $v_family pv_family - upvar #0 $v_size pv_size - - set pv_family $f_family - set pv_size $f_size - - destroy $w -} - -method _pick_family {x y} { - variable all_families - - set i [lindex [split [$w_family index @$x,$y] .] 0] - set n [lindex $all_families [expr {$i - 1}]] - if {$n ne {}} { - $w_family tag remove in_sel 0.0 end - $w_family tag add in_sel $i.0 [expr {$i + 1}].0 - set f_family $n - _update $this - } -} - -method _update {args} { - variable all_families - - set i [lsearch -exact $all_families $f_family] - if {$i < 0} return - - $w_example tag conf example -font [list $f_family $f_size] - $w_family see [expr {$i + 1}].0 -} - -} diff --git a/lib/choose_repository.tcl b/lib/choose_repository.tcl deleted file mode 100644 index 75d1da8d31..0000000000 --- a/lib/choose_repository.tcl +++ /dev/null @@ -1,1129 +0,0 @@ -# git-gui Git repository chooser -# Copyright (C) 2007 Shawn Pearce - -class choose_repository { - -field top -field w -field w_body ; # Widget holding the center content -field w_next ; # Next button -field w_quit ; # Quit button -field o_cons ; # Console object (if active) -field w_types ; # List of type buttons in clone -field w_recentlist ; # Listbox containing recent repositories -field w_localpath ; # Entry widget bound to local_path - -field done 0 ; # Finished picking the repository? -field local_path {} ; # Where this repository is locally -field origin_url {} ; # Where we are cloning from -field origin_name origin ; # What we shall call 'origin' -field clone_type hardlink ; # Type of clone to construct -field recursive true ; # Recursive cloning flag -field readtree_err ; # Error output from read-tree (if any) -field sorted_recent ; # recent repositories (sorted) - -constructor pick {} { - global M1T M1B use_ttk NS - - if {[set maxrecent [get_config gui.maxrecentrepo]] eq {}} { - set maxrecent 10 - } - - make_dialog top w - wm title $top [mc "Git Gui"] - - if {$top eq {.}} { - menu $w.mbar -tearoff 0 - $top configure -menu $w.mbar - - set m_repo $w.mbar.repository - $w.mbar add cascade \ - -label [mc Repository] \ - -menu $m_repo - menu $m_repo - - if {[is_MacOSX]} { - $w.mbar add cascade -label Apple -menu .mbar.apple - menu $w.mbar.apple - $w.mbar.apple add command \ - -label [mc "About %s" [appname]] \ - -command do_about - $w.mbar.apple add command \ - -label [mc "Show SSH Key"] \ - -command do_ssh_key - } else { - $w.mbar add cascade -label [mc Help] -menu $w.mbar.help - menu $w.mbar.help - $w.mbar.help add command \ - -label [mc "About %s" [appname]] \ - -command do_about - $w.mbar.help add command \ - -label [mc "Show SSH Key"] \ - -command do_ssh_key - } - - wm protocol $top WM_DELETE_WINDOW exit - bind $top <$M1B-q> exit - bind $top <$M1B-Q> exit - bind $top <Key-Escape> exit - } else { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - bind $top <Key-Escape> [list destroy $top] - set m_repo {} - } - - pack [git_logo $w.git_logo] -side left -fill y -padx 10 -pady 10 - - set w_body $w.body - set opts $w_body.options - ${NS}::frame $w_body - text $opts \ - -cursor $::cursor_ptr \ - -relief flat \ - -background [get_bg_color $w_body] \ - -wrap none \ - -spacing1 5 \ - -width 50 \ - -height 3 - pack $opts -anchor w -fill x - - $opts tag conf link_new -foreground blue -underline 1 - $opts tag bind link_new <1> [cb _next new] - $opts insert end [mc "Create New Repository"] link_new - $opts insert end "\n" - if {$m_repo ne {}} { - $m_repo add command \ - -command [cb _next new] \ - -accelerator $M1T-N \ - -label [mc "New..."] - bind $top <$M1B-n> [cb _next new] - bind $top <$M1B-N> [cb _next new] - } - - $opts tag conf link_clone -foreground blue -underline 1 - $opts tag bind link_clone <1> [cb _next clone] - $opts insert end [mc "Clone Existing Repository"] link_clone - $opts insert end "\n" - if {$m_repo ne {}} { - if {[tk windowingsystem] eq "win32"} { - set key L - } else { - set key C - } - $m_repo add command \ - -command [cb _next clone] \ - -accelerator $M1T-$key \ - -label [mc "Clone..."] - bind $top <$M1B-[string tolower $key]> [cb _next clone] - bind $top <$M1B-[string toupper $key]> [cb _next clone] - } - - $opts tag conf link_open -foreground blue -underline 1 - $opts tag bind link_open <1> [cb _next open] - $opts insert end [mc "Open Existing Repository"] link_open - $opts insert end "\n" - if {$m_repo ne {}} { - $m_repo add command \ - -command [cb _next open] \ - -accelerator $M1T-O \ - -label [mc "Open..."] - bind $top <$M1B-o> [cb _next open] - bind $top <$M1B-O> [cb _next open] - } - - $opts conf -state disabled - - set sorted_recent [_get_recentrepos] - if {[llength $sorted_recent] > 0} { - if {$m_repo ne {}} { - $m_repo add separator - $m_repo add command \ - -state disabled \ - -label [mc "Recent Repositories"] - } - - ${NS}::label $w_body.space - ${NS}::label $w_body.recentlabel \ - -anchor w \ - -text [mc "Open Recent Repository:"] - set w_recentlist $w_body.recentlist - text $w_recentlist \ - -cursor $::cursor_ptr \ - -relief flat \ - -background [get_bg_color $w_body.recentlabel] \ - -wrap none \ - -width 50 \ - -height $maxrecent - $w_recentlist tag conf link \ - -foreground blue \ - -underline 1 - set home $::env(HOME) - if {[is_Cygwin]} { - set home [exec cygpath --windows --absolute $home] - } - set home "[file normalize $home]/" - set hlen [string length $home] - foreach p $sorted_recent { - set path $p - if {[string equal -length $hlen $home $p]} { - set p "~/[string range $p $hlen end]" - } - regsub -all "\n" $p "\\n" p - $w_recentlist insert end $p link - $w_recentlist insert end "\n" - - if {$m_repo ne {}} { - $m_repo add command \ - -command [cb _open_recent_path $path] \ - -label " $p" - } - } - $w_recentlist conf -state disabled - $w_recentlist tag bind link <1> [cb _open_recent %x,%y] - pack $w_body.space -anchor w -fill x - pack $w_body.recentlabel -anchor w -fill x - pack $w_recentlist -anchor w -fill x - } - pack $w_body -fill x -padx 10 -pady 10 - - ${NS}::frame $w.buttons - set w_next $w.buttons.next - set w_quit $w.buttons.quit - ${NS}::button $w_quit \ - -text [mc "Quit"] \ - -command exit - pack $w_quit -side right -padx 5 - pack $w.buttons -side bottom -fill x -padx 10 -pady 10 - - if {$m_repo ne {}} { - $m_repo add separator - $m_repo add command \ - -label [mc Quit] \ - -command exit \ - -accelerator $M1T-Q - } - - bind $top <Return> [cb _invoke_next] - bind $top <Visibility> " - [cb _center] - grab $top - focus $top - bind $top <Visibility> {} - " - wm deiconify $top - tkwait variable @done - - grab release $top - if {$top eq {.}} { - eval destroy [winfo children $top] - } -} - -method _center {} { - set nx [winfo reqwidth $top] - set ny [winfo reqheight $top] - set rx [expr {([winfo screenwidth $top] - $nx) / 3}] - set ry [expr {([winfo screenheight $top] - $ny) / 3}] - wm geometry $top [format {+%d+%d} $rx $ry] -} - -method _invoke_next {} { - if {[winfo exists $w_next]} { - uplevel #0 [$w_next cget -command] - } -} - -proc _get_recentrepos {} { - set recent [list] - foreach p [get_config gui.recentrepo] { - if {[_is_git [file join $p .git]]} { - lappend recent $p - } else { - _unset_recentrepo $p - } - } - return [lsort $recent] -} - -proc _unset_recentrepo {p} { - regsub -all -- {([()\[\]{}\.^$+*?\\])} $p {\\\1} p - git config --global --unset gui.recentrepo "^$p\$" - load_config 1 -} - -proc _append_recentrepos {path} { - set path [file normalize $path] - set recent [get_config gui.recentrepo] - - if {[lindex $recent end] eq $path} { - return - } - - set i [lsearch $recent $path] - if {$i >= 0} { - _unset_recentrepo $path - set recent [lreplace $recent $i $i] - } - - lappend recent $path - git config --global --add gui.recentrepo $path - load_config 1 - - if {[set maxrecent [get_config gui.maxrecentrepo]] eq {}} { - set maxrecent 10 - } - - while {[llength $recent] > $maxrecent} { - _unset_recentrepo [lindex $recent 0] - set recent [lrange $recent 1 end] - } -} - -method _open_recent {xy} { - set id [lindex [split [$w_recentlist index @$xy] .] 0] - set local_path [lindex $sorted_recent [expr {$id - 1}]] - _do_open2 $this -} - -method _open_recent_path {p} { - set local_path $p - _do_open2 $this -} - -method _next {action} { - global NS - destroy $w_body - if {![winfo exists $w_next]} { - ${NS}::button $w_next -default active - set pos -before - if {[tk windowingsystem] eq "win32"} { set pos -after } - pack $w_next -side right -padx 5 $pos $w_quit - } - _do_$action $this -} - -method _write_local_path {args} { - if {$local_path eq {}} { - $w_next conf -state disabled - } else { - $w_next conf -state normal - } -} - -method _git_init {} { - if {[catch {file mkdir $local_path} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - - if {[catch {cd $local_path} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - - if {[catch {git init} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - - _append_recentrepos [pwd] - set ::_gitdir .git - set ::_prefix {} - return 1 -} - -proc _is_git {path {outdir_var ""}} { - if {$outdir_var ne ""} { - upvar 1 $outdir_var outdir - } - if {[file isfile $path]} { - set fp [open $path r] - gets $fp line - close $fp - if {[regexp "^gitdir: (.+)$" $line line link_target]} { - set path [file join [file dirname $path] $link_target] - set path [file normalize $path] - } - } - - if {[file exists [file join $path HEAD]] - && [file exists [file join $path objects]] - && [file exists [file join $path config]]} { - set outdir $path - return 1 - } - if {[is_Cygwin]} { - if {[file exists [file join $path HEAD]] - && [file exists [file join $path objects.lnk]] - && [file exists [file join $path config.lnk]]} { - set outdir $path - return 1 - } - } - return 0 -} - -proc _objdir {path} { - set objdir [file join $path .git objects] - if {[file isdirectory $objdir]} { - return $objdir - } - - set objdir [file join $path objects] - if {[file isdirectory $objdir]} { - return $objdir - } - - if {[is_Cygwin]} { - set objdir [file join $path .git objects.lnk] - if {[file isfile $objdir]} { - return [win32_read_lnk $objdir] - } - - set objdir [file join $path objects.lnk] - if {[file isfile $objdir]} { - return [win32_read_lnk $objdir] - } - } - - return {} -} - -###################################################################### -## -## Create New Repository - -method _do_new {} { - global use_ttk NS - $w_next conf \ - -state disabled \ - -command [cb _do_new2] \ - -text [mc "Create"] - - ${NS}::frame $w_body - ${NS}::label $w_body.h \ - -font font_uibold -anchor center \ - -text [mc "Create New Repository"] - pack $w_body.h -side top -fill x -pady 10 - pack $w_body -fill x -padx 10 - - ${NS}::frame $w_body.where - ${NS}::label $w_body.where.l -text [mc "Directory:"] - ${NS}::entry $w_body.where.t \ - -textvariable @local_path \ - -width 50 - ${NS}::button $w_body.where.b \ - -text [mc "Browse"] \ - -command [cb _new_local_path] - set w_localpath $w_body.where.t - - grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew - pack $w_body.where -fill x - - grid columnconfigure $w_body.where 1 -weight 1 - - trace add variable @local_path write [cb _write_local_path] - bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] - update - focus $w_body.where.t -} - -method _new_local_path {} { - if {$local_path ne {}} { - set p [file dirname $local_path] - } else { - set p [pwd] - } - - set p [tk_chooseDirectory \ - -initialdir $p \ - -parent $top \ - -title [mc "Git Repository"] \ - -mustexist false] - if {$p eq {}} return - - set p [file normalize $p] - if {![_new_ok $p]} { - return - } - set local_path $p - $w_localpath icursor end -} - -method _do_new2 {} { - if {![_new_ok $local_path]} { - return - } - if {![_git_init $this]} { - return - } - set done 1 -} - -proc _new_ok {p} { - if {[file isdirectory $p]} { - if {[_is_git [file join $p .git]]} { - error_popup [mc "Directory %s already exists." $p] - return 0 - } - } elseif {[file exists $p]} { - error_popup [mc "File %s already exists." $p] - return 0 - } - return 1 -} - -###################################################################### -## -## Clone Existing Repository - -method _do_clone {} { - global use_ttk NS - $w_next conf \ - -state disabled \ - -command [cb _do_clone2] \ - -text [mc "Clone"] - - ${NS}::frame $w_body - ${NS}::label $w_body.h \ - -font font_uibold -anchor center \ - -text [mc "Clone Existing Repository"] - pack $w_body.h -side top -fill x -pady 10 - pack $w_body -fill x -padx 10 - - set args $w_body.args - ${NS}::frame $w_body.args - pack $args -fill both - - ${NS}::label $args.origin_l -text [mc "Source Location:"] - ${NS}::entry $args.origin_t \ - -textvariable @origin_url \ - -width 50 - ${NS}::button $args.origin_b \ - -text [mc "Browse"] \ - -command [cb _open_origin] - grid $args.origin_l $args.origin_t $args.origin_b -sticky ew - - ${NS}::label $args.where_l -text [mc "Target Directory:"] - ${NS}::entry $args.where_t \ - -textvariable @local_path \ - -width 50 - ${NS}::button $args.where_b \ - -text [mc "Browse"] \ - -command [cb _new_local_path] - grid $args.where_l $args.where_t $args.where_b -sticky ew - set w_localpath $args.where_t - - ${NS}::label $args.type_l -text [mc "Clone Type:"] - ${NS}::frame $args.type_f - set w_types [list] - lappend w_types [${NS}::radiobutton $args.type_f.hardlink \ - -state disabled \ - -text [mc "Standard (Fast, Semi-Redundant, Hardlinks)"] \ - -variable @clone_type \ - -value hardlink] - lappend w_types [${NS}::radiobutton $args.type_f.full \ - -state disabled \ - -text [mc "Full Copy (Slower, Redundant Backup)"] \ - -variable @clone_type \ - -value full] - lappend w_types [${NS}::radiobutton $args.type_f.shared \ - -state disabled \ - -text [mc "Shared (Fastest, Not Recommended, No Backup)"] \ - -variable @clone_type \ - -value shared] - foreach r $w_types { - pack $r -anchor w - } - ${NS}::checkbutton $args.type_f.recursive \ - -text [mc "Recursively clone submodules too"] \ - -variable @recursive \ - -onvalue true -offvalue false - pack $args.type_f.recursive -anchor w - grid $args.type_l $args.type_f -sticky new - - grid columnconfigure $args 1 -weight 1 - - trace add variable @local_path write [cb _update_clone] - trace add variable @origin_url write [cb _update_clone] - bind $w_body.h <Destroy> " - [list trace remove variable @local_path write [cb _update_clone]] - [list trace remove variable @origin_url write [cb _update_clone]] - " - update - focus $args.origin_t -} - -method _open_origin {} { - if {$origin_url ne {} && [file isdirectory $origin_url]} { - set p $origin_url - } else { - set p [pwd] - } - - set p [tk_chooseDirectory \ - -initialdir $p \ - -parent $top \ - -title [mc "Git Repository"] \ - -mustexist true] - if {$p eq {}} return - - set p [file normalize $p] - if {![_is_git [file join $p .git]] && ![_is_git $p]} { - error_popup [mc "Not a Git repository: %s" [file tail $p]] - return - } - set origin_url $p -} - -method _update_clone {args} { - if {$local_path ne {} && $origin_url ne {}} { - $w_next conf -state normal - } else { - $w_next conf -state disabled - } - - if {$origin_url ne {} && - ( [_is_git [file join $origin_url .git]] - || [_is_git $origin_url])} { - set e normal - if {[[lindex $w_types 0] cget -state] eq {disabled}} { - set clone_type hardlink - } - } else { - set e disabled - set clone_type full - } - - foreach r $w_types { - $r conf -state $e - } -} - -method _do_clone2 {} { - if {[file isdirectory $origin_url]} { - set origin_url [file normalize $origin_url] - } - - if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} { - error_popup [mc "Standard only available for local repository."] - return - } - if {$clone_type eq {shared} && ![file isdirectory $origin_url]} { - error_popup [mc "Shared only available for local repository."] - return - } - - if {$clone_type eq {hardlink} || $clone_type eq {shared}} { - set objdir [_objdir $origin_url] - if {$objdir eq {}} { - error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] - return - } - } - - set giturl $origin_url - if {[is_Cygwin] && [file isdirectory $giturl]} { - set giturl [exec cygpath --unix --absolute $giturl] - if {$clone_type eq {shared}} { - set objdir [exec cygpath --unix --absolute $objdir] - } - } - - if {[file exists $local_path]} { - error_popup [mc "Location %s already exists." $local_path] - return - } - - if {![_git_init $this]} return - set local_path [pwd] - - if {[catch { - git config remote.$origin_name.url $giturl - git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/* - } err]} { - error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"] - return - } - - destroy $w_body $w_next - - switch -exact -- $clone_type { - hardlink { - set o_cons [status_bar::two_line $w_body] - pack $w_body -fill x -padx 10 -pady 10 - - $o_cons start \ - [mc "Counting objects"] \ - [mc "buckets"] - update - - if {[file exists [file join $objdir info alternates]]} { - set pwd [pwd] - if {[catch { - file mkdir [gitdir objects info] - set f_in [open [file join $objdir info alternates] r] - set f_cp [open [gitdir objects info alternates] w] - fconfigure $f_in -translation binary -encoding binary - fconfigure $f_cp -translation binary -encoding binary - cd $objdir - while {[gets $f_in line] >= 0} { - if {[is_Cygwin]} { - puts $f_cp [exec cygpath --unix --absolute $line] - } else { - puts $f_cp [file normalize $line] - } - } - close $f_in - close $f_cp - cd $pwd - } err]} { - catch {cd $pwd} - _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] - return - } - } - - set tolink [list] - set buckets [glob \ - -tails \ - -nocomplain \ - -directory [file join $objdir] ??] - set bcnt [expr {[llength $buckets] + 2}] - set bcur 1 - $o_cons update $bcur $bcnt - update - - file mkdir [file join .git objects pack] - foreach i [glob -tails -nocomplain \ - -directory [file join $objdir pack] *] { - lappend tolink [file join pack $i] - } - $o_cons update [incr bcur] $bcnt - update - - foreach i $buckets { - file mkdir [file join .git objects $i] - foreach j [glob -tails -nocomplain \ - -directory [file join $objdir $i] *] { - lappend tolink [file join $i $j] - } - $o_cons update [incr bcur] $bcnt - update - } - $o_cons stop - - if {$tolink eq {}} { - info_popup [strcat \ - [mc "Nothing to clone from %s." $origin_url] \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - destroy $w_body - set done 1 - return - } - - set i [lindex $tolink 0] - if {[catch { - file link -hard \ - [file join .git objects $i] \ - [file join $objdir $i] - } err]} { - info_popup [mc "Hardlinks are unavailable. Falling back to copying."] - set i [_copy_files $this $objdir $tolink] - } else { - set i [_link_files $this $objdir [lrange $tolink 1 end]] - } - if {!$i} return - - destroy $w_body - } - full { - set o_cons [console::embed \ - $w_body \ - [mc "Cloning from %s" $origin_url]] - pack $w_body -fill both -expand 1 -padx 10 - $o_cons exec \ - [list git fetch --no-tags -k $origin_name] \ - [cb _do_clone_tags] - } - shared { - set fd [open [gitdir objects info alternates] w] - fconfigure $fd -translation binary - puts $fd $objdir - close $fd - } - } - - if {$clone_type eq {hardlink} || $clone_type eq {shared}} { - if {![_clone_refs $this]} return - set pwd [pwd] - if {[catch { - cd $origin_url - set HEAD [git rev-parse --verify HEAD^0] - } err]} { - _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]] - return 0 - } - cd $pwd - _do_clone_checkout $this $HEAD - } -} - -method _copy_files {objdir tocopy} { - $o_cons start \ - [mc "Copying objects"] \ - [mc "KiB"] - set tot 0 - set cmp 0 - foreach p $tocopy { - incr tot [file size [file join $objdir $p]] - } - foreach p $tocopy { - if {[catch { - set f_in [open [file join $objdir $p] r] - set f_cp [open [file join .git objects $p] w] - fconfigure $f_in -translation binary -encoding binary - fconfigure $f_cp -translation binary -encoding binary - - while {![eof $f_in]} { - incr cmp [fcopy $f_in $f_cp -size 16384] - $o_cons update \ - [expr {$cmp / 1024}] \ - [expr {$tot / 1024}] - update - } - - close $f_in - close $f_cp - } err]} { - _clone_failed $this [mc "Unable to copy object: %s" $err] - return 0 - } - } - return 1 -} - -method _link_files {objdir tolink} { - set total [llength $tolink] - $o_cons start \ - [mc "Linking objects"] \ - [mc "objects"] - for {set i 0} {$i < $total} {} { - set p [lindex $tolink $i] - if {[catch { - file link -hard \ - [file join .git objects $p] \ - [file join $objdir $p] - } err]} { - _clone_failed $this [mc "Unable to hardlink object: %s" $err] - return 0 - } - - incr i - if {$i % 5 == 0} { - $o_cons update $i $total - update - } - } - return 1 -} - -method _clone_refs {} { - set pwd [pwd] - if {[catch {cd $origin_url} err]} { - error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] - return 0 - } - set fd_in [git_read for-each-ref \ - --tcl \ - {--format=list %(refname) %(objectname) %(*objectname)}] - cd $pwd - - set fd [open [gitdir packed-refs] w] - fconfigure $fd -translation binary - puts $fd "# pack-refs with: peeled" - while {[gets $fd_in line] >= 0} { - set line [eval $line] - set refn [lindex $line 0] - set robj [lindex $line 1] - set tobj [lindex $line 2] - - if {[regsub ^refs/heads/ $refn \ - "refs/remotes/$origin_name/" refn]} { - puts $fd "$robj $refn" - } elseif {[string match refs/tags/* $refn]} { - puts $fd "$robj $refn" - if {$tobj ne {}} { - puts $fd "^$tobj" - } - } - } - close $fd_in - close $fd - return 1 -} - -method _do_clone_tags {ok} { - if {$ok} { - $o_cons exec \ - [list git fetch --tags -k $origin_name] \ - [cb _do_clone_HEAD] - } else { - $o_cons done $ok - _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."] - } -} - -method _do_clone_HEAD {ok} { - if {$ok} { - $o_cons exec \ - [list git fetch $origin_name HEAD] \ - [cb _do_clone_full_end] - } else { - $o_cons done $ok - _clone_failed $this [mc "Cannot fetch tags. See console output for details."] - } -} - -method _do_clone_full_end {ok} { - $o_cons done $ok - - if {$ok} { - destroy $w_body - - set HEAD {} - if {[file exists [gitdir FETCH_HEAD]]} { - set fd [open [gitdir FETCH_HEAD] r] - while {[gets $fd line] >= 0} { - if {[regexp "^(.{40})\t\t" $line line HEAD]} { - break - } - } - close $fd - } - - catch {git pack-refs} - _do_clone_checkout $this $HEAD - } else { - _clone_failed $this [mc "Cannot determine HEAD. See console output for details."] - } -} - -method _clone_failed {{why {}}} { - if {[catch {file delete -force $local_path} err]} { - set why [strcat \ - $why \ - "\n\n" \ - [mc "Unable to cleanup %s" $local_path] \ - "\n\n" \ - $err] - } - if {$why ne {}} { - update - error_popup [strcat [mc "Clone failed."] "\n" $why] - } -} - -method _do_clone_checkout {HEAD} { - if {$HEAD eq {}} { - info_popup [strcat \ - [mc "No default branch obtained."] \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - set done 1 - return - } - if {[catch { - git update-ref HEAD $HEAD^0 - } err]} { - info_popup [strcat \ - [mc "Cannot resolve %s as a commit." $HEAD^0] \ - "\n $err" \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - set done 1 - return - } - - set o_cons [status_bar::two_line $w_body] - pack $w_body -fill x -padx 10 -pady 10 - $o_cons start \ - [mc "Creating working directory"] \ - [mc "files"] - - set readtree_err {} - set fd [git_read --stderr read-tree \ - -m \ - -u \ - -v \ - HEAD \ - HEAD \ - ] - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [cb _readtree_wait $fd] -} - -method _do_validate_submodule_cloning {ok} { - if {$ok} { - $o_cons done $ok - set done 1 - } else { - _clone_failed $this [mc "Cannot clone submodules."] - } -} - -method _do_clone_submodules {} { - if {$recursive eq {true}} { - destroy $w_body - set o_cons [console::embed \ - $w_body \ - [mc "Cloning submodules"]] - pack $w_body -fill both -expand 1 -padx 10 - $o_cons exec \ - [list git submodule update --init --recursive] \ - [cb _do_validate_submodule_cloning] - } else { - set done 1 - } -} - -method _readtree_wait {fd} { - set buf [read $fd] - $o_cons update_meter $buf - append readtree_err $buf - - fconfigure $fd -blocking 1 - if {![eof $fd]} { - fconfigure $fd -blocking 0 - return - } - - if {[catch {close $fd}]} { - set err $readtree_err - regsub {^fatal: } $err {} err - error_popup [strcat \ - [mc "Initial file checkout failed."] \ - "\n\n$err"] - return - } - - # -- Run the post-checkout hook. - # - set fd_ph [githook_read post-checkout [string repeat 0 40] \ - [git rev-parse HEAD] 1] - if {$fd_ph ne {}} { - global pch_error - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph] - } else { - _do_clone_submodules $this - } -} - -method _postcheckout_wait {fd_ph} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - hook_failed_popup post-checkout $pch_error 0 - } - unset pch_error - _do_clone_submodules $this - return - } - fconfigure $fd_ph -blocking 0 -} - -###################################################################### -## -## Open Existing Repository - -method _do_open {} { - global NS - $w_next conf \ - -state disabled \ - -command [cb _do_open2] \ - -text [mc "Open"] - - ${NS}::frame $w_body - ${NS}::label $w_body.h \ - -font font_uibold -anchor center \ - -text [mc "Open Existing Repository"] - pack $w_body.h -side top -fill x -pady 10 - pack $w_body -fill x -padx 10 - - ${NS}::frame $w_body.where - ${NS}::label $w_body.where.l -text [mc "Repository:"] - ${NS}::entry $w_body.where.t \ - -textvariable @local_path \ - -width 50 - ${NS}::button $w_body.where.b \ - -text [mc "Browse"] \ - -command [cb _open_local_path] - - grid $w_body.where.l $w_body.where.t $w_body.where.b -sticky ew - pack $w_body.where -fill x - - grid columnconfigure $w_body.where 1 -weight 1 - - trace add variable @local_path write [cb _write_local_path] - bind $w_body.h <Destroy> [list trace remove variable @local_path write [cb _write_local_path]] - update - focus $w_body.where.t -} - -method _open_local_path {} { - if {$local_path ne {}} { - set p $local_path - } else { - set p [pwd] - } - - set p [tk_chooseDirectory \ - -initialdir $p \ - -parent $top \ - -title [mc "Git Repository"] \ - -mustexist true] - if {$p eq {}} return - - set p [file normalize $p] - if {![_is_git [file join $p .git]]} { - error_popup [mc "Not a Git repository: %s" [file tail $p]] - return - } - set local_path $p -} - -method _do_open2 {} { - if {![_is_git [file join $local_path .git] actualgit]} { - error_popup [mc "Not a Git repository: %s" [file tail $local_path]] - return - } - - if {[catch {cd $local_path} err]} { - error_popup [strcat \ - [mc "Failed to open repository %s:" $local_path] \ - "\n\n$err"] - return - } - - _append_recentrepos [pwd] - set ::_gitdir $actualgit - set ::_prefix {} - set done 1 -} - -} diff --git a/lib/choose_rev.tcl b/lib/choose_rev.tcl deleted file mode 100644 index 6dae7937d5..0000000000 --- a/lib/choose_rev.tcl +++ /dev/null @@ -1,634 +0,0 @@ -# git-gui revision chooser -# Copyright (C) 2006, 2007 Shawn Pearce - -class choose_rev { - -image create photo ::choose_rev::img_find -data {R0lGODlhEAAQAIYAAPwCBCQmJDw+PBQSFAQCBMza3NTm5MTW1HyChOT29Ozq7MTq7Kze5Kzm7Oz6/NTy9Iza5GzGzKzS1Nzy9Nz29Kzq9HTGzHTK1Lza3AwKDLzu9JTi7HTW5GTCzITO1Mzq7Hza5FTK1ESyvHzKzKzW3DQyNDyqtDw6PIzW5HzGzAT+/Dw+RKyurNTOzMTGxMS+tJSGdATCxHRydLSqpLymnLSijBweHERCRNze3Pz69PTy9Oze1OTSxOTGrMSqlLy+vPTu5OzSvMymjNTGvNS+tMy2pMyunMSefAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAe4gACCAAECA4OIiAIEBQYHBAKJgwIICQoLDA0IkZIECQ4PCxARCwSSAxITFA8VEBYXGBmJAQYLGhUbHB0eH7KIGRIMEBAgISIjJKaIJQQLFxERIialkieUGigpKRoIBCqJKyyLBwvJAioEyoICLS4v6QQwMQQyLuqLli8zNDU2BCf1lN3AkUPHDh49fAQAAEnGD1MCCALZEaSHkIUMBQS8wWMIkSJGhBzBmFEGgRsBUqpMiSgdAD+BAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7} - -field w ; # our megawidget path -field w_list ; # list of currently filtered specs -field w_filter ; # filter entry for $w_list - -field c_expr {}; # current revision expression -field filter ""; # current filter string -field revtype head; # type of revision chosen -field cur_specs [list]; # list of specs for $revtype -field spec_head ; # list of all head specs -field spec_trck ; # list of all tracking branch specs -field spec_tag ; # list of all tag specs -field tip_data ; # array of tip commit info by refname -field log_last ; # array of reflog date by refname - -field tooltip_wm {} ; # Current tooltip toplevel, if open -field tooltip_t {} ; # Text widget in $tooltip_wm -field tooltip_timer {} ; # Current timer event for our tooltip - -proc new {path {title {}}} { - return [_new $path 0 $title] -} - -proc new_unmerged {path {title {}}} { - return [_new $path 1 $title] -} - -constructor _new {path unmerged_only title} { - global current_branch is_detached use_ttk NS - - if {![info exists ::all_remotes]} { - load_all_remotes - } - - set w $path - - if {$title ne {}} { - ${NS}::labelframe $w -text $title - } else { - ${NS}::frame $w - } - bind $w <Destroy> [cb _delete %W] - - if {$is_detached} { - ${NS}::radiobutton $w.detachedhead_r \ - -text [mc "This Detached Checkout"] \ - -value HEAD \ - -variable @revtype - if {!$use_ttk} {$w.detachedhead_r configure -anchor w} - grid $w.detachedhead_r -sticky we -padx {0 5} -columnspan 2 - } - - ${NS}::radiobutton $w.expr_r \ - -text [mc "Revision Expression:"] \ - -value expr \ - -variable @revtype - ${NS}::entry $w.expr_t \ - -width 50 \ - -textvariable @c_expr \ - -validate key \ - -validatecommand [cb _validate %d %S] - grid $w.expr_r $w.expr_t -sticky we -padx {0 5} - - ${NS}::frame $w.types - ${NS}::radiobutton $w.types.head_r \ - -text [mc "Local Branch"] \ - -value head \ - -variable @revtype - pack $w.types.head_r -side left - ${NS}::radiobutton $w.types.trck_r \ - -text [mc "Tracking Branch"] \ - -value trck \ - -variable @revtype - pack $w.types.trck_r -side left - ${NS}::radiobutton $w.types.tag_r \ - -text [mc "Tag"] \ - -value tag \ - -variable @revtype - pack $w.types.tag_r -side left - set w_filter $w.types.filter - ${NS}::entry $w_filter \ - -width 12 \ - -textvariable @filter \ - -validate key \ - -validatecommand [cb _filter %P] - pack $w_filter -side right - pack [${NS}::label $w.types.filter_icon \ - -image ::choose_rev::img_find \ - ] -side right - grid $w.types -sticky we -padx {0 5} -columnspan 2 - - if {$use_ttk} { - ttk::frame $w.list -style SListbox.TFrame -padding 2 - } else { - frame $w.list - } - set w_list $w.list.l - listbox $w_list \ - -font font_diff \ - -width 50 \ - -height 10 \ - -selectmode browse \ - -exportselection false \ - -xscrollcommand [cb _sb_set $w.list.sbx h] \ - -yscrollcommand [cb _sb_set $w.list.sby v] - if {$use_ttk} { - $w_list configure -relief flat -highlightthickness 0 -borderwidth 0 - } - pack $w_list -fill both -expand 1 - grid $w.list -sticky nswe -padx {20 5} -columnspan 2 - bind $w_list <Any-Motion> [cb _show_tooltip @%x,%y] - bind $w_list <Any-Enter> [cb _hide_tooltip] - bind $w_list <Any-Leave> [cb _hide_tooltip] - bind $w_list <Destroy> [cb _hide_tooltip] - - grid columnconfigure $w 1 -weight 1 - if {$is_detached} { - grid rowconfigure $w 3 -weight 1 - } else { - grid rowconfigure $w 2 -weight 1 - } - - trace add variable @revtype write [cb _select] - bind $w_filter <Key-Return> [list focus $w_list]\;break - bind $w_filter <Key-Down> [list focus $w_list] - - set fmt list - append fmt { %(refname)} - append fmt { [list} - append fmt { %(objecttype)} - append fmt { %(objectname)} - append fmt { [concat %(taggername) %(authorname)]} - append fmt { [reformat_date [concat %(taggerdate) %(authordate)]]} - append fmt { %(subject)} - append fmt {] [list} - append fmt { %(*objecttype)} - append fmt { %(*objectname)} - append fmt { %(*authorname)} - append fmt { [reformat_date %(*authordate)]} - append fmt { %(*subject)} - append fmt {]} - set all_refn [list] - set fr_fd [git_read for-each-ref \ - --tcl \ - --sort=-taggerdate \ - --format=$fmt \ - refs/heads \ - refs/remotes \ - refs/tags \ - ] - fconfigure $fr_fd -translation lf -encoding utf-8 - while {[gets $fr_fd line] > 0} { - set line [eval $line] - if {[lindex $line 1 0] eq {tag}} { - if {[lindex $line 2 0] eq {commit}} { - set sha1 [lindex $line 2 1] - } else { - continue - } - } elseif {[lindex $line 1 0] eq {commit}} { - set sha1 [lindex $line 1 1] - } else { - continue - } - set refn [lindex $line 0] - set tip_data($refn) [lrange $line 1 end] - lappend cmt_refn($sha1) $refn - lappend all_refn $refn - } - close $fr_fd - - if {$unmerged_only} { - set fr_fd [git_read rev-list --all ^$::HEAD] - while {[gets $fr_fd sha1] > 0} { - if {[catch {set rlst $cmt_refn($sha1)}]} continue - foreach refn $rlst { - set inc($refn) 1 - } - } - close $fr_fd - } else { - foreach refn $all_refn { - set inc($refn) 1 - } - } - - set spec_head [list] - foreach name [load_all_heads] { - set refn refs/heads/$name - if {[info exists inc($refn)]} { - lappend spec_head [list $name $refn] - } - } - - set spec_trck [list] - foreach spec [all_tracking_branches] { - set refn [lindex $spec 0] - if {[info exists inc($refn)]} { - regsub ^refs/(heads|remotes)/ $refn {} name - lappend spec_trck [concat $name $spec] - } - } - - set spec_tag [list] - foreach name [load_all_tags] { - set refn refs/tags/$name - if {[info exists inc($refn)]} { - lappend spec_tag [list $name $refn] - } - } - - if {$is_detached} { set revtype HEAD - } elseif {[llength $spec_head] > 0} { set revtype head - } elseif {[llength $spec_trck] > 0} { set revtype trck - } elseif {[llength $spec_tag ] > 0} { set revtype tag - } else { set revtype expr - } - - if {$revtype eq {head} && $current_branch ne {}} { - set i 0 - foreach spec $spec_head { - if {[lindex $spec 0] eq $current_branch} { - $w_list selection clear 0 end - $w_list selection set $i - break - } - incr i - } - } - - return $this -} - -method none {text} { - global NS use_ttk - if {![winfo exists $w.none_r]} { - ${NS}::radiobutton $w.none_r \ - -value none \ - -variable @revtype - if {!$use_ttk} {$w.none_r configure -anchor w} - grid $w.none_r -sticky we -padx {0 5} -columnspan 2 - } - $w.none_r configure -text $text -} - -method get {} { - switch -- $revtype { - head - - trck - - tag { - set i [$w_list curselection] - if {$i ne {}} { - return [lindex $cur_specs $i 0] - } else { - return {} - } - } - - HEAD { return HEAD } - expr { return $c_expr } - none { return {} } - default { error "unknown type of revision" } - } -} - -method pick_tracking_branch {} { - set revtype trck -} - -method focus_filter {} { - if {[$w_filter cget -state] eq {normal}} { - focus $w_filter - } -} - -method bind_listbox {event script} { - bind $w_list $event $script -} - -method get_local_branch {} { - if {$revtype eq {head}} { - return [_expr $this] - } else { - return {} - } -} - -method get_tracking_branch {} { - set i [$w_list curselection] - if {$i eq {} || $revtype ne {trck}} { - return {} - } - return [lrange [lindex $cur_specs $i] 1 end] -} - -method get_commit {} { - set e [_expr $this] - if {$e eq {}} { - return {} - } - return [git rev-parse --verify "$e^0"] -} - -method commit_or_die {} { - if {[catch {set new [get_commit $this]} err]} { - - # Cleanup the not-so-friendly error from rev-parse. - # - regsub {^fatal:\s*} $err {} err - if {$err eq {Needed a single revision}} { - set err {} - } - - set top [winfo toplevel $w] - set msg [strcat [mc "Invalid revision: %s" [get $this]] "\n\n$err"] - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $top] \ - -parent $top \ - -message $msg - error $msg - } - return $new -} - -method _expr {} { - switch -- $revtype { - head - - trck - - tag { - set i [$w_list curselection] - if {$i ne {}} { - return [lindex $cur_specs $i 1] - } else { - error [mc "No revision selected."] - } - } - - expr { - if {$c_expr ne {}} { - return $c_expr - } else { - error [mc "Revision expression is empty."] - } - } - HEAD { return HEAD } - none { return {} } - default { error "unknown type of revision" } - } -} - -method _validate {d S} { - if {$d == 1} { - if {[regexp {\s} $S]} { - return 0 - } - if {[string length $S] > 0} { - set revtype expr - } - } - return 1 -} - -method _filter {P} { - if {[regexp {\s} $P]} { - return 0 - } - _rebuild $this $P - return 1 -} - -method _select {args} { - _rebuild $this $filter - focus_filter $this -} - -method _rebuild {pat} { - set ste normal - switch -- $revtype { - head { set new $spec_head } - trck { set new $spec_trck } - tag { set new $spec_tag } - expr - - HEAD - - none { - set new [list] - set ste disabled - } - } - - if {[$w_list cget -state] eq {disabled}} { - $w_list configure -state normal - } - $w_list delete 0 end - - if {$pat ne {}} { - set pat *${pat}* - } - set cur_specs [list] - foreach spec $new { - set txt [lindex $spec 0] - if {$pat eq {} || [string match $pat $txt]} { - lappend cur_specs $spec - $w_list insert end $txt - } - } - if {$cur_specs ne {}} { - $w_list selection clear 0 end - $w_list selection set 0 - } - - if {[$w_filter cget -state] ne $ste} { - $w_list configure -state $ste - $w_filter configure -state $ste - } -} - -method _delete {current} { - if {$current eq $w} { - delete_this - } -} - -method _sb_set {sb orient first last} { - global NS - set old_focus [focus -lastfor $w] - - if {$first == 0 && $last == 1} { - if {[winfo exists $sb]} { - destroy $sb - if {$old_focus ne {}} { - update - focus $old_focus - } - } - return - } - - if {![winfo exists $sb]} { - if {$orient eq {h}} { - ${NS}::scrollbar $sb -orient h -command [list $w_list xview] - pack $sb -fill x -side bottom -before $w_list - } else { - ${NS}::scrollbar $sb -orient v -command [list $w_list yview] - pack $sb -fill y -side right -before $w_list - } - if {$old_focus ne {}} { - update - focus $old_focus - } - } - - catch {$sb set $first $last} -} - -method _show_tooltip {pos} { - if {$tooltip_wm ne {}} { - _open_tooltip $this - } elseif {$tooltip_timer eq {}} { - set tooltip_timer [after 1000 [cb _open_tooltip]] - } -} - -method _open_tooltip {} { - global remote_url - - set tooltip_timer {} - set pos_x [winfo pointerx $w_list] - set pos_y [winfo pointery $w_list] - if {[winfo containing $pos_x $pos_y] ne $w_list} { - _hide_tooltip $this - return - } - - set pos @[join [list \ - [expr {$pos_x - [winfo rootx $w_list]}] \ - [expr {$pos_y - [winfo rooty $w_list]}]] ,] - set lno [$w_list index $pos] - if {$lno eq {}} { - _hide_tooltip $this - return - } - - set spec [lindex $cur_specs $lno] - set refn [lindex $spec 1] - if {$refn eq {}} { - _hide_tooltip $this - return - } - - if {$tooltip_wm eq {}} { - set tooltip_wm [toplevel $w_list.tooltip -borderwidth 1] - catch {wm attributes $tooltip_wm -type tooltip} - wm overrideredirect $tooltip_wm 1 - wm transient $tooltip_wm [winfo toplevel $w_list] - set tooltip_t $tooltip_wm.label - text $tooltip_t \ - -takefocus 0 \ - -highlightthickness 0 \ - -relief flat \ - -borderwidth 0 \ - -wrap none \ - -background lightyellow \ - -foreground black - $tooltip_t tag conf section_header -font font_uibold - bind $tooltip_wm <Escape> [cb _hide_tooltip] - pack $tooltip_t - } else { - $tooltip_t conf -state normal - $tooltip_t delete 0.0 end - } - - set data $tip_data($refn) - if {[lindex $data 0 0] eq {tag}} { - set tag [lindex $data 0] - if {[lindex $data 1 0] eq {commit}} { - set cmit [lindex $data 1] - } else { - set cmit {} - } - } elseif {[lindex $data 0 0] eq {commit}} { - set tag {} - set cmit [lindex $data 0] - } - - $tooltip_t insert end [lindex $spec 0] - set last [_reflog_last $this [lindex $spec 1]] - if {$last ne {}} { - $tooltip_t insert end "\n" - $tooltip_t insert end [mc "Updated"] - $tooltip_t insert end " $last" - } - $tooltip_t insert end "\n" - - if {$tag ne {}} { - $tooltip_t insert end "\n" - $tooltip_t insert end [mc "Tag"] section_header - $tooltip_t insert end " [lindex $tag 1]\n" - $tooltip_t insert end [lindex $tag 2] - $tooltip_t insert end " ([lindex $tag 3])\n" - $tooltip_t insert end [lindex $tag 4] - $tooltip_t insert end "\n" - } - - if {$cmit ne {}} { - $tooltip_t insert end "\n" - $tooltip_t insert end [mc "Commit@@noun"] section_header - $tooltip_t insert end " [lindex $cmit 1]\n" - $tooltip_t insert end [lindex $cmit 2] - $tooltip_t insert end " ([lindex $cmit 3])\n" - $tooltip_t insert end [lindex $cmit 4] - } - - if {[llength $spec] > 2} { - $tooltip_t insert end "\n" - $tooltip_t insert end [mc "Remote"] section_header - $tooltip_t insert end " [lindex $spec 2]\n" - $tooltip_t insert end [mc "URL"] - $tooltip_t insert end " $remote_url([lindex $spec 2])\n" - $tooltip_t insert end [mc "Branch"] - $tooltip_t insert end " [lindex $spec 3]" - } - - $tooltip_t conf -state disabled - _position_tooltip $this -} - -method _reflog_last {name} { - if {[info exists reflog_last($name)]} { - return reflog_last($name) - } - - set last {} - if {[catch {set last [file mtime [gitdir $name]]}] - && ![catch {set g [open [gitdir logs $name] r]}]} { - fconfigure $g -translation binary - while {[gets $g line] >= 0} { - if {[regexp {> ([1-9][0-9]*) } $line line when]} { - set last $when - } - } - close $g - } - - if {$last ne {}} { - set last [format_date $last] - } - set reflog_last($name) $last - return $last -} - -method _position_tooltip {} { - set max_h [lindex [split [$tooltip_t index end] .] 0] - set max_w 0 - for {set i 1} {$i <= $max_h} {incr i} { - set c [lindex [split [$tooltip_t index "$i.0 lineend"] .] 1] - if {$c > $max_w} {set max_w $c} - } - $tooltip_t conf -width $max_w -height $max_h - - set req_w [winfo reqwidth $tooltip_t] - set req_h [winfo reqheight $tooltip_t] - set pos_x [expr {[winfo pointerx .] + 5}] - set pos_y [expr {[winfo pointery .] + 10}] - - set g "${req_w}x${req_h}" - if {[tk windowingsystem] eq "win32" || $pos_x >= 0} {append g +} - append g $pos_x - if {[tk windowingsystem] eq "win32" || $pos_y >= 0} {append g +} - append g $pos_y - - wm geometry $tooltip_wm $g - raise $tooltip_wm -} - -method _hide_tooltip {} { - if {$tooltip_wm ne {}} { - destroy $tooltip_wm - set tooltip_wm {} - } - if {$tooltip_timer ne {}} { - after cancel $tooltip_timer - set tooltip_timer {} - } -} - -} diff --git a/lib/class.tcl b/lib/class.tcl deleted file mode 100644 index f08506f383..0000000000 --- a/lib/class.tcl +++ /dev/null @@ -1,194 +0,0 @@ -# git-gui simple class/object fake-alike -# Copyright (C) 2007 Shawn Pearce - -proc class {class body} { - if {[namespace exists $class]} { - error "class $class already declared" - } - namespace eval $class " - variable __nextid 0 - variable __sealed 0 - variable __field_list {} - variable __field_array - - proc cb {name args} { - upvar this this - concat \[list ${class}::\$name \$this\] \$args - } - " - namespace eval $class $body -} - -proc field {name args} { - set class [uplevel {namespace current}] - variable ${class}::__sealed - variable ${class}::__field_array - - switch [llength $args] { - 0 { set new [list $name] } - 1 { set new [list $name [lindex $args 0]] } - default { error "wrong # args: field name value?" } - } - - if {$__sealed} { - error "class $class is sealed (cannot add new fields)" - } - - if {[catch {set old $__field_array($name)}]} { - variable ${class}::__field_list - lappend __field_list $new - set __field_array($name) 1 - } else { - error "field $name already declared" - } -} - -proc constructor {name params body} { - set class [uplevel {namespace current}] - set ${class}::__sealed 1 - variable ${class}::__field_list - set mbodyc {} - - append mbodyc {set this } $class - append mbodyc {::__o[incr } $class {::__nextid]::__d} \; - append mbodyc {create_this } $class \; - append mbodyc {set __this [namespace qualifiers $this]} \; - - if {$__field_list ne {}} { - append mbodyc {upvar #0} - foreach n $__field_list { - set n [lindex $n 0] - append mbodyc { ${__this}::} $n { } $n - regsub -all @$n\\M $body "\${__this}::$n" body - } - append mbodyc \; - foreach n $__field_list { - if {[llength $n] == 2} { - append mbodyc \ - {set } [lindex $n 0] { } [list [lindex $n 1]] \; - } - } - } - append mbodyc $body - namespace eval $class [list proc $name $params $mbodyc] -} - -proc method {name params body {deleted {}} {del_body {}}} { - set class [uplevel {namespace current}] - set ${class}::__sealed 1 - variable ${class}::__field_list - set params [linsert $params 0 this] - set mbodyc {} - - append mbodyc {set __this [namespace qualifiers $this]} \; - - switch $deleted { - {} {} - ifdeleted { - append mbodyc {if {![namespace exists $__this]} } - append mbodyc \{ $del_body \; return \} \; - } - default { - error "wrong # args: method name args body (ifdeleted body)?" - } - } - - set decl {} - foreach n $__field_list { - set n [lindex $n 0] - if {[regexp -- $n\\M $body]} { - if { [regexp -all -- $n\\M $body] == 1 - && [regexp -all -- \\\$$n\\M $body] == 1 - && [regexp -all -- \\\$$n\\( $body] == 0} { - regsub -all \ - \\\$$n\\M $body \ - "\[set \${__this}::$n\]" body - } else { - append decl { ${__this}::} $n { } $n - regsub -all @$n\\M $body "\${__this}::$n" body - } - } - } - if {$decl ne {}} { - append mbodyc {upvar #0} $decl \; - } - append mbodyc $body - namespace eval $class [list proc $name $params $mbodyc] -} - -proc create_this {class} { - upvar this this - namespace eval [namespace qualifiers $this] [list proc \ - [namespace tail $this] \ - [list name args] \ - "eval \[list ${class}::\$name $this\] \$args" \ - ] -} - -proc delete_this {{t {}}} { - if {$t eq {}} { - upvar this this - set t $this - } - set t [namespace qualifiers $t] - if {[namespace exists $t]} {namespace delete $t} -} - -proc make_dialog {t w args} { - upvar $t top $w pfx this this - global use_ttk - uplevel [linsert $args 0 make_toplevel $t $w] - catch {wm attributes $top -type dialog} - pave_toplevel $pfx -} - -proc make_toplevel {t w args} { - upvar $t top $w pfx this this - - if {[llength $args] % 2} { - error "make_toplevel topvar winvar {options}" - } - set autodelete 1 - foreach {name value} $args { - switch -exact -- $name { - -autodelete {set autodelete $value} - default {error "unsupported option $name"} - } - } - - if {$::root_exists || [winfo ismapped .]} { - regsub -all {::} $this {__} w - set top .$w - set pfx $top - toplevel $top - set ::root_exists 1 - } else { - set top . - set pfx {} - } - - if {$autodelete} { - wm protocol $top WM_DELETE_WINDOW " - [list delete_this $this] - [list destroy $top] - " - } -} - - -## auto_mkindex support for class/constructor/method -## -auto_mkindex_parser::command class {name body} { - variable parser - variable contextStack - set contextStack [linsert $contextStack 0 $name] - $parser eval [list _%@namespace eval $name] $body - set contextStack [lrange $contextStack 1 end] -} -auto_mkindex_parser::command constructor {name args} { - variable index - variable scriptFile - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" -} diff --git a/lib/commit.tcl b/lib/commit.tcl deleted file mode 100644 index 864b687057..0000000000 --- a/lib/commit.tcl +++ /dev/null @@ -1,508 +0,0 @@ -# git-gui misc. commit reading/writing support -# Copyright (C) 2006, 2007 Shawn Pearce - -proc load_last_commit {} { - global HEAD PARENT MERGE_HEAD commit_type ui_comm - global repo_config - - if {[llength $PARENT] == 0} { - error_popup [mc "There is nothing to amend. - -You are about to create the initial commit. There is no commit before this to amend. -"] - return - } - - repository_state curType curHEAD curMERGE_HEAD - if {$curType eq {merge}} { - error_popup [mc "Cannot amend while merging. - -You are currently in the middle of a merge that has not been fully completed. You cannot amend the prior commit unless you first abort the current merge activity. -"] - return - } - - set msg {} - set parents [list] - if {[catch { - set fd [git_read cat-file commit $curHEAD] - fconfigure $fd -encoding binary -translation lf - # By default commits are assumed to be in utf-8 - set enc utf-8 - while {[gets $fd line] > 0} { - if {[string match {parent *} $line]} { - lappend parents [string range $line 7 end] - } elseif {[string match {encoding *} $line]} { - set enc [string tolower [string range $line 9 end]] - } - } - set msg [read $fd] - close $fd - - set enc [tcl_encoding $enc] - if {$enc ne {}} { - set msg [encoding convertfrom $enc $msg] - } - set msg [string trim $msg] - } err]} { - error_popup [strcat [mc "Error loading commit data for amend:"] "\n\n$err"] - return - } - - set HEAD $curHEAD - set PARENT $parents - set MERGE_HEAD [list] - switch -- [llength $parents] { - 0 {set commit_type amend-initial} - 1 {set commit_type amend} - default {set commit_type amend-merge} - } - - $ui_comm delete 0.0 end - $ui_comm insert end $msg - $ui_comm edit reset - $ui_comm edit modified false - rescan ui_ready -} - -set GIT_COMMITTER_IDENT {} - -proc committer_ident {} { - global GIT_COMMITTER_IDENT - - if {$GIT_COMMITTER_IDENT eq {}} { - if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} { - error_popup [strcat [mc "Unable to obtain your identity:"] "\n\n$err"] - return {} - } - if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \ - $me me GIT_COMMITTER_IDENT]} { - error_popup [strcat [mc "Invalid GIT_COMMITTER_IDENT:"] "\n\n$me"] - return {} - } - } - - return $GIT_COMMITTER_IDENT -} - -proc do_signoff {} { - global ui_comm - - set me [committer_ident] - if {$me eq {}} return - - set sob "Signed-off-by: $me" - set last [$ui_comm get {end -1c linestart} {end -1c}] - if {$last ne $sob} { - $ui_comm edit separator - if {$last ne {} - && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} { - $ui_comm insert end "\n" - } - $ui_comm insert end "\n$sob" - $ui_comm edit separator - $ui_comm see end - } -} - -proc create_new_commit {} { - global commit_type ui_comm - - set commit_type normal - $ui_comm delete 0.0 end - $ui_comm edit reset - $ui_comm edit modified false - rescan ui_ready -} - -proc setup_commit_encoding {msg_wt {quiet 0}} { - global repo_config - - if {[catch {set enc $repo_config(i18n.commitencoding)}]} { - set enc utf-8 - } - set use_enc [tcl_encoding $enc] - if {$use_enc ne {}} { - fconfigure $msg_wt -encoding $use_enc - } else { - if {!$quiet} { - error_popup [mc "warning: Tcl does not support encoding '%s'." $enc] - } - fconfigure $msg_wt -encoding utf-8 - } -} - -proc commit_tree {} { - global HEAD commit_type file_states ui_comm repo_config - global pch_error - - if {[committer_ident] eq {}} return - if {![lock_index update]} return - - # -- Our in memory state should match the repository. - # - repository_state curType curHEAD curMERGE_HEAD - if {[string match amend* $commit_type] - && $curType eq {normal} - && $curHEAD eq $HEAD} { - } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} { - info_popup [mc "Last scanned state does not match repository state. - -Another Git program has modified this repository since the last scan. A rescan must be performed before another commit can be created. - -The rescan will be automatically started now. -"] - unlock_index - rescan ui_ready - return - } - - # -- At least one file should differ in the index. - # - set files_ready 0 - foreach path [array names file_states] { - set s $file_states($path) - switch -glob -- [lindex $s 0] { - _? {continue} - A? - - D? - - T? - - M? {set files_ready 1} - _U - - U? { - error_popup [mc "Unmerged files cannot be committed. - -File %s has merge conflicts. You must resolve them and stage the file before committing. -" [short_path $path]] - unlock_index - return - } - default { - error_popup [mc "Unknown file state %s detected. - -File %s cannot be committed by this program. -" [lindex $s 0] [short_path $path]] - } - } - } - if {!$files_ready && ![string match *merge $curType] && ![is_enabled nocommit]} { - info_popup [mc "No changes to commit. - -You must stage at least 1 file before you can commit. -"] - unlock_index - return - } - - if {[is_enabled nocommitmsg]} { do_quit 0 } - - # -- A message is required. - # - set msg [string trim [$ui_comm get 1.0 end]] - regsub -all -line {[ \t\r]+$} $msg {} msg - if {$msg eq {}} { - error_popup [mc "Please supply a commit message. - -A good commit message has the following format: - -- First line: Describe in one sentence what you did. -- Second line: Blank -- Remaining lines: Describe why this change is good. -"] - unlock_index - return - } - - # -- Build the message file. - # - set msg_p [gitdir GITGUI_EDITMSG] - set msg_wt [open $msg_p w] - fconfigure $msg_wt -translation lf - setup_commit_encoding $msg_wt - puts $msg_wt $msg - close $msg_wt - - if {[is_enabled nocommit]} { do_quit 0 } - - # -- Run the pre-commit hook. - # - set fd_ph [githook_read pre-commit] - if {$fd_ph eq {}} { - commit_commitmsg $curHEAD $msg_p - return - } - - ui_status [mc "Calling pre-commit hook..."] - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable \ - [list commit_prehook_wait $fd_ph $curHEAD $msg_p] -} - -proc commit_prehook_wait {fd_ph curHEAD msg_p} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - catch {file delete $msg_p} - ui_status [mc "Commit declined by pre-commit hook."] - hook_failed_popup pre-commit $pch_error - unlock_index - } else { - commit_commitmsg $curHEAD $msg_p - } - set pch_error {} - return - } - fconfigure $fd_ph -blocking 0 -} - -proc commit_commitmsg {curHEAD msg_p} { - global is_detached repo_config - global pch_error - - if {$is_detached - && ![file exists [gitdir rebase-merge head-name]] - && [is_config_true gui.warndetachedcommit]} { - set msg [mc "You are about to commit on a detached head.\ -This is a potentially dangerous thing to do because if you switch\ -to another branch you will lose your changes and it can be difficult\ -to retrieve them later from the reflog. You should probably cancel this\ -commit and create a new branch to continue.\n\ -\n\ -Do you really want to proceed with your Commit?"] - if {[ask_popup $msg] ne yes} { - unlock_index - return - } - } - - # -- Run the commit-msg hook. - # - set fd_ph [githook_read commit-msg $msg_p] - if {$fd_ph eq {}} { - commit_writetree $curHEAD $msg_p - return - } - - ui_status [mc "Calling commit-msg hook..."] - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable \ - [list commit_commitmsg_wait $fd_ph $curHEAD $msg_p] -} - -proc commit_commitmsg_wait {fd_ph curHEAD msg_p} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - catch {file delete $msg_p} - ui_status [mc "Commit declined by commit-msg hook."] - hook_failed_popup commit-msg $pch_error - unlock_index - } else { - commit_writetree $curHEAD $msg_p - } - set pch_error {} - return - } - fconfigure $fd_ph -blocking 0 -} - -proc commit_writetree {curHEAD msg_p} { - ui_status [mc "Committing changes..."] - set fd_wt [git_read write-tree] - fileevent $fd_wt readable \ - [list commit_committree $fd_wt $curHEAD $msg_p] -} - -proc commit_committree {fd_wt curHEAD msg_p} { - global HEAD PARENT MERGE_HEAD commit_type - global current_branch - global ui_comm selected_commit_type - global file_states selected_paths rescan_active - global repo_config - - gets $fd_wt tree_id - if {[catch {close $fd_wt} err]} { - catch {file delete $msg_p} - error_popup [strcat [mc "write-tree failed:"] "\n\n$err"] - ui_status [mc "Commit failed."] - unlock_index - return - } - - # -- Verify this wasn't an empty change. - # - if {$commit_type eq {normal}} { - set fd_ot [git_read cat-file commit $PARENT] - fconfigure $fd_ot -encoding binary -translation lf - set old_tree [gets $fd_ot] - close $fd_ot - - if {[string equal -length 5 {tree } $old_tree] - && [string length $old_tree] == 45} { - set old_tree [string range $old_tree 5 end] - } else { - error [mc "Commit %s appears to be corrupt" $PARENT] - } - - if {$tree_id eq $old_tree} { - catch {file delete $msg_p} - info_popup [mc "No changes to commit. - -No files were modified by this commit and it was not a merge commit. - -A rescan will be automatically started now. -"] - unlock_index - rescan {ui_status [mc "No changes to commit."]} - return - } - } - - # -- Create the commit. - # - set cmd [list commit-tree $tree_id] - foreach p [concat $PARENT $MERGE_HEAD] { - lappend cmd -p $p - } - lappend cmd <$msg_p - if {[catch {set cmt_id [eval git $cmd]} err]} { - catch {file delete $msg_p} - error_popup [strcat [mc "commit-tree failed:"] "\n\n$err"] - ui_status [mc "Commit failed."] - unlock_index - return - } - - # -- Update the HEAD ref. - # - set reflogm commit - if {$commit_type ne {normal}} { - append reflogm " ($commit_type)" - } - set msg_fd [open $msg_p r] - setup_commit_encoding $msg_fd 1 - gets $msg_fd subject - close $msg_fd - append reflogm {: } $subject - if {[catch { - git update-ref -m $reflogm HEAD $cmt_id $curHEAD - } err]} { - catch {file delete $msg_p} - error_popup [strcat [mc "update-ref failed:"] "\n\n$err"] - ui_status [mc "Commit failed."] - unlock_index - return - } - - # -- Cleanup after ourselves. - # - catch {file delete $msg_p} - catch {file delete [gitdir MERGE_HEAD]} - catch {file delete [gitdir MERGE_MSG]} - catch {file delete [gitdir SQUASH_MSG]} - catch {file delete [gitdir GITGUI_MSG]} - catch {file delete [gitdir CHERRY_PICK_HEAD]} - - # -- Let rerere do its thing. - # - if {[get_config rerere.enabled] eq {}} { - set rerere [file isdirectory [gitdir rr-cache]] - } else { - set rerere [is_config_true rerere.enabled] - } - if {$rerere} { - catch {git rerere} - } - - # -- Run the post-commit hook. - # - set fd_ph [githook_read post-commit] - if {$fd_ph ne {}} { - global pch_error - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable \ - [list commit_postcommit_wait $fd_ph $cmt_id] - } - - $ui_comm delete 0.0 end - $ui_comm edit reset - $ui_comm edit modified false - if {$::GITGUI_BCK_exists} { - catch {file delete [gitdir GITGUI_BCK]} - set ::GITGUI_BCK_exists 0 - } - - if {[is_enabled singlecommit]} { do_quit 0 } - - # -- Update in memory status - # - set selected_commit_type new - set commit_type normal - set HEAD $cmt_id - set PARENT $cmt_id - set MERGE_HEAD [list] - - foreach path [array names file_states] { - set s $file_states($path) - set m [lindex $s 0] - switch -glob -- $m { - _O - - _M - - _D {continue} - __ - - A_ - - M_ - - T_ - - D_ { - unset file_states($path) - catch {unset selected_paths($path)} - } - DO { - set file_states($path) [list _O [lindex $s 1] {} {}] - } - AM - - AD - - AT - - TM - - TD - - MM - - MT - - MD { - set file_states($path) [list \ - _[string index $m 1] \ - [lindex $s 1] \ - [lindex $s 3] \ - {}] - } - } - } - - display_all_files - unlock_index - reshow_diff - ui_status [mc "Created commit %s: %s" [string range $cmt_id 0 7] $subject] -} - -proc commit_postcommit_wait {fd_ph cmt_id} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - hook_failed_popup post-commit $pch_error 0 - } - unset pch_error - return - } - fconfigure $fd_ph -blocking 0 -} diff --git a/lib/console.tcl b/lib/console.tcl deleted file mode 100644 index 1f3248ffd1..0000000000 --- a/lib/console.tcl +++ /dev/null @@ -1,223 +0,0 @@ -# git-gui console support -# Copyright (C) 2006, 2007 Shawn Pearce - -class console { - -field t_short -field t_long -field w -field w_t -field console_cr -field is_toplevel 1; # are we our own window? - -constructor new {short_title long_title} { - set t_short $short_title - set t_long $long_title - _init $this - return $this -} - -constructor embed {path title} { - set t_short {} - set t_long $title - set w $path - set is_toplevel 0 - _init $this - return $this -} - -method _init {} { - global M1B use_ttk NS - - if {$is_toplevel} { - make_dialog top w -autodelete 0 - wm title $top "[appname] ([reponame]): $t_short" - } else { - ${NS}::frame $w - } - - set console_cr 1.0 - set w_t $w.m.t - - ${NS}::frame $w.m - ${NS}::label $w.m.l1 \ - -textvariable @t_long \ - -anchor w \ - -justify left \ - -font font_uibold - text $w_t \ - -background white \ - -foreground black \ - -borderwidth 1 \ - -relief sunken \ - -width 80 -height 10 \ - -wrap none \ - -font font_diff \ - -state disabled \ - -xscrollcommand [cb _sb_set $w.m.sbx h] \ - -yscrollcommand [cb _sb_set $w.m.sby v] - label $w.m.s -text [mc "Working... please wait..."] \ - -anchor w \ - -justify left \ - -font font_uibold - pack $w.m.l1 -side top -fill x - pack $w.m.s -side bottom -fill x - pack $w_t -side left -fill both -expand 1 - pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10 - - menu $w.ctxm -tearoff 0 - $w.ctxm add command -label [mc "Copy"] \ - -command "tk_textCopy $w_t" - $w.ctxm add command -label [mc "Select All"] \ - -command "focus $w_t;$w_t tag add sel 0.0 end" - $w.ctxm add command -label [mc "Copy All"] \ - -command " - $w_t tag add sel 0.0 end - tk_textCopy $w_t - $w_t tag remove sel 0.0 end - " - - if {$is_toplevel} { - ${NS}::button $w.ok -text [mc "Close"] \ - -state disabled \ - -command [list destroy $w] - pack $w.ok -side bottom -anchor e -pady 10 -padx 10 - bind $w <Visibility> [list focus $w] - } - - bind_button3 $w_t "tk_popup $w.ctxm %X %Y" - bind $w_t <$M1B-Key-a> "$w_t tag add sel 0.0 end;break" - bind $w_t <$M1B-Key-A> "$w_t tag add sel 0.0 end;break" -} - -method exec {cmd {after {}}} { - if {[lindex $cmd 0] eq {git}} { - set fd_f [eval git_read --stderr [lrange $cmd 1 end]] - } else { - lappend cmd 2>@1 - set fd_f [_open_stdout_stderr $cmd] - } - fconfigure $fd_f -blocking 0 -translation binary - fileevent $fd_f readable [cb _read $fd_f $after] -} - -method _read {fd after} { - set buf [read $fd] - if {$buf ne {}} { - if {![winfo exists $w_t]} {_init $this} - $w_t conf -state normal - set c 0 - set n [string length $buf] - while {$c < $n} { - set cr [string first "\r" $buf $c] - set lf [string first "\n" $buf $c] - if {$cr < 0} {set cr [expr {$n + 1}]} - if {$lf < 0} {set lf [expr {$n + 1}]} - - if {$lf < $cr} { - $w_t insert end [string range $buf $c $lf] - set console_cr [$w_t index {end -1c}] - set c $lf - incr c - } else { - $w_t delete $console_cr end - $w_t insert end "\n" - $w_t insert end [string range $buf $c [expr {$cr - 1}]] - set c $cr - incr c - } - } - $w_t conf -state disabled - $w_t see end - } - - fconfigure $fd -blocking 1 - if {[eof $fd]} { - if {[catch {close $fd}]} { - set ok 0 - } else { - set ok 1 - } - if {$after ne {}} { - uplevel #0 $after $ok - } else { - done $this $ok - } - return - } - fconfigure $fd -blocking 0 -} - -method chain {cmdlist {ok 1}} { - if {$ok} { - if {[llength $cmdlist] == 0} { - done $this $ok - return - } - - set cmd [lindex $cmdlist 0] - set cmdlist [lrange $cmdlist 1 end] - - if {[lindex $cmd 0] eq {exec}} { - exec $this \ - [lrange $cmd 1 end] \ - [cb chain $cmdlist] - } else { - uplevel #0 $cmd [cb chain $cmdlist] - } - } else { - done $this $ok - } -} - -method insert {txt} { - if {![winfo exists $w_t]} {_init $this} - $w_t conf -state normal - $w_t insert end "$txt\n" - set console_cr [$w_t index {end -1c}] - $w_t conf -state disabled -} - -method done {ok} { - if {$ok} { - if {[winfo exists $w.m.s]} { - bind $w.m.s <Destroy> [list delete_this $this] - $w.m.s conf -background green -foreground black \ - -text [mc "Success"] - if {$is_toplevel} { - $w.ok conf -state normal - focus $w.ok - } - } else { - delete_this - } - } else { - if {![winfo exists $w.m.s]} { - _init $this - } - bind $w.m.s <Destroy> [list delete_this $this] - $w.m.s conf -background red -foreground black \ - -text [mc "Error: Command Failed"] - if {$is_toplevel} { - $w.ok conf -state normal - focus $w.ok - } - } -} - -method _sb_set {sb orient first last} { - global NS - if {![winfo exists $sb]} { - if {$first == $last || ($first == 0 && $last == 1)} return - if {$orient eq {h}} { - ${NS}::scrollbar $sb -orient h -command [list $w_t xview] - pack $sb -fill x -side bottom -before $w_t - } else { - ${NS}::scrollbar $sb -orient v -command [list $w_t yview] - pack $sb -fill y -side right -before $w_t - } - } - $sb set $first $last -} - -} diff --git a/lib/database.tcl b/lib/database.tcl deleted file mode 100644 index 1f187ed286..0000000000 --- a/lib/database.tcl +++ /dev/null @@ -1,115 +0,0 @@ -# git-gui object database management support -# Copyright (C) 2006, 2007 Shawn Pearce - -proc do_stats {} { - global use_ttk NS - set fd [git_read count-objects -v] - while {[gets $fd line] > 0} { - if {[regexp {^([^:]+): (\d+)$} $line _ name value]} { - set stats($name) $value - } - } - close $fd - - set packed_sz 0 - foreach p [glob -directory [gitdir objects pack] \ - -type f \ - -nocomplain -- *] { - incr packed_sz [file size $p] - } - if {$packed_sz > 0} { - set stats(size-pack) [expr {$packed_sz / 1024}] - } - - set w .stats_view - Dialog $w - wm withdraw $w - wm geometry $w "+[winfo rootx .]+[winfo rooty .]" - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.close -text [mc Close] \ - -default active \ - -command [list destroy $w] - ${NS}::button $w.buttons.gc -text [mc "Compress Database"] \ - -default normal \ - -command "destroy $w;do_gc" - pack $w.buttons.close -side right - pack $w.buttons.gc -side left - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.stat -text [mc "Database Statistics"] - foreach s { - {count {mc "Number of loose objects"}} - {size {mc "Disk space used by loose objects"} { KiB}} - {in-pack {mc "Number of packed objects"}} - {packs {mc "Number of packs"}} - {size-pack {mc "Disk space used by packed objects"} { KiB}} - {prune-packable {mc "Packed objects waiting for pruning"}} - {garbage {mc "Garbage files"}} - } { - set name [lindex $s 0] - set label [eval [lindex $s 1]] - if {[catch {set value $stats($name)}]} continue - if {[llength $s] > 2} { - set value "$value[lindex $s 2]" - } - - ${NS}::label $w.stat.l_$name -text "$label:" -anchor w - ${NS}::label $w.stat.v_$name -text $value -anchor w - grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5} - } - pack $w.stat -pady 10 -padx 10 - - bind $w <Visibility> "grab $w; focus $w.buttons.close" - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [list destroy $w] - wm title $w [append "[appname] ([reponame]): " [mc "Database Statistics"]] - wm deiconify $w - tkwait window $w -} - -proc do_gc {} { - set w [console::new {gc} [mc "Compressing the object database"]] - console::chain $w { - {exec git pack-refs --prune} - {exec git reflog expire --all} - {exec git repack -a -d -l} - {exec git rerere gc} - } -} - -proc do_fsck_objects {} { - set w [console::new {fsck-objects} \ - [mc "Verifying the object database with fsck-objects"]] - set cmd [list git fsck-objects] - lappend cmd --full - lappend cmd --cache - lappend cmd --strict - console::exec $w $cmd -} - -proc hint_gc {} { - set ndirs 1 - set limit 8 - if {[is_Windows]} { - set ndirs 4 - set limit 1 - } - - set count [llength [glob \ - -nocomplain \ - -- \ - [gitdir objects 4\[0-[expr {$ndirs-1}]\]/*]]] - - if {$count >= $limit * $ndirs} { - set objects_current [expr {$count * 256/$ndirs}] - if {[ask_popup \ - [mc "This repository currently has approximately %i loose objects. - -To maintain optimal performance it is strongly recommended that you compress the database. - -Compress the database now?" $objects_current]] eq yes} { - do_gc - } - } -} diff --git a/lib/date.tcl b/lib/date.tcl deleted file mode 100644 index abe82992b6..0000000000 --- a/lib/date.tcl +++ /dev/null @@ -1,53 +0,0 @@ -# git-gui date processing support -# Copyright (C) 2007 Shawn Pearce - -set git_month(Jan) 1 -set git_month(Feb) 2 -set git_month(Mar) 3 -set git_month(Apr) 4 -set git_month(May) 5 -set git_month(Jun) 6 -set git_month(Jul) 7 -set git_month(Aug) 8 -set git_month(Sep) 9 -set git_month(Oct) 10 -set git_month(Nov) 11 -set git_month(Dec) 12 - -proc parse_git_date {s} { - if {$s eq {}} { - return {} - } - - if {![regexp \ - {^... (...) (\d{1,2}) (\d\d):(\d\d):(\d\d) (\d{4}) ([+-]?)(\d\d)(\d\d)$} $s s \ - month day hr mm ss yr ew tz_h tz_m]} { - error [mc "Invalid date from Git: %s" $s] - } - - set s [clock scan [format {%4.4i%2.2i%2.2iT%2s%2s%2s} \ - $yr $::git_month($month) $day \ - $hr $mm $ss] \ - -gmt 1] - - regsub ^0 $tz_h {} tz_h - regsub ^0 $tz_m {} tz_m - switch -- $ew { - - {set ew +} - + {set ew -} - {} {set ew -} - } - - return [expr "$s $ew ($tz_h * 3600 + $tz_m * 60)"] -} - -proc format_date {s} { - if {$s eq {}} { - return {} - } - return [clock format $s -format {%a %b %e %H:%M:%S %Y}] -} - -proc reformat_date {s} { - return [format_date [parse_git_date $s]] -} diff --git a/lib/diff.tcl b/lib/diff.tcl deleted file mode 100644 index 0d56986215..0000000000 --- a/lib/diff.tcl +++ /dev/null @@ -1,833 +0,0 @@ -# git-gui diff viewer -# Copyright (C) 2006, 2007 Shawn Pearce - -proc apply_tab_size {{firsttab {}}} { - global have_tk85 repo_config ui_diff - - set w [font measure font_diff "0"] - if {$have_tk85 && $firsttab != 0} { - $ui_diff configure -tabs [list [expr {$firsttab * $w}] [expr {($firsttab + $repo_config(gui.tabsize)) * $w}]] - } elseif {$have_tk85 || $repo_config(gui.tabsize) != 8} { - $ui_diff configure -tabs [expr {$repo_config(gui.tabsize) * $w}] - } else { - $ui_diff configure -tabs {} - } -} - -proc clear_diff {} { - global ui_diff current_diff_path current_diff_header - global ui_index ui_workdir - - $ui_diff conf -state normal - $ui_diff delete 0.0 end - $ui_diff conf -state disabled - - set current_diff_path {} - set current_diff_header {} - - $ui_index tag remove in_diff 0.0 end - $ui_workdir tag remove in_diff 0.0 end -} - -proc reshow_diff {{after {}}} { - global file_states file_lists - global current_diff_path current_diff_side - global ui_diff - - set p $current_diff_path - if {$p eq {}} { - # No diff is being shown. - } elseif {$current_diff_side eq {}} { - clear_diff - } elseif {[catch {set s $file_states($p)}] - || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} { - - if {[find_next_diff $current_diff_side $p {} {[^O]}]} { - next_diff $after - } else { - clear_diff - } - } else { - set save_pos [lindex [$ui_diff yview] 0] - show_diff $p $current_diff_side {} $save_pos $after - } -} - -proc force_diff_encoding {enc} { - global current_diff_path - - if {$current_diff_path ne {}} { - force_path_encoding $current_diff_path $enc - reshow_diff - } -} - -proc handle_empty_diff {} { - global current_diff_path file_states file_lists - global diff_empty_count - - set path $current_diff_path - set s $file_states($path) - if {[lindex $s 0] ne {_M} || [has_textconv $path]} return - - # Prevent infinite rescan loops - incr diff_empty_count - if {$diff_empty_count > 1} return - - info_popup [mc "No differences detected. - -%s has no changes. - -The modification date of this file was updated by another application, but the content within the file was not changed. - -A rescan will be automatically started to find other files which may have the same state." [short_path $path]] - - clear_diff - display_file $path __ - rescan ui_ready 0 -} - -proc show_diff {path w {lno {}} {scroll_pos {}} {callback {}}} { - global file_states file_lists - global is_3way_diff is_conflict_diff diff_active repo_config - global ui_diff ui_index ui_workdir - global current_diff_path current_diff_side current_diff_header - global current_diff_queue - - if {$diff_active || ![lock_index read]} return - - clear_diff - if {$lno == {}} { - set lno [lsearch -sorted -exact $file_lists($w) $path] - if {$lno >= 0} { - incr lno - } - } - if {$lno >= 1} { - $w tag add in_diff $lno.0 [expr {$lno + 1}].0 - $w see $lno.0 - } - - set s $file_states($path) - set m [lindex $s 0] - set is_conflict_diff 0 - set current_diff_path $path - set current_diff_side $w - set current_diff_queue {} - ui_status [mc "Loading diff of %s..." [escape_path $path]] - - set cont_info [list $scroll_pos $callback] - - apply_tab_size 0 - - if {[string first {U} $m] >= 0} { - merge_load_stages $path [list show_unmerged_diff $cont_info] - } elseif {$m eq {_O}} { - show_other_diff $path $w $m $cont_info - } else { - start_show_diff $cont_info - } -} - -proc show_unmerged_diff {cont_info} { - global current_diff_path current_diff_side - global merge_stages ui_diff is_conflict_diff - global current_diff_queue - - if {$merge_stages(2) eq {}} { - set is_conflict_diff 1 - lappend current_diff_queue \ - [list [mc "LOCAL: deleted\nREMOTE:\n"] d= \ - [list ":1:$current_diff_path" ":3:$current_diff_path"]] - } elseif {$merge_stages(3) eq {}} { - set is_conflict_diff 1 - lappend current_diff_queue \ - [list [mc "REMOTE: deleted\nLOCAL:\n"] d= \ - [list ":1:$current_diff_path" ":2:$current_diff_path"]] - } elseif {[lindex $merge_stages(1) 0] eq {120000} - || [lindex $merge_stages(2) 0] eq {120000} - || [lindex $merge_stages(3) 0] eq {120000}} { - set is_conflict_diff 1 - lappend current_diff_queue \ - [list [mc "LOCAL:\n"] d= \ - [list ":1:$current_diff_path" ":2:$current_diff_path"]] - lappend current_diff_queue \ - [list [mc "REMOTE:\n"] d= \ - [list ":1:$current_diff_path" ":3:$current_diff_path"]] - } else { - start_show_diff $cont_info - return - } - - advance_diff_queue $cont_info -} - -proc advance_diff_queue {cont_info} { - global current_diff_queue ui_diff - - set item [lindex $current_diff_queue 0] - set current_diff_queue [lrange $current_diff_queue 1 end] - - $ui_diff conf -state normal - $ui_diff insert end [lindex $item 0] [lindex $item 1] - $ui_diff conf -state disabled - - start_show_diff $cont_info [lindex $item 2] -} - -proc show_other_diff {path w m cont_info} { - global file_states file_lists - global is_3way_diff diff_active repo_config - global ui_diff ui_index ui_workdir - global current_diff_path current_diff_side current_diff_header - - # - Git won't give us the diff, there's nothing to compare to! - # - if {$m eq {_O}} { - set max_sz 100000 - set type unknown - if {[catch { - set type [file type $path] - switch -- $type { - directory { - set type submodule - set content {} - set sz 0 - } - link { - set content [file readlink $path] - set sz [string length $content] - } - file { - set fd [open $path r] - fconfigure $fd \ - -eofchar {} \ - -encoding [get_path_encoding $path] - set content [read $fd $max_sz] - close $fd - set sz [file size $path] - } - default { - error "'$type' not supported" - } - } - } err ]} { - set diff_active 0 - unlock_index - ui_status [mc "Unable to display %s" [escape_path $path]] - error_popup [strcat [mc "Error loading file:"] "\n\n$err"] - return - } - $ui_diff conf -state normal - if {$type eq {submodule}} { - $ui_diff insert end [append \ - "* " \ - [mc "Git Repository (subproject)"] \ - "\n"] d_info - } elseif {![catch {set type [exec file $path]}]} { - set n [string length $path] - if {[string equal -length $n $path $type]} { - set type [string range $type $n end] - regsub {^:?\s*} $type {} type - } - $ui_diff insert end "* $type\n" d_info - } - if {[string first "\0" $content] != -1} { - $ui_diff insert end \ - [mc "* Binary file (not showing content)."] \ - d_info - } else { - if {$sz > $max_sz} { - $ui_diff insert end [mc \ -"* Untracked file is %d bytes. -* Showing only first %d bytes. -" $sz $max_sz] d_info - } - $ui_diff insert end $content - if {$sz > $max_sz} { - $ui_diff insert end [mc " -* Untracked file clipped here by %s. -* To see the entire file, use an external editor. -" [appname]] d_info - } - } - $ui_diff conf -state disabled - set diff_active 0 - unlock_index - set scroll_pos [lindex $cont_info 0] - if {$scroll_pos ne {}} { - update - $ui_diff yview moveto $scroll_pos - } - ui_ready - set callback [lindex $cont_info 1] - if {$callback ne {}} { - eval $callback - } - return - } -} - -proc get_conflict_marker_size {path} { - set size 7 - catch { - set fd_rc [eval [list git_read check-attr "conflict-marker-size" -- $path]] - set ret [gets $fd_rc line] - close $fd_rc - if {$ret > 0} { - regexp {.*: conflict-marker-size: (\d+)$} $line line size - } - } - return $size -} - -proc start_show_diff {cont_info {add_opts {}}} { - global file_states file_lists - global is_3way_diff is_submodule_diff diff_active repo_config - global ui_diff ui_index ui_workdir - global current_diff_path current_diff_side current_diff_header - - set path $current_diff_path - set w $current_diff_side - - set s $file_states($path) - set m [lindex $s 0] - set is_3way_diff 0 - set is_submodule_diff 0 - set diff_active 1 - set current_diff_header {} - set conflict_size [get_conflict_marker_size $path] - - set cmd [list] - if {$w eq $ui_index} { - lappend cmd diff-index - lappend cmd --cached - if {[git-version >= "1.7.2"]} { - lappend cmd --ignore-submodules=dirty - } - } elseif {$w eq $ui_workdir} { - if {[string first {U} $m] >= 0} { - lappend cmd diff - } else { - lappend cmd diff-files - } - } - if {![is_config_false gui.textconv] && [git-version >= 1.6.1]} { - lappend cmd --textconv - } - - if {[string match {160000 *} [lindex $s 2]] - || [string match {160000 *} [lindex $s 3]]} { - set is_submodule_diff 1 - - if {[git-version >= "1.6.6"]} { - lappend cmd --submodule - } - } - - lappend cmd -p - lappend cmd --color - set cmd [concat $cmd $repo_config(gui.diffopts)] - if {$repo_config(gui.diffcontext) >= 1} { - lappend cmd "-U$repo_config(gui.diffcontext)" - } - if {$w eq $ui_index} { - lappend cmd [PARENT] - } - if {$add_opts ne {}} { - eval lappend cmd $add_opts - } else { - lappend cmd -- - lappend cmd $path - } - - if {$is_submodule_diff && [git-version < "1.6.6"]} { - if {$w eq $ui_index} { - set cmd [list submodule summary --cached -- $path] - } else { - set cmd [list submodule summary --files -- $path] - } - } - - if {[catch {set fd [eval git_read --nice $cmd]} err]} { - set diff_active 0 - unlock_index - ui_status [mc "Unable to display %s" [escape_path $path]] - error_popup [strcat [mc "Error loading diff:"] "\n\n$err"] - return - } - - set ::current_diff_inheader 1 - fconfigure $fd \ - -blocking 0 \ - -encoding [get_path_encoding $path] \ - -translation lf - fileevent $fd readable [list read_diff $fd $conflict_size $cont_info] -} - -proc parse_color_line {line} { - set start 0 - set result "" - set markup [list] - set regexp {\033\[((?:\d+;)*\d+)?m} - set need_reset 0 - while {[regexp -indices -start $start $regexp $line match code]} { - foreach {begin end} $match break - append result [string range $line $start [expr {$begin - 1}]] - set pos [string length $result] - set col [eval [linsert $code 0 string range $line]] - set start [incr end] - if {$col eq "0" || $col eq ""} { - if {!$need_reset} continue - set need_reset 0 - } else { - set need_reset 1 - } - lappend markup $pos $col - } - append result [string range $line $start end] - if {[llength $markup] < 4} {set markup {}} - return [list $result $markup] -} - -proc read_diff {fd conflict_size cont_info} { - global ui_diff diff_active is_submodule_diff - global is_3way_diff is_conflict_diff current_diff_header - global current_diff_queue - global diff_empty_count - - $ui_diff conf -state normal - while {[gets $fd line] >= 0} { - foreach {line markup} [parse_color_line $line] break - set line [string map {\033 ^} $line] - - set tags {} - - # -- Check for start of diff header. - if { [string match {diff --git *} $line] - || [string match {diff --cc *} $line] - || [string match {diff --combined *} $line]} { - set ::current_diff_inheader 1 - } - - # -- Check for end of diff header (any hunk line will do this). - # - if {[regexp {^@@+ } $line]} {set ::current_diff_inheader 0} - - # -- Automatically detect if this is a 3 way diff. - # - if {[string match {@@@ *} $line]} { - set is_3way_diff 1 - apply_tab_size 1 - } - - if {$::current_diff_inheader} { - - # -- These two lines stop a diff header and shouldn't be in there - if { [string match {Binary files * and * differ} $line] - || [regexp {^\* Unmerged path } $line]} { - set ::current_diff_inheader 0 - } else { - append current_diff_header $line "\n" - } - - # -- Cleanup uninteresting diff header lines. - # - if { [string match {diff --git *} $line] - || [string match {diff --cc *} $line] - || [string match {diff --combined *} $line] - || [string match {--- *} $line] - || [string match {+++ *} $line] - || [string match {index *} $line]} { - continue - } - - # -- Name it symlink, not 120000 - # Note, that the original line is in $current_diff_header - regsub {^(deleted|new) file mode 120000} $line {\1 symlink} line - - } elseif { $line eq {\ No newline at end of file}} { - # -- Handle some special lines - } elseif {$is_3way_diff} { - set op [string range $line 0 1] - switch -- $op { - { } {set tags {}} - {@@} {set tags d_@} - { +} {set tags d_s+} - { -} {set tags d_s-} - {+ } {set tags d_+s} - {- } {set tags d_-s} - {--} {set tags d_--} - {++} { - set regexp [string map [list %conflict_size $conflict_size]\ - {^\+\+([<>=]){%conflict_size}(?: |$)}] - if {[regexp $regexp $line _g op]} { - set is_conflict_diff 1 - set line [string replace $line 0 1 { }] - set tags d$op - } else { - set tags d_++ - } - } - default { - puts "error: Unhandled 3 way diff marker: {$op}" - set tags {} - } - } - } elseif {$is_submodule_diff} { - if {$line == ""} continue - if {[regexp {^Submodule } $line]} { - set tags d_info - } elseif {[regexp {^\* } $line]} { - set line [string replace $line 0 1 {Submodule }] - set tags d_info - } else { - set op [string range $line 0 2] - switch -- $op { - { <} {set tags d_-} - { >} {set tags d_+} - { W} {set tags {}} - default { - puts "error: Unhandled submodule diff marker: {$op}" - set tags {} - } - } - } - } else { - set op [string index $line 0] - switch -- $op { - { } {set tags {}} - {@} {set tags d_@} - {-} {set tags d_-} - {+} { - set regexp [string map [list %conflict_size $conflict_size]\ - {^\+([<>=]){%conflict_size}(?: |$)}] - if {[regexp $regexp $line _g op]} { - set is_conflict_diff 1 - set tags d$op - } else { - set tags d_+ - } - } - default { - puts "error: Unhandled 2 way diff marker: {$op}" - set tags {} - } - } - } - set mark [$ui_diff index "end - 1 line linestart"] - $ui_diff insert end $line $tags - if {[string index $line end] eq "\r"} { - $ui_diff tag add d_cr {end - 2c} - } - $ui_diff insert end "\n" $tags - - foreach {posbegin colbegin posend colend} $markup { - set prefix clr - foreach style [lsort -integer [split $colbegin ";"]] { - if {$style eq "7"} {append prefix i; continue} - if {$style != 4 && ($style < 30 || $style > 47)} {continue} - set a "$mark linestart + $posbegin chars" - set b "$mark linestart + $posend chars" - catch {$ui_diff tag add $prefix$style $a $b} - } - } - } - $ui_diff conf -state disabled - - if {[eof $fd]} { - close $fd - - if {$current_diff_queue ne {}} { - advance_diff_queue $cont_info - return - } - - set diff_active 0 - unlock_index - set scroll_pos [lindex $cont_info 0] - if {$scroll_pos ne {}} { - update - $ui_diff yview moveto $scroll_pos - } - ui_ready - - if {[$ui_diff index end] eq {2.0}} { - handle_empty_diff - } else { - set diff_empty_count 0 - } - - set callback [lindex $cont_info 1] - if {$callback ne {}} { - eval $callback - } - } -} - -proc apply_hunk {x y} { - global current_diff_path current_diff_header current_diff_side - global ui_diff ui_index file_states - - if {$current_diff_path eq {} || $current_diff_header eq {}} return - if {![lock_index apply_hunk]} return - - set apply_cmd {apply --cached --whitespace=nowarn} - set mi [lindex $file_states($current_diff_path) 0] - if {$current_diff_side eq $ui_index} { - set failed_msg [mc "Failed to unstage selected hunk."] - lappend apply_cmd --reverse - if {[string index $mi 0] ne {M}} { - unlock_index - return - } - } else { - set failed_msg [mc "Failed to stage selected hunk."] - if {[string index $mi 1] ne {M}} { - unlock_index - return - } - } - - set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0] - set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0] - if {$s_lno eq {}} { - unlock_index - return - } - - set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end] - if {$e_lno eq {}} { - set e_lno end - } - - if {[catch { - set enc [get_path_encoding $current_diff_path] - set p [eval git_write $apply_cmd] - fconfigure $p -translation binary -encoding $enc - puts -nonewline $p $current_diff_header - puts -nonewline $p [$ui_diff get $s_lno $e_lno] - close $p} err]} { - error_popup [append $failed_msg "\n\n$err"] - unlock_index - return - } - - $ui_diff conf -state normal - $ui_diff delete $s_lno $e_lno - $ui_diff conf -state disabled - - if {[$ui_diff get 1.0 end] eq "\n"} { - set o _ - } else { - set o ? - } - - if {$current_diff_side eq $ui_index} { - set mi ${o}M - } elseif {[string index $mi 0] eq {_}} { - set mi M$o - } else { - set mi ?$o - } - unlock_index - display_file $current_diff_path $mi - # This should trigger shift to the next changed file - if {$o eq {_}} { - reshow_diff - } -} - -proc apply_range_or_line {x y} { - global current_diff_path current_diff_header current_diff_side - global ui_diff ui_index file_states - - set selected [$ui_diff tag nextrange sel 0.0] - - if {$selected == {}} { - set first [$ui_diff index "@$x,$y"] - set last $first - } else { - set first [lindex $selected 0] - set last [lindex $selected 1] - } - - set first_l [$ui_diff index "$first linestart"] - set last_l [$ui_diff index "$last lineend"] - - if {$current_diff_path eq {} || $current_diff_header eq {}} return - if {![lock_index apply_hunk]} return - - set apply_cmd {apply --cached --whitespace=nowarn} - set mi [lindex $file_states($current_diff_path) 0] - if {$current_diff_side eq $ui_index} { - set failed_msg [mc "Failed to unstage selected line."] - set to_context {+} - lappend apply_cmd --reverse - if {[string index $mi 0] ne {M}} { - unlock_index - return - } - } else { - set failed_msg [mc "Failed to stage selected line."] - set to_context {-} - if {[string index $mi 1] ne {M}} { - unlock_index - return - } - } - - set wholepatch {} - - while {$first_l < $last_l} { - set i_l [$ui_diff search -backwards -regexp ^@@ $first_l 0.0] - if {$i_l eq {}} { - # If there's not a @@ above, then the selected range - # must have come before the first_l @@ - set i_l [$ui_diff search -regexp ^@@ $first_l $last_l] - } - if {$i_l eq {}} { - unlock_index - return - } - # $i_l is now at the beginning of a line - - # pick start line number from hunk header - set hh [$ui_diff get $i_l "$i_l + 1 lines"] - set hh [lindex [split $hh ,] 0] - set hln [lindex [split $hh -] 1] - - # There is a special situation to take care of. Consider this - # hunk: - # - # @@ -10,4 +10,4 @@ - # context before - # -old 1 - # -old 2 - # +new 1 - # +new 2 - # context after - # - # We used to keep the context lines in the order they appear in - # the hunk. But then it is not possible to correctly stage only - # "-old 1" and "+new 1" - it would result in this staged text: - # - # context before - # old 2 - # new 1 - # context after - # - # (By symmetry it is not possible to *un*stage "old 2" and "new - # 2".) - # - # We resolve the problem by introducing an asymmetry, namely, - # when a "+" line is *staged*, it is moved in front of the - # context lines that are generated from the "-" lines that are - # immediately before the "+" block. That is, we construct this - # patch: - # - # @@ -10,4 +10,5 @@ - # context before - # +new 1 - # old 1 - # old 2 - # context after - # - # But we do *not* treat "-" lines that are *un*staged in a - # special way. - # - # With this asymmetry it is possible to stage the change "old - # 1" -> "new 1" directly, and to stage the change "old 2" -> - # "new 2" by first staging the entire hunk and then unstaging - # the change "old 1" -> "new 1". - # - # Applying multiple lines adds complexity to the special - # situation. The pre_context must be moved after the entire - # first block of consecutive staged "+" lines, so that - # staging both additions gives the following patch: - # - # @@ -10,4 +10,6 @@ - # context before - # +new 1 - # +new 2 - # old 1 - # old 2 - # context after - - # This is non-empty if and only if we are _staging_ changes; - # then it accumulates the consecutive "-" lines (after - # converting them to context lines) in order to be moved after - # "+" change lines. - set pre_context {} - - set n 0 - set m 0 - set i_l [$ui_diff index "$i_l + 1 lines"] - set patch {} - while {[$ui_diff compare $i_l < "end - 1 chars"] && - [$ui_diff get $i_l "$i_l + 2 chars"] ne {@@}} { - set next_l [$ui_diff index "$i_l + 1 lines"] - set c1 [$ui_diff get $i_l] - if {[$ui_diff compare $first_l <= $i_l] && - [$ui_diff compare $i_l < $last_l] && - ($c1 eq {-} || $c1 eq {+})} { - # a line to stage/unstage - set ln [$ui_diff get $i_l $next_l] - if {$c1 eq {-}} { - set n [expr $n+1] - set patch "$patch$pre_context$ln" - set pre_context {} - } else { - set m [expr $m+1] - set patch "$patch$ln" - } - } elseif {$c1 ne {-} && $c1 ne {+}} { - # context line - set ln [$ui_diff get $i_l $next_l] - set patch "$patch$pre_context$ln" - # Skip the "\ No newline at end of - # file". Depending on the locale setting - # we don't know what this line looks - # like exactly. The only thing we do - # know is that it starts with "\ " - if {![string match {\\ *} $ln]} { - set n [expr $n+1] - set m [expr $m+1] - } - set pre_context {} - } elseif {$c1 eq $to_context} { - # turn change line into context line - set ln [$ui_diff get "$i_l + 1 chars" $next_l] - if {$c1 eq {-}} { - set pre_context "$pre_context $ln" - } else { - set patch "$patch $ln" - } - set n [expr $n+1] - set m [expr $m+1] - } else { - # a change in the opposite direction of - # to_context which is outside the range of - # lines to apply. - set patch "$patch$pre_context" - set pre_context {} - } - set i_l $next_l - } - set patch "$patch$pre_context" - set wholepatch "$wholepatch@@ -$hln,$n +$hln,$m @@\n$patch" - set first_l [$ui_diff index "$next_l + 1 lines"] - } - - if {[catch { - set enc [get_path_encoding $current_diff_path] - set p [eval git_write $apply_cmd] - fconfigure $p -translation binary -encoding $enc - puts -nonewline $p $current_diff_header - puts -nonewline $p $wholepatch - close $p} err]} { - error_popup [append $failed_msg "\n\n$err"] - } - - unlock_index -} diff --git a/lib/encoding.tcl b/lib/encoding.tcl deleted file mode 100644 index 32668fc9c6..0000000000 --- a/lib/encoding.tcl +++ /dev/null @@ -1,466 +0,0 @@ -# git-gui encoding support -# Copyright (C) 2005 Paul Mackerras <paulus@samba.org> -# (Copied from gitk, commit fd8ccbec4f0161) - -# This list of encoding names and aliases is distilled from -# http://www.iana.org/assignments/character-sets. -# Not all of them are supported by Tcl. -set encoding_aliases { - { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII - ISO646-US US-ASCII us IBM367 cp367 csASCII } - { ISO-10646-UTF-1 csISO10646UTF1 } - { ISO_646.basic:1983 ref csISO646basic1983 } - { INVARIANT csINVARIANT } - { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion } - { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom } - { NATS-SEFI iso-ir-8-1 csNATSSEFI } - { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD } - { NATS-DANO iso-ir-9-1 csNATSDANO } - { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD } - { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish } - { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames } - { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 } - { ISO-2022-KR csISO2022KR } - { EUC-KR csEUCKR } - { ISO-2022-JP csISO2022JP } - { ISO-2022-JP-2 csISO2022JP2 } - { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7 - csISO13JISC6220jp } - { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro } - { IT iso-ir-15 ISO646-IT csISO15Italian } - { PT iso-ir-16 ISO646-PT csISO16Portuguese } - { ES iso-ir-17 ISO646-ES csISO17Spanish } - { greek7-old iso-ir-18 csISO18Greek7Old } - { latin-greek iso-ir-19 csISO19LatinGreek } - { DIN_66003 iso-ir-21 de ISO646-DE csISO21German } - { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French } - { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 } - { ISO_5427 iso-ir-37 csISO5427Cyrillic } - { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 } - { BS_viewdata iso-ir-47 csISO47BSViewdata } - { INIS iso-ir-49 csISO49INIS } - { INIS-8 iso-ir-50 csISO50INIS8 } - { INIS-cyrillic iso-ir-51 csISO51INISCyrillic } - { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 } - { ISO_5428:1980 iso-ir-55 csISO5428Greek } - { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 } - { GB_2312-80 iso-ir-58 chinese csISO58GB231280 } - { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian - csISO60Norwegian1 } - { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 } - { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French } - { videotex-suppl iso-ir-70 csISO70VideotexSupp1 } - { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 } - { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 } - { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian } - { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 } - { greek7 iso-ir-88 csISO88Greek7 } - { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 } - { iso-ir-90 csISO90 } - { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a } - { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b - csISO92JISC62991984b } - { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd } - { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand } - { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add - csISO95JIS62291984handadd } - { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana } - { ISO_2033-1983 iso-ir-98 e13b csISO2033 } - { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS } - { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819 - CP819 csISOLatin1 } - { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 } - { T.61-7bit iso-ir-102 csISO102T617bit } - { T.61-8bit T.61 iso-ir-103 csISO103T618bit } - { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 } - { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 } - { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic } - { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 } - { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 } - { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr } - { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708 - arabic csISOLatinArabic } - { ISO_8859-6-E csISO88596E ISO-8859-6-E } - { ISO_8859-6-I csISO88596I ISO-8859-6-I } - { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118 - greek greek8 csISOLatinGreek } - { T.101-G2 iso-ir-128 csISO128T101G2 } - { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew - csISOLatinHebrew } - { ISO_8859-8-E csISO88598E ISO-8859-8-E } - { ISO_8859-8-I csISO88598I ISO-8859-8-I } - { CSN_369103 iso-ir-139 csISO139CSN369103 } - { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 } - { ISO_6937-2-add iso-ir-142 csISOTextComm } - { IEC_P27-1 iso-ir-143 csISO143IECP271 } - { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic - csISOLatinCyrillic } - { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian } - { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian } - { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 } - { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT } - { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba } - { ISO_6937-2-25 iso-ir-152 csISO6937Add } - { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 } - { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp } - { ISO_10367-box iso-ir-155 csISO10367Box } - { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 } - { latin-lap lap iso-ir-158 csISO158Lap } - { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 } - { DS_2089 DS2089 ISO646-DK dk csISO646Danish } - { us-dk csUSDK } - { dk-us csDKUS } - { JIS_X0201 X0201 csHalfWidthKatakana } - { KSC5636 ISO646-KR csKSC5636 } - { ISO-10646-UCS-2 csUnicode } - { ISO-10646-UCS-4 csUCS4 } - { DEC-MCS dec csDECMCS } - { hp-roman8 roman8 r8 csHPRoman8 } - { macintosh mac csMacintosh } - { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl - csIBM037 } - { IBM038 EBCDIC-INT cp038 csIBM038 } - { IBM273 CP273 csIBM273 } - { IBM274 EBCDIC-BE CP274 csIBM274 } - { IBM275 EBCDIC-BR cp275 csIBM275 } - { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 } - { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 } - { IBM280 CP280 ebcdic-cp-it csIBM280 } - { IBM281 EBCDIC-JP-E cp281 csIBM281 } - { IBM284 CP284 ebcdic-cp-es csIBM284 } - { IBM285 CP285 ebcdic-cp-gb csIBM285 } - { IBM290 cp290 EBCDIC-JP-kana csIBM290 } - { IBM297 cp297 ebcdic-cp-fr csIBM297 } - { IBM420 cp420 ebcdic-cp-ar1 csIBM420 } - { IBM423 cp423 ebcdic-cp-gr csIBM423 } - { IBM424 cp424 ebcdic-cp-he csIBM424 } - { IBM437 cp437 437 csPC8CodePage437 } - { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 } - { IBM775 cp775 csPC775Baltic } - { IBM850 cp850 850 csPC850Multilingual } - { IBM851 cp851 851 csIBM851 } - { IBM852 cp852 852 csPCp852 } - { IBM855 cp855 855 csIBM855 } - { IBM857 cp857 857 csIBM857 } - { IBM860 cp860 860 csIBM860 } - { IBM861 cp861 861 cp-is csIBM861 } - { IBM862 cp862 862 csPC862LatinHebrew } - { IBM863 cp863 863 csIBM863 } - { IBM864 cp864 csIBM864 } - { IBM865 cp865 865 csIBM865 } - { IBM866 cp866 866 csIBM866 } - { IBM868 CP868 cp-ar csIBM868 } - { IBM869 cp869 869 cp-gr csIBM869 } - { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 } - { IBM871 CP871 ebcdic-cp-is csIBM871 } - { IBM880 cp880 EBCDIC-Cyrillic csIBM880 } - { IBM891 cp891 csIBM891 } - { IBM903 cp903 csIBM903 } - { IBM904 cp904 904 csIBBM904 } - { IBM905 CP905 ebcdic-cp-tr csIBM905 } - { IBM918 CP918 ebcdic-cp-ar2 csIBM918 } - { IBM1026 CP1026 csIBM1026 } - { EBCDIC-AT-DE csIBMEBCDICATDE } - { EBCDIC-AT-DE-A csEBCDICATDEA } - { EBCDIC-CA-FR csEBCDICCAFR } - { EBCDIC-DK-NO csEBCDICDKNO } - { EBCDIC-DK-NO-A csEBCDICDKNOA } - { EBCDIC-FI-SE csEBCDICFISE } - { EBCDIC-FI-SE-A csEBCDICFISEA } - { EBCDIC-FR csEBCDICFR } - { EBCDIC-IT csEBCDICIT } - { EBCDIC-PT csEBCDICPT } - { EBCDIC-ES csEBCDICES } - { EBCDIC-ES-A csEBCDICESA } - { EBCDIC-ES-S csEBCDICESS } - { EBCDIC-UK csEBCDICUK } - { EBCDIC-US csEBCDICUS } - { UNKNOWN-8BIT csUnknown8BiT } - { MNEMONIC csMnemonic } - { MNEM csMnem } - { VISCII csVISCII } - { VIQR csVIQR } - { KOI8-R csKOI8R } - { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro } - { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro } - { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro } - { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro } - { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro } - { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro } - { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro } - { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro } - { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro } - { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro } - { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro } - { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro } - { IBM1047 IBM-1047 } - { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian } - { Amiga-1251 Ami1251 Amiga1251 Ami-1251 } - { UNICODE-1-1 csUnicode11 } - { CESU-8 csCESU-8 } - { BOCU-1 csBOCU-1 } - { UNICODE-1-1-UTF-7 csUnicode11UTF7 } - { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic - l8 } - { ISO-8859-15 ISO_8859-15 Latin-9 } - { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 } - { GBK CP936 MS936 windows-936 } - { JIS_Encoding csJISEncoding } - { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS } - { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese - EUC-JP } - { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese } - { ISO-10646-UCS-Basic csUnicodeASCII } - { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 } - { ISO-Unicode-IBM-1261 csUnicodeIBM1261 } - { ISO-Unicode-IBM-1268 csUnicodeIBM1268 } - { ISO-Unicode-IBM-1276 csUnicodeIBM1276 } - { ISO-Unicode-IBM-1264 csUnicodeIBM1264 } - { ISO-Unicode-IBM-1265 csUnicodeIBM1265 } - { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 } - { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 } - { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 } - { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 } - { Adobe-Standard-Encoding csAdobeStandardEncoding } - { Ventura-US csVenturaUS } - { Ventura-International csVenturaInternational } - { PC8-Danish-Norwegian csPC8DanishNorwegian } - { PC8-Turkish csPC8Turkish } - { IBM-Symbols csIBMSymbols } - { IBM-Thai csIBMThai } - { HP-Legal csHPLegal } - { HP-Pi-font csHPPiFont } - { HP-Math8 csHPMath8 } - { Adobe-Symbol-Encoding csHPPSMath } - { HP-DeskTop csHPDesktop } - { Ventura-Math csVenturaMath } - { Microsoft-Publishing csMicrosoftPublishing } - { Windows-31J csWindows31J } - { GB2312 csGB2312 } - { Big5 csBig5 } -} - -set encoding_groups { - {"" "" - {"Unicode" UTF-8} - {"Western" ISO-8859-1}} - {we "West European" - {"Western" ISO-8859-15 CP-437 CP-850 MacRoman CP-1252 Windows-1252} - {"Celtic" ISO-8859-14} - {"Greek" ISO-8859-14 ISO-8859-7 CP-737 CP-869 MacGreek CP-1253 Windows-1253} - {"Icelandic" MacIceland MacIcelandic CP-861} - {"Nordic" ISO-8859-10 CP-865} - {"Portuguese" CP-860} - {"South European" ISO-8859-3}} - {ee "East European" - {"Baltic" CP-775 ISO-8859-4 ISO-8859-13 CP-1257 Windows-1257} - {"Central European" CP-852 ISO-8859-2 MacCE CP-1250 Windows-1250} - {"Croatian" MacCroatian} - {"Cyrillic" CP-855 ISO-8859-5 ISO-IR-111 KOI8-R MacCyrillic CP-1251 Windows-1251} - {"Russian" CP-866} - {"Ukrainian" KOI8-U MacUkraine MacUkrainian} - {"Romanian" ISO-8859-16 MacRomania MacRomanian}} - {ea "East Asian" - {"Generic" ISO-2022} - {"Chinese Simplified" GB2312 GB1988 GB12345 GB2312-RAW GBK EUC-CN GB18030 HZ ISO-2022-CN} - {"Chinese Traditional" Big5 Big5-HKSCS EUC-TW CP-950} - {"Japanese" EUC-JP ISO-2022-JP Shift-JIS JIS-0212 JIS-0208 JIS-0201 CP-932 MacJapan} - {"Korean" EUC-KR UHC JOHAB ISO-2022-KR CP-949 KSC5601}} - {sa "SE & SW Asian" - {"Armenian" ARMSCII-8} - {"Georgian" GEOSTD8} - {"Thai" TIS-620 ISO-8859-11 CP-874 Windows-874 MacThai} - {"Turkish" CP-857 CP857 ISO-8859-9 MacTurkish CP-1254 Windows-1254} - {"Vietnamese" TCVN VISCII VPS CP-1258 Windows-1258} - {"Hindi" MacDevanagari} - {"Gujarati" MacGujarati} - {"Gurmukhi" MacGurmukhi}} - {me "Middle Eastern" - {"Arabic" ISO-8859-6 Windows-1256 CP-1256 CP-864 MacArabic} - {"Farsi" MacFarsi} - {"Hebrew" ISO-8859-8-I Windows-1255 CP-1255 ISO-8859-8 CP-862 MacHebrew}} - {mi "Misc" - {"7-bit" ASCII} - {"16-bit" Unicode} - {"Legacy" CP-863 EBCDIC} - {"Symbol" Symbol Dingbats MacDingbats MacCentEuro}} -} - -proc build_encoding_table {} { - global encoding_aliases encoding_lookup_table - - # Prepare the lookup list; cannot use lsort -nocase because - # of compatibility issues with older Tcl (e.g. in msysgit) - set names [list] - foreach item [encoding names] { - lappend names [list [string tolower $item] $item] - } - set names [lsort -ascii -index 0 $names] - # neither can we use lsearch -index - set lnames [list] - foreach item $names { - lappend lnames [lindex $item 0] - } - - foreach grp $encoding_aliases { - set target {} - foreach item $grp { - set i [lsearch -sorted -ascii $lnames \ - [string tolower $item]] - if {$i >= 0} { - set target [lindex $names $i 1] - break - } - } - if {$target eq {}} continue - foreach item $grp { - set encoding_lookup_table([string tolower $item]) $target - } - } - - foreach item $names { - set encoding_lookup_table([lindex $item 0]) [lindex $item 1] - } -} - -proc tcl_encoding {enc} { - global encoding_lookup_table - if {$enc eq {}} { - return {} - } - if {![info exists encoding_lookup_table]} { - build_encoding_table - } - set enc [string tolower $enc] - if {![info exists encoding_lookup_table($enc)]} { - # look for "isonnn" instead of "iso-nnn" or "iso_nnn" - if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} { - set enc $encx - } - } - if {[info exists encoding_lookup_table($enc)]} { - return $encoding_lookup_table($enc) - } else { - return {} - } -} - -proc force_path_encoding {path enc} { - global path_encoding_overrides last_encoding_override - - set enc [tcl_encoding $enc] - if {$enc eq {}} { - catch { unset last_encoding_override } - catch { unset path_encoding_overrides($path) } - } else { - set last_encoding_override $enc - if {$path ne {}} { - set path_encoding_overrides($path) $enc - } - } -} - -proc get_path_encoding {path} { - global path_encoding_overrides last_encoding_override - - if {[info exists last_encoding_override]} { - set tcl_enc $last_encoding_override - } else { - set tcl_enc [tcl_encoding [get_config gui.encoding]] - } - if {$tcl_enc eq {}} { - set tcl_enc [encoding system] - } - if {$path ne {}} { - if {[info exists path_encoding_overrides($path)]} { - set enc2 $path_encoding_overrides($path) - } else { - set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]] - } - if {$enc2 ne {}} { - set tcl_enc $enc2 - } - } - return $tcl_enc -} - -proc build_encoding_submenu {parent grp cmd} { - global used_encodings - - set mid [lindex $grp 0] - set gname [mc [lindex $grp 1]] - - set smenu {} - foreach subset [lrange $grp 2 end] { - set name [mc [lindex $subset 0]] - - foreach enc [lrange $subset 1 end] { - set tcl_enc [tcl_encoding $enc] - if {$tcl_enc eq {}} continue - - if {$smenu eq {}} { - if {$mid eq {}} { - set smenu $parent - } else { - set smenu "$parent.$mid" - menu $smenu - $parent add cascade \ - -label $gname \ - -menu $smenu - } - } - - if {$name ne {}} { - set lbl "$name ($enc)" - } else { - set lbl $enc - } - $smenu add command \ - -label $lbl \ - -command [concat $cmd [list $tcl_enc]] - - lappend used_encodings $tcl_enc - } - } -} - -proc popup_btn_menu {m b} { - tk_popup $m [winfo pointerx $b] [winfo pointery $b] -} - -proc build_encoding_menu {emenu cmd {nodef 0}} { - $emenu configure -postcommand \ - [list do_build_encoding_menu $emenu $cmd $nodef] -} - -proc do_build_encoding_menu {emenu cmd {nodef 0}} { - global used_encodings encoding_groups - - $emenu configure -postcommand {} - - if {!$nodef} { - $emenu add command \ - -label [mc "Default"] \ - -command [concat $cmd [list {}]] - } - set sysenc [encoding system] - $emenu add command \ - -label [mc "System (%s)" $sysenc] \ - -command [concat $cmd [list $sysenc]] - - # Main encoding tree - set used_encodings [list identity] - $emenu add separator - foreach grp $encoding_groups { - build_encoding_submenu $emenu $grp $cmd - } - - # Add unclassified encodings - set unused_grp [list [mc Other]] - foreach enc [encoding names] { - if {[lsearch -exact $used_encodings $enc] < 0} { - lappend unused_grp $enc - } - } - build_encoding_submenu $emenu [list other [mc Other] $unused_grp] $cmd -} diff --git a/lib/error.tcl b/lib/error.tcl deleted file mode 100644 index c0fa69af56..0000000000 --- a/lib/error.tcl +++ /dev/null @@ -1,119 +0,0 @@ -# git-gui branch (create/delete) support -# Copyright (C) 2006, 2007 Shawn Pearce - -proc _error_parent {} { - set p [grab current .] - if {$p eq {}} { - return . - } - return $p -} - -proc error_popup {msg} { - set title [appname] - if {[reponame] ne {}} { - append title " ([reponame])" - } - set cmd [list tk_messageBox \ - -icon error \ - -type ok \ - -title [append "$title: " [mc "error"]] \ - -message $msg] - if {[winfo ismapped [_error_parent]]} { - lappend cmd -parent [_error_parent] - } - eval $cmd -} - -proc warn_popup {msg} { - set title [appname] - if {[reponame] ne {}} { - append title " ([reponame])" - } - set cmd [list tk_messageBox \ - -icon warning \ - -type ok \ - -title [append "$title: " [mc "warning"]] \ - -message $msg] - if {[winfo ismapped [_error_parent]]} { - lappend cmd -parent [_error_parent] - } - eval $cmd -} - -proc info_popup {msg} { - set title [appname] - if {[reponame] ne {}} { - append title " ([reponame])" - } - tk_messageBox \ - -parent [_error_parent] \ - -icon info \ - -type ok \ - -title $title \ - -message $msg -} - -proc ask_popup {msg} { - set title [appname] - if {[reponame] ne {}} { - append title " ([reponame])" - } - set cmd [list tk_messageBox \ - -icon question \ - -type yesno \ - -title $title \ - -message $msg] - if {[winfo ismapped [_error_parent]]} { - lappend cmd -parent [_error_parent] - } - eval $cmd -} - -proc hook_failed_popup {hook msg {is_fatal 1}} { - global use_ttk NS - set w .hookfail - Dialog $w - wm withdraw $w - - ${NS}::frame $w.m - ${NS}::label $w.m.l1 -text "$hook hook failed:" \ - -anchor w \ - -justify left \ - -font font_uibold - text $w.m.t \ - -background white \ - -foreground black \ - -borderwidth 1 \ - -relief sunken \ - -width 80 -height 10 \ - -font font_diff \ - -yscrollcommand [list $w.m.sby set] - ${NS}::scrollbar $w.m.sby -command [list $w.m.t yview] - pack $w.m.l1 -side top -fill x - if {$is_fatal} { - ${NS}::label $w.m.l2 \ - -text [mc "You must correct the above errors before committing."] \ - -anchor w \ - -justify left \ - -font font_uibold - pack $w.m.l2 -side bottom -fill x - } - pack $w.m.sby -side right -fill y - pack $w.m.t -side left -fill both -expand 1 - pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10 - - $w.m.t insert 1.0 $msg - $w.m.t conf -state disabled - - ${NS}::button $w.ok -text OK \ - -width 15 \ - -command "destroy $w" - pack $w.ok -side bottom -anchor e -pady 10 -padx 10 - - bind $w <Visibility> "grab $w; focus $w" - bind $w <Key-Return> "destroy $w" - wm title $w [strcat "[appname] ([reponame]): " [mc "error"]] - wm deiconify $w - tkwait window $w -} diff --git a/lib/git-gui.ico b/lib/git-gui.ico Binary files differdeleted file mode 100644 index 334cfa5a1a..0000000000 --- a/lib/git-gui.ico +++ /dev/null diff --git a/lib/index.tcl b/lib/index.tcl deleted file mode 100644 index 3a3e534aef..0000000000 --- a/lib/index.tcl +++ /dev/null @@ -1,484 +0,0 @@ -# git-gui index (add/remove) support -# Copyright (C) 2006, 2007 Shawn Pearce - -proc _delete_indexlock {} { - if {[catch {file delete -- [gitdir index.lock]} err]} { - error_popup [strcat [mc "Unable to unlock the index."] "\n\n$err"] - } -} - -proc _close_updateindex {fd after} { - global use_ttk NS - fconfigure $fd -blocking 1 - if {[catch {close $fd} err]} { - set w .indexfried - Dialog $w - wm withdraw $w - wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]] - wm geometry $w "+[winfo rootx .]+[winfo rooty .]" - set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."] - text $w.msg -yscrollcommand [list $w.vs set] \ - -width [string length $s] -relief flat \ - -borderwidth 0 -highlightthickness 0 \ - -background [get_bg_color $w] - $w.msg tag configure bold -font font_uibold -justify center - ${NS}::scrollbar $w.vs -command [list $w.msg yview] - $w.msg insert end $s bold \n\n$err {} - $w.msg configure -state disabled - - ${NS}::button $w.continue \ - -text [mc "Continue"] \ - -command [list destroy $w] - ${NS}::button $w.unlock \ - -text [mc "Unlock Index"] \ - -command "destroy $w; _delete_indexlock" - grid $w.msg - $w.vs -sticky news - grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2 - grid columnconfigure $w 0 -weight 1 - grid rowconfigure $w 0 -weight 1 - - wm protocol $w WM_DELETE_WINDOW update - bind $w.continue <Visibility> " - grab $w - focus %W - " - wm deiconify $w - tkwait window $w - - $::main_status stop - unlock_index - rescan $after 0 - return - } - - $::main_status stop - unlock_index - uplevel #0 $after -} - -proc update_indexinfo {msg pathList after} { - global update_index_cp - - if {![lock_index update]} return - - set update_index_cp 0 - set pathList [lsort $pathList] - set totalCnt [llength $pathList] - set batch [expr {int($totalCnt * .01) + 1}] - if {$batch > 25} {set batch 25} - - $::main_status start $msg [mc "files"] - set fd [git_write update-index -z --index-info] - fconfigure $fd \ - -blocking 0 \ - -buffering full \ - -buffersize 512 \ - -encoding binary \ - -translation binary - fileevent $fd writable [list \ - write_update_indexinfo \ - $fd \ - $pathList \ - $totalCnt \ - $batch \ - $after \ - ] -} - -proc write_update_indexinfo {fd pathList totalCnt batch after} { - global update_index_cp - global file_states current_diff_path - - if {$update_index_cp >= $totalCnt} { - _close_updateindex $fd $after - return - } - - for {set i $batch} \ - {$update_index_cp < $totalCnt && $i > 0} \ - {incr i -1} { - set path [lindex $pathList $update_index_cp] - incr update_index_cp - - set s $file_states($path) - switch -glob -- [lindex $s 0] { - A? {set new _O} - MT - - TM - - T_ {set new _T} - M? {set new _M} - TD - - D_ {set new _D} - D? {set new _?} - ?? {continue} - } - set info [lindex $s 2] - if {$info eq {}} continue - - puts -nonewline $fd "$info\t[encoding convertto $path]\0" - display_file $path $new - } - - $::main_status update $update_index_cp $totalCnt -} - -proc update_index {msg pathList after} { - global update_index_cp - - if {![lock_index update]} return - - set update_index_cp 0 - set pathList [lsort $pathList] - set totalCnt [llength $pathList] - set batch [expr {int($totalCnt * .01) + 1}] - if {$batch > 25} {set batch 25} - - $::main_status start $msg [mc "files"] - set fd [git_write update-index --add --remove -z --stdin] - fconfigure $fd \ - -blocking 0 \ - -buffering full \ - -buffersize 512 \ - -encoding binary \ - -translation binary - fileevent $fd writable [list \ - write_update_index \ - $fd \ - $pathList \ - $totalCnt \ - $batch \ - $after \ - ] -} - -proc write_update_index {fd pathList totalCnt batch after} { - global update_index_cp - global file_states current_diff_path - - if {$update_index_cp >= $totalCnt} { - _close_updateindex $fd $after - return - } - - for {set i $batch} \ - {$update_index_cp < $totalCnt && $i > 0} \ - {incr i -1} { - set path [lindex $pathList $update_index_cp] - incr update_index_cp - - switch -glob -- [lindex $file_states($path) 0] { - AD {set new __} - ?D {set new D_} - _O - - AT - - AM {set new A_} - TM - - MT - - _T {set new T_} - _U - - U? { - if {[file exists $path]} { - set new M_ - } else { - set new D_ - } - } - ?M {set new M_} - ?? {continue} - } - puts -nonewline $fd "[encoding convertto $path]\0" - display_file $path $new - } - - $::main_status update $update_index_cp $totalCnt -} - -proc checkout_index {msg pathList after} { - global update_index_cp - - if {![lock_index update]} return - - set update_index_cp 0 - set pathList [lsort $pathList] - set totalCnt [llength $pathList] - set batch [expr {int($totalCnt * .01) + 1}] - if {$batch > 25} {set batch 25} - - $::main_status start $msg [mc "files"] - set fd [git_write checkout-index \ - --index \ - --quiet \ - --force \ - -z \ - --stdin \ - ] - fconfigure $fd \ - -blocking 0 \ - -buffering full \ - -buffersize 512 \ - -encoding binary \ - -translation binary - fileevent $fd writable [list \ - write_checkout_index \ - $fd \ - $pathList \ - $totalCnt \ - $batch \ - $after \ - ] -} - -proc write_checkout_index {fd pathList totalCnt batch after} { - global update_index_cp - global file_states current_diff_path - - if {$update_index_cp >= $totalCnt} { - _close_updateindex $fd $after - return - } - - for {set i $batch} \ - {$update_index_cp < $totalCnt && $i > 0} \ - {incr i -1} { - set path [lindex $pathList $update_index_cp] - incr update_index_cp - switch -glob -- [lindex $file_states($path) 0] { - U? {continue} - ?M - - ?T - - ?D { - puts -nonewline $fd "[encoding convertto $path]\0" - display_file $path ?_ - } - } - } - - $::main_status update $update_index_cp $totalCnt -} - -proc unstage_helper {txt paths} { - global file_states current_diff_path - - if {![lock_index begin-update]} return - - set pathList [list] - set after {} - foreach path $paths { - switch -glob -- [lindex $file_states($path) 0] { - A? - - M? - - T? - - D? { - lappend pathList $path - if {$path eq $current_diff_path} { - set after {reshow_diff;} - } - } - } - } - if {$pathList eq {}} { - unlock_index - } else { - update_indexinfo \ - $txt \ - $pathList \ - [concat $after [list ui_ready]] - } -} - -proc do_unstage_selection {} { - global current_diff_path selected_paths - - if {[array size selected_paths] > 0} { - unstage_helper \ - [mc "Unstaging selected files from commit"] \ - [array names selected_paths] - } elseif {$current_diff_path ne {}} { - unstage_helper \ - [mc "Unstaging %s from commit" [short_path $current_diff_path]] \ - [list $current_diff_path] - } -} - -proc add_helper {txt paths} { - global file_states current_diff_path - - if {![lock_index begin-update]} return - - set pathList [list] - set after {} - foreach path $paths { - switch -glob -- [lindex $file_states($path) 0] { - _U - - U? { - if {$path eq $current_diff_path} { - unlock_index - merge_stage_workdir $path - return - } - } - _O - - ?M - - ?D - - ?T { - lappend pathList $path - if {$path eq $current_diff_path} { - set after {reshow_diff;} - } - } - } - } - if {$pathList eq {}} { - unlock_index - } else { - update_index \ - $txt \ - $pathList \ - [concat $after {ui_status [mc "Ready to commit."]}] - } -} - -proc do_add_selection {} { - global current_diff_path selected_paths - - if {[array size selected_paths] > 0} { - add_helper \ - [mc "Adding selected files"] \ - [array names selected_paths] - } elseif {$current_diff_path ne {}} { - add_helper \ - [mc "Adding %s" [short_path $current_diff_path]] \ - [list $current_diff_path] - } -} - -proc do_add_all {} { - global file_states - - set paths [list] - set untracked_paths [list] - foreach path [array names file_states] { - switch -glob -- [lindex $file_states($path) 0] { - U? {continue} - ?M - - ?T - - ?D {lappend paths $path} - ?O {lappend untracked_paths $path} - } - } - if {[llength $untracked_paths]} { - set reply 0 - switch -- [get_config gui.stageuntracked] { - no { - set reply 0 - } - yes { - set reply 1 - } - ask - - default { - set reply [ask_popup [mc "Stage %d untracked files?" \ - [llength $untracked_paths]]] - } - } - if {$reply} { - set paths [concat $paths $untracked_paths] - } - } - add_helper [mc "Adding all changed files"] $paths -} - -proc revert_helper {txt paths} { - global file_states current_diff_path - - if {![lock_index begin-update]} return - - set pathList [list] - set after {} - foreach path $paths { - switch -glob -- [lindex $file_states($path) 0] { - U? {continue} - ?M - - ?T - - ?D { - lappend pathList $path - if {$path eq $current_diff_path} { - set after {reshow_diff;} - } - } - } - } - - - # Split question between singular and plural cases, because - # such distinction is needed in some languages. Previously, the - # code used "Revert changes in" for both, but that can't work - # in languages where 'in' must be combined with word from - # rest of string (in different way for both cases of course). - # - # FIXME: Unfortunately, even that isn't enough in some languages - # as they have quite complex plural-form rules. Unfortunately, - # msgcat doesn't seem to support that kind of string translation. - # - set n [llength $pathList] - if {$n == 0} { - unlock_index - return - } elseif {$n == 1} { - set query [mc "Revert changes in file %s?" [short_path [lindex $pathList]]] - } else { - set query [mc "Revert changes in these %i files?" $n] - } - - set reply [tk_dialog \ - .confirm_revert \ - "[appname] ([reponame])" \ - "$query - -[mc "Any unstaged changes will be permanently lost by the revert."]" \ - question \ - 1 \ - [mc "Do Nothing"] \ - [mc "Revert Changes"] \ - ] - if {$reply == 1} { - checkout_index \ - $txt \ - $pathList \ - [concat $after [list ui_ready]] - } else { - unlock_index - } -} - -proc do_revert_selection {} { - global current_diff_path selected_paths - - if {[array size selected_paths] > 0} { - revert_helper \ - [mc "Reverting selected files"] \ - [array names selected_paths] - } elseif {$current_diff_path ne {}} { - revert_helper \ - [mc "Reverting %s" [short_path $current_diff_path]] \ - [list $current_diff_path] - } -} - -proc do_select_commit_type {} { - global commit_type selected_commit_type - - if {$selected_commit_type eq {new} - && [string match amend* $commit_type]} { - create_new_commit - } elseif {$selected_commit_type eq {amend} - && ![string match amend* $commit_type]} { - load_last_commit - - # The amend request was rejected... - # - if {![string match amend* $commit_type]} { - set selected_commit_type new - } - } -} diff --git a/lib/line.tcl b/lib/line.tcl deleted file mode 100644 index a026de954c..0000000000 --- a/lib/line.tcl +++ /dev/null @@ -1,81 +0,0 @@ -# goto line number -# based on code from gitk, Copyright (C) Paul Mackerras - -class linebar { - -field w -field ctext - -field linenum {} - -constructor new {i_w i_text args} { - global use_ttk NS - set w $i_w - set ctext $i_text - - ${NS}::frame $w - ${NS}::label $w.l -text [mc "Goto Line:"] - tentry $w.ent \ - -textvariable ${__this}::linenum \ - -background lightgreen \ - -validate key \ - -validatecommand [cb _validate %P] - ${NS}::button $w.bn -text [mc Go] -command [cb _goto] - - pack $w.l -side left - pack $w.bn -side right - pack $w.ent -side left -expand 1 -fill x - - eval grid conf $w -sticky we $args - grid remove $w - - trace add variable linenum write [cb _goto_cb] - bind $w.ent <Return> [cb _goto] - bind $w.ent <Escape> [cb hide] - - bind $w <Destroy> [list delete_this $this] - return $this -} - -method show {} { - if {![visible $this]} { - grid $w - } - focus -force $w.ent -} - -method hide {} { - if {[visible $this]} { - $w.ent delete 0 end - focus $ctext - grid remove $w - } -} - -method visible {} { - return [winfo ismapped $w] -} - -method editor {} { - return $w.ent -} - -method _validate {P} { - # only accept numbers as input - string is integer $P -} - -method _goto_cb {name ix op} { - after idle [cb _goto 1] -} - -method _goto {{nohide {0}}} { - if {$linenum ne {}} { - $ctext see $linenum.0 - if {!$nohide} { - hide $this - } - } -} - -} diff --git a/lib/logo.tcl b/lib/logo.tcl deleted file mode 100644 index 5ff76692f5..0000000000 --- a/lib/logo.tcl +++ /dev/null @@ -1,43 +0,0 @@ -# git-gui Git Gui logo -# Copyright (C) 2007 Shawn Pearce - -# Henrik Nyh's alternative Git logo, from his blog post -# http://henrik.nyh.se/2007/06/alternative-git-logo-and-favicon -# -image create photo ::git_logo_data -data { -R0lGODdhYQC8AIQbAGZmZtg4LW9vb3l5eYKCgoyMjEC/TOJpYZWVlZ+fn2/PeKmpqbKysry8vMXF -xZ/fpc/Pz7fnvPXNytnZ2eLi4s/v0vja1+zs7Of36fX19f3z8v///////////////////ywAAAAA -YQC8AAAF/uAmjmRpnmiqrmzrvq4hz3RtGw+s7zx5/7dcb0hUAY8zYXHJRCKVzGjPeYRKry8q0Irt -GrVBr3gFDo/PprKNix6ra+y2902Ly7H05L2dl9n3UX04gGeCf4RFhohiiotdjY5XkJGBfYeUOpOY -iZablXmXURgPpKWmp6ipqYIKqq6vqREjFYK1trUKs7e7vFq5IrS9wsM0vxvBxMm8xsjKzqy6z9J5 -zNPWatXX2k7Z29433d/iMuHj3+Xm2+jp1+vs0+7vz/HyyvT1xPf4wvr7y9H+pBkbBasgLFYGE8ba -o8nTlE4OOYGKKJFOKIopGmLMAnHjDo0eWYAM+WUiSRgj/k+eSKmyBMuWI17C3CATZs2WN1XmPLmT -ZM+QPz0G3VihqNGjSJNWwDCzqdOnUKPu0SChqtWrWLNq3cq1q9evYCVYGCEhgNmzaNOqXcu2rdu3 -cOMGOEBWrt27ePPCpSuirN6/gAO35bvBr+DDiPMSNpy4sWO2ix9Lnmw2MuXLiS1j3gxYM+fPdz2D -Hv1WNOnTak2jXj23LuvXlV3DZq16Nujatjnjzo15N2/Kvn9LDi7cMfHimaUqX868ufPn0KPPpOCA -AQMWCQBo3869u/fv4MNrd3DlQoMC3QlkSJFdvPv38LVDWJLBAYHwE1LE38+/+/UhGTAggHv5odDf -gfv9/seDgPAVeAKCELqnIAwU3BefgyZEqOF3E7rAQH8YlrDhiNt1uEIG6IGoH4kjmpjCBRaqaCCL -G7p4AgUDIhgiCTTW2AKOEe44Qo8a2khCBgNoKKQIREZopAgZxAjhkhs0CeGTG7Sn5IpW9vekAyRS -2eWBRl6Q44ZijhlfAQlQmeKIaarpHZsMTHABCxDQGKec3JH3QpIs7snndn6yAKaeXA7aZwuABppo -fAws0GiEhaKQJ40F3DkjfwVC8CaCAlCgAgIkJjDfCgdiOMGn/Q2w3gkZtPgqC6ma0ECECaBwa4QE -aOpCrSYAqeMJpEKYqw7ABnsmfwQ8aCwPySqLYKUb/kwAYbPQyoiCtQcOUMKHBwrgK7LaogBuuaxC -OkS0KEwa37EiLBufALPuwO4Jh/InwAixkknEvSe4C9+p3PY3rr3lpnDufguIcCmzRQAc7IHYLhxf -w/8mnILA74lg8cARa4xCsZxusMCBomZccgsfv0deuh2HvLKh/sLs3hJSvieuCwUzvIHN4tGXc3ih -vtDzmj8fSNLR8BWQdH9LH+g00OFF3d/UBx4cUcvuOc21eFRiouV+Xvvr0dDvlX21R/2uzTR89TqU -L3+5UoBgAxtRHd5/CHpLkd13i4D2e3hHRLKMY+9Hr0Nvx/fq3Pw57cng7/m9wQVObnIyhAiQwHF8 -/tQS8nDgI2wOYeh3CAvhuIBHiDEgqvdtwudkaz3GBPKaTcKuGgqAJRMZmK6h1hnk3ncDcUvhgPFS -o5B476ZKQcECzCN4qgmYN4lAncmzcAEEkhJp+QlfkyhAAdtbN8H67FvHQAF6b4g6v9UryqfkKkBu -v/0prxD//kR63YnqB8AeqcdoBRxU/1zAuwRaaX4reJ4DSSRAHUhwgrgqwgUx2B94EWGDHISPBzUY -QgSNcAn6K6F4fscDCtBOhdoRwPW6kIHDwZA7vWoDBF44Qd/tIUAEBCACbIeG4AXxfmFrQ4B4OCYE -JBEQELChmgbAACJioj4JOCKCCLCABZ6EAg1IHwDlyLYAB1gRJhSYgHUQAD9WnQ9+CWBAA+wknTpC -JwQAOw== -} - -proc git_logo {w} { - label $w \ - -borderwidth 1 \ - -relief sunken \ - -background white \ - -image ::git_logo_data - return $w -} diff --git a/lib/merge.tcl b/lib/merge.tcl deleted file mode 100644 index 460d32fa22..0000000000 --- a/lib/merge.tcl +++ /dev/null @@ -1,277 +0,0 @@ -# git-gui branch merge support -# Copyright (C) 2006, 2007 Shawn Pearce - -class merge { - -field w ; # top level window -field w_rev ; # mega-widget to pick the revision to merge - -method _can_merge {} { - global HEAD commit_type file_states - - if {[string match amend* $commit_type]} { - info_popup [mc "Cannot merge while amending. - -You must finish amending this commit before starting any type of merge. -"] - return 0 - } - - if {[committer_ident] eq {}} {return 0} - if {![lock_index merge]} {return 0} - - # -- Our in memory state should match the repository. - # - repository_state curType curHEAD curMERGE_HEAD - if {$commit_type ne $curType || $HEAD ne $curHEAD} { - info_popup [mc "Last scanned state does not match repository state. - -Another Git program has modified this repository since the last scan. A rescan must be performed before a merge can be performed. - -The rescan will be automatically started now. -"] - unlock_index - rescan ui_ready - return 0 - } - - foreach path [array names file_states] { - switch -glob -- [lindex $file_states($path) 0] { - _O { - continue; # and pray it works! - } - _U - - U? { - error_popup [mc "You are in the middle of a conflicted merge. - -File %s has merge conflicts. - -You must resolve them, stage the file, and commit to complete the current merge. Only then can you begin another merge. -" [short_path $path]] - unlock_index - return 0 - } - ?? { - error_popup [mc "You are in the middle of a change. - -File %s is modified. - -You should complete the current commit before starting a merge. Doing so will help you abort a failed merge, should the need arise. -" [short_path $path]] - unlock_index - return 0 - } - } - } - - return 1 -} - -method _rev {} { - if {[catch {$w_rev commit_or_die}]} { - return {} - } - return [$w_rev get] -} - -method _visualize {} { - set rev [_rev $this] - if {$rev ne {}} { - do_gitk [list $rev --not HEAD] - } -} - -method _start {} { - global HEAD current_branch remote_url - global _last_merged_branch - - set name [_rev $this] - if {$name eq {}} { - return - } - - set spec [$w_rev get_tracking_branch] - set cmit [$w_rev get_commit] - - set fh [open [gitdir FETCH_HEAD] w] - fconfigure $fh -translation lf - if {$spec eq {}} { - set remote . - set branch $name - set stitle $branch - } else { - set remote $remote_url([lindex $spec 1]) - if {[regexp {^[^:@]*@[^:]*:/} $remote]} { - regsub {^[^:@]*@} $remote {} remote - } - set branch [lindex $spec 2] - set stitle [mc "%s of %s" $branch $remote] - } - regsub ^refs/heads/ $branch {} branch - puts $fh "$cmit\t\tbranch '$branch' of $remote" - close $fh - set _last_merged_branch $branch - - set cmd [list git] - lappend cmd merge - lappend cmd --strategy=recursive - lappend cmd [git fmt-merge-msg <[gitdir FETCH_HEAD]] - lappend cmd HEAD - lappend cmd $name - - ui_status [mc "Merging %s and %s..." $current_branch $stitle] - set cons [console::new [mc "Merge"] "merge $stitle"] - console::exec $cons $cmd [cb _finish $cons] - - wm protocol $w WM_DELETE_WINDOW {} - destroy $w -} - -method _finish {cons ok} { - console::done $cons $ok - if {$ok} { - set msg [mc "Merge completed successfully."] - } else { - set msg [mc "Merge failed. Conflict resolution is required."] - } - unlock_index - rescan [list ui_status $msg] - delete_this -} - -constructor dialog {} { - global current_branch - global M1B use_ttk NS - - if {![_can_merge $this]} { - delete_this - return - } - - make_dialog top w - wm title $top [append "[appname] ([reponame]): " [mc "Merge"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - set _start [cb _start] - - ${NS}::label $w.header \ - -text [mc "Merge Into %s" $current_branch] \ - -font font_uibold - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.visualize \ - -text [mc Visualize] \ - -command [cb _visualize] - pack $w.buttons.visualize -side left - ${NS}::button $w.buttons.merge \ - -text [mc Merge] \ - -command $_start - pack $w.buttons.merge -side right - ${NS}::button $w.buttons.cancel \ - -text [mc "Cancel"] \ - -command [cb _cancel] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - set w_rev [::choose_rev::new_unmerged $w.rev [mc "Revision To Merge"]] - pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5 - - bind $w <$M1B-Key-Return> $_start - bind $w <Key-Return> $_start - bind $w <Key-Escape> [cb _cancel] - wm protocol $w WM_DELETE_WINDOW [cb _cancel] - - bind $w.buttons.merge <Visibility> [cb _visible] - tkwait window $w -} - -method _visible {} { - grab $w - if {[is_config_true gui.matchtrackingbranch]} { - $w_rev pick_tracking_branch - } - $w_rev focus_filter -} - -method _cancel {} { - wm protocol $w WM_DELETE_WINDOW {} - unlock_index - destroy $w - delete_this -} - -} - -namespace eval merge { - -proc reset_hard {} { - global HEAD commit_type file_states - - if {[string match amend* $commit_type]} { - info_popup [mc "Cannot abort while amending. - -You must finish amending this commit. -"] - return - } - - if {![lock_index abort]} return - - if {[string match *merge* $commit_type]} { - set op_question [mc "Abort merge? - -Aborting the current merge will cause *ALL* uncommitted changes to be lost. - -Continue with aborting the current merge?"] - } else { - set op_question [mc "Reset changes? - -Resetting the changes will cause *ALL* uncommitted changes to be lost. - -Continue with resetting the current changes?"] - } - - if {[ask_popup $op_question] eq {yes}} { - set fd [git_read --stderr read-tree --reset -u -v HEAD] - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [namespace code [list _reset_wait $fd]] - $::main_status start [mc "Aborting"] [mc "files reset"] - } else { - unlock_index - } -} - -proc _reset_wait {fd} { - global ui_comm - - $::main_status update_meter [read $fd] - - fconfigure $fd -blocking 1 - if {[eof $fd]} { - set fail [catch {close $fd} err] - $::main_status stop - unlock_index - - $ui_comm delete 0.0 end - $ui_comm edit modified false - - catch {file delete [gitdir MERGE_HEAD]} - catch {file delete [gitdir rr-cache MERGE_RR]} - catch {file delete [gitdir MERGE_RR]} - catch {file delete [gitdir SQUASH_MSG]} - catch {file delete [gitdir MERGE_MSG]} - catch {file delete [gitdir GITGUI_MSG]} - - if {$fail} { - warn_popup "[mc "Abort failed."]\n\n$err" - } - rescan {ui_status [mc "Abort completed. Ready."]} - } else { - fconfigure $fd -blocking 0 - } -} - -} diff --git a/lib/mergetool.tcl b/lib/mergetool.tcl deleted file mode 100644 index 120bc4064b..0000000000 --- a/lib/mergetool.tcl +++ /dev/null @@ -1,400 +0,0 @@ -# git-gui merge conflict resolution -# parts based on git-mergetool (c) 2006 Theodore Y. Ts'o - -proc merge_resolve_one {stage} { - global current_diff_path - - switch -- $stage { - 1 { set targetquestion [mc "Force resolution to the base version?"] } - 2 { set targetquestion [mc "Force resolution to this branch?"] } - 3 { set targetquestion [mc "Force resolution to the other branch?"] } - } - - set op_question [strcat $targetquestion "\n" \ -[mc "Note that the diff shows only conflicting changes. - -%s will be overwritten. - -This operation can be undone only by restarting the merge." \ - [short_path $current_diff_path]]] - - if {[ask_popup $op_question] eq {yes}} { - merge_load_stages $current_diff_path [list merge_force_stage $stage] - } -} - -proc merge_stage_workdir {path {lno {}}} { - global current_diff_path diff_active - global current_diff_side ui_workdir - - if {$diff_active} return - - if {$path ne $current_diff_path || $ui_workdir ne $current_diff_side} { - show_diff $path $ui_workdir $lno {} [list do_merge_stage_workdir $path] - } else { - do_merge_stage_workdir $path - } -} - -proc do_merge_stage_workdir {path} { - global current_diff_path is_conflict_diff - - if {$path ne $current_diff_path} return; - - if {$is_conflict_diff} { - if {[ask_popup [mc "File %s seems to have unresolved conflicts, still stage?" \ - [short_path $path]]] ne {yes}} { - return - } - } - - merge_add_resolution $path -} - -proc merge_add_resolution {path} { - global current_diff_path ui_workdir - - set after [next_diff_after_action $ui_workdir $path {} {^_?U}] - - update_index \ - [mc "Adding resolution for %s" [short_path $path]] \ - [list $path] \ - [concat $after [list ui_ready]] -} - -proc merge_force_stage {stage} { - global current_diff_path merge_stages - - if {$merge_stages($stage) ne {}} { - git checkout-index -f --stage=$stage -- $current_diff_path - } else { - file delete -- $current_diff_path - } - - merge_add_resolution $current_diff_path -} - -proc merge_load_stages {path cont} { - global merge_stages_fd merge_stages merge_stages_buf - - if {[info exists merge_stages_fd]} { - catch { kill_file_process $merge_stages_fd } - catch { close $merge_stages_fd } - } - - set merge_stages(0) {} - set merge_stages(1) {} - set merge_stages(2) {} - set merge_stages(3) {} - set merge_stages_buf {} - - set merge_stages_fd [eval git_read ls-files -u -z -- {$path}] - - fconfigure $merge_stages_fd -blocking 0 -translation binary -encoding binary - fileevent $merge_stages_fd readable [list read_merge_stages $merge_stages_fd $cont] -} - -proc read_merge_stages {fd cont} { - global merge_stages_buf merge_stages_fd merge_stages - - append merge_stages_buf [read $fd] - set pck [split $merge_stages_buf "\0"] - set merge_stages_buf [lindex $pck end] - - if {[eof $fd] && $merge_stages_buf ne {}} { - lappend pck {} - set merge_stages_buf {} - } - - foreach p [lrange $pck 0 end-1] { - set fcols [split $p "\t"] - set cols [split [lindex $fcols 0] " "] - set stage [lindex $cols 2] - - set merge_stages($stage) [lrange $cols 0 1] - } - - if {[eof $fd]} { - close $fd - unset merge_stages_fd - eval $cont - } -} - -proc merge_resolve_tool {} { - global current_diff_path - - merge_load_stages $current_diff_path [list merge_resolve_tool2] -} - -proc merge_resolve_tool2 {} { - global current_diff_path merge_stages - - # Validate the stages - if {$merge_stages(2) eq {} || - [lindex $merge_stages(2) 0] eq {120000} || - [lindex $merge_stages(2) 0] eq {160000} || - $merge_stages(3) eq {} || - [lindex $merge_stages(3) 0] eq {120000} || - [lindex $merge_stages(3) 0] eq {160000} - } { - error_popup [mc "Cannot resolve deletion or link conflicts using a tool"] - return - } - - if {![file exists $current_diff_path]} { - error_popup [mc "Conflict file does not exist"] - return - } - - # Determine the tool to use - set tool [get_config merge.tool] - if {$tool eq {}} { set tool meld } - - set merge_tool_path [get_config "mergetool.$tool.path"] - if {$merge_tool_path eq {}} { - switch -- $tool { - emerge { set merge_tool_path "emacs" } - araxis { set merge_tool_path "compare" } - default { set merge_tool_path $tool } - } - } - - # Make file names - set filebase [file rootname $current_diff_path] - set fileext [file extension $current_diff_path] - set basename [lindex [file split $current_diff_path] end] - - set MERGED $current_diff_path - set BASE "./$MERGED.BASE$fileext" - set LOCAL "./$MERGED.LOCAL$fileext" - set REMOTE "./$MERGED.REMOTE$fileext" - set BACKUP "./$MERGED.BACKUP$fileext" - - set base_stage $merge_stages(1) - - # Build the command line - switch -- $tool { - araxis { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" -wait -merge -3 -a1 \ - -title1:"'$MERGED (Base)'" -title2:"'$MERGED (Local)'" \ - -title3:"'$MERGED (Remote)'" \ - "$BASE" "$LOCAL" "$REMOTE" "$MERGED"] - } else { - set cmdline [list "$merge_tool_path" -wait -2 \ - -title1:"'$MERGED (Local)'" -title2:"'$MERGED (Remote)'" \ - "$LOCAL" "$REMOTE" "$MERGED"] - } - } - bc3 { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" "$LOCAL" "$REMOTE" "$BASE" "-mergeoutput=$MERGED"] - } else { - set cmdline [list "$merge_tool_path" "$LOCAL" "$REMOTE" "-mergeoutput=$MERGED"] - } - } - ecmerge { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" "$BASE" "$LOCAL" "$REMOTE" --default --mode=merge3 --to="$MERGED"] - } else { - set cmdline [list "$merge_tool_path" "$LOCAL" "$REMOTE" --default --mode=merge2 --to="$MERGED"] - } - } - emerge { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" -f emerge-files-with-ancestor-command \ - "$LOCAL" "$REMOTE" "$BASE" "$basename"] - } else { - set cmdline [list "$merge_tool_path" -f emerge-files-command \ - "$LOCAL" "$REMOTE" "$basename"] - } - } - gvimdiff { - set cmdline [list "$merge_tool_path" -f "$LOCAL" "$MERGED" "$REMOTE"] - } - kdiff3 { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" --auto --L1 "$MERGED (Base)" \ - --L2 "$MERGED (Local)" --L3 "$MERGED (Remote)" -o "$MERGED" "$BASE" "$LOCAL" "$REMOTE"] - } else { - set cmdline [list "$merge_tool_path" --auto --L1 "$MERGED (Local)" \ - --L2 "$MERGED (Remote)" -o "$MERGED" "$LOCAL" "$REMOTE"] - } - } - meld { - set cmdline [list "$merge_tool_path" "$LOCAL" "$MERGED" "$REMOTE"] - } - opendiff { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" "$LOCAL" "$REMOTE" -ancestor "$BASE" -merge "$MERGED"] - } else { - set cmdline [list "$merge_tool_path" "$LOCAL" "$REMOTE" -merge "$MERGED"] - } - } - p4merge { - set cmdline [list "$merge_tool_path" "$BASE" "$REMOTE" "$LOCAL" "$MERGED"] - } - tkdiff { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" -a "$BASE" -o "$MERGED" "$LOCAL" "$REMOTE"] - } else { - set cmdline [list "$merge_tool_path" -o "$MERGED" "$LOCAL" "$REMOTE"] - } - } - vimdiff { - error_popup [mc "Not a GUI merge tool: '%s'" $tool] - return - } - winmerge { - if {$base_stage ne {}} { - # This tool does not support 3-way merges. - # Use the 'conflict file' resolution feature instead. - set cmdline [list "$merge_tool_path" -e -ub "$MERGED"] - } else { - set cmdline [list "$merge_tool_path" -e -ub -wl \ - -dl "Theirs File" -dr "Mine File" "$REMOTE" "$LOCAL" "$MERGED"] - } - } - xxdiff { - if {$base_stage ne {}} { - set cmdline [list "$merge_tool_path" -X --show-merged-pane \ - -R {Accel.SaveAsMerged: "Ctrl-S"} \ - -R {Accel.Search: "Ctrl+F"} \ - -R {Accel.SearchForward: "Ctrl-G"} \ - --merged-file "$MERGED" "$LOCAL" "$BASE" "$REMOTE"] - } else { - set cmdline [list "$merge_tool_path" -X --show-merged-pane \ - -R {Accel.SaveAsMerged: "Ctrl-S"} \ - -R {Accel.Search: "Ctrl+F"} \ - -R {Accel.SearchForward: "Ctrl-G"} \ - --merged-file "$MERGED" "$LOCAL" "$REMOTE"] - } - } - default { - error_popup [mc "Unsupported merge tool '%s'" $tool] - return - } - } - - merge_tool_start $cmdline $MERGED $BACKUP [list $BASE $LOCAL $REMOTE] -} - -proc delete_temp_files {files} { - foreach fname $files { - file delete $fname - } -} - -proc merge_tool_get_stages {target stages} { - global merge_stages - - set i 1 - foreach fname $stages { - if {$merge_stages($i) eq {}} { - file delete $fname - catch { close [open $fname w] } - } else { - # A hack to support autocrlf properly - git checkout-index -f --stage=$i -- $target - file rename -force -- $target $fname - } - incr i - } -} - -proc merge_tool_start {cmdline target backup stages} { - global merge_stages mtool_target mtool_tmpfiles mtool_fd mtool_mtime - - if {[info exists mtool_fd]} { - if {[ask_popup [mc "Merge tool is already running, terminate it?"]] eq {yes}} { - catch { kill_file_process $mtool_fd } - catch { close $mtool_fd } - unset mtool_fd - - set old_backup [lindex $mtool_tmpfiles end] - file rename -force -- $old_backup $mtool_target - delete_temp_files $mtool_tmpfiles - } else { - return - } - } - - # Save the original file - file rename -force -- $target $backup - - # Get the blobs; it destroys $target - if {[catch {merge_tool_get_stages $target $stages} err]} { - file rename -force -- $backup $target - delete_temp_files $stages - error_popup [mc "Error retrieving versions:\n%s" $err] - return - } - - # Restore the conflict file - file copy -force -- $backup $target - - # Initialize global state - set mtool_target $target - set mtool_mtime [file mtime $target] - set mtool_tmpfiles $stages - - lappend mtool_tmpfiles $backup - - # Force redirection to avoid interpreting output on stderr - # as an error, and launch the tool - lappend cmdline {2>@1} - - if {[catch { set mtool_fd [_open_stdout_stderr $cmdline] } err]} { - delete_temp_files $mtool_tmpfiles - error_popup [mc "Could not start the merge tool:\n\n%s" $err] - return - } - - ui_status [mc "Running merge tool..."] - - fconfigure $mtool_fd -blocking 0 -translation binary -encoding binary - fileevent $mtool_fd readable [list read_mtool_output $mtool_fd] -} - -proc read_mtool_output {fd} { - global mtool_fd mtool_tmpfiles - - read $fd - if {[eof $fd]} { - unset mtool_fd - - fconfigure $fd -blocking 1 - merge_tool_finish $fd - } -} - -proc merge_tool_finish {fd} { - global mtool_tmpfiles mtool_target mtool_mtime - - set backup [lindex $mtool_tmpfiles end] - set failed 0 - - # Check the return code - if {[catch {close $fd} err]} { - set failed 1 - if {$err ne {child process exited abnormally}} { - error_popup [strcat [mc "Merge tool failed."] "\n\n$err"] - } - } - - # Finish - if {$failed} { - file rename -force -- $backup $mtool_target - delete_temp_files $mtool_tmpfiles - ui_status [mc "Merge tool failed."] - } else { - if {[is_config_true mergetool.keepbackup]} { - file rename -force -- $backup "$mtool_target.orig" - } - - delete_temp_files $mtool_tmpfiles - - reshow_diff - } -} diff --git a/lib/option.tcl b/lib/option.tcl deleted file mode 100644 index b5b6b2fea6..0000000000 --- a/lib/option.tcl +++ /dev/null @@ -1,349 +0,0 @@ -# git-gui options editor -# Copyright (C) 2006, 2007 Shawn Pearce - -proc config_check_encodings {} { - global repo_config_new global_config_new - - set enc $global_config_new(gui.encoding) - if {$enc eq {}} { - set global_config_new(gui.encoding) [encoding system] - } elseif {[tcl_encoding $enc] eq {}} { - error_popup [mc "Invalid global encoding '%s'" $enc] - return 0 - } - - set enc $repo_config_new(gui.encoding) - if {$enc eq {}} { - set repo_config_new(gui.encoding) [encoding system] - } elseif {[tcl_encoding $enc] eq {}} { - error_popup [mc "Invalid repo encoding '%s'" $enc] - return 0 - } - - return 1 -} - -proc save_config {} { - global default_config font_descs - global repo_config global_config system_config - global repo_config_new global_config_new - global ui_comm_spell - - foreach option $font_descs { - set name [lindex $option 0] - set font [lindex $option 1] - font configure $font \ - -family $global_config_new(gui.$font^^family) \ - -size $global_config_new(gui.$font^^size) - font configure ${font}bold \ - -family $global_config_new(gui.$font^^family) \ - -size $global_config_new(gui.$font^^size) - font configure ${font}italic \ - -family $global_config_new(gui.$font^^family) \ - -size $global_config_new(gui.$font^^size) - set global_config_new(gui.$name) [font configure $font] - unset global_config_new(gui.$font^^family) - unset global_config_new(gui.$font^^size) - } - - foreach name [array names default_config] { - set value $global_config_new($name) - if {$value ne $global_config($name)} { - if {$value eq $system_config($name)} { - catch {git config --global --unset $name} - } else { - regsub -all "\[{}\]" $value {"} value - git config --global $name $value - } - set global_config($name) $value - if {$value eq $repo_config($name)} { - catch {git config --unset $name} - set repo_config($name) $value - } - } - } - - foreach name [array names default_config] { - set value $repo_config_new($name) - if {$value ne $repo_config($name)} { - if {$value eq $global_config($name)} { - catch {git config --unset $name} - } else { - regsub -all "\[{}\]" $value {"} value - git config $name $value - } - set repo_config($name) $value - } - } - - if {[info exists repo_config(gui.spellingdictionary)]} { - set value $repo_config(gui.spellingdictionary) - if {$value eq {none}} { - if {[info exists ui_comm_spell]} { - $ui_comm_spell stop - } - } elseif {[info exists ui_comm_spell]} { - $ui_comm_spell lang $value - } - } -} - -proc do_options {} { - global repo_config global_config font_descs - global repo_config_new global_config_new - global ui_comm_spell use_ttk NS - - array unset repo_config_new - array unset global_config_new - foreach name [array names repo_config] { - set repo_config_new($name) $repo_config($name) - } - load_config 1 - foreach name [array names repo_config] { - switch -- $name { - gui.diffcontext {continue} - } - set repo_config_new($name) $repo_config($name) - } - foreach name [array names global_config] { - set global_config_new($name) $global_config($name) - } - - set w .options_editor - Dialog $w - wm withdraw $w - wm transient $w [winfo parent $w] - wm geometry $w "+[winfo rootx .]+[winfo rooty .]" - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.restore -text [mc "Restore Defaults"] \ - -default normal \ - -command do_restore_defaults - pack $w.buttons.restore -side left - ${NS}::button $w.buttons.save -text [mc Save] \ - -default active \ - -command [list do_save_config $w] - pack $w.buttons.save -side right - ${NS}::button $w.buttons.cancel -text [mc "Cancel"] \ - -default normal \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.repo -text [mc "%s Repository" [reponame]] - ${NS}::labelframe $w.global -text [mc "Global (All Repositories)"] - pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5 - pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5 - - set optid 0 - foreach option { - {t user.name {mc "User Name"}} - {t user.email {mc "Email Address"}} - - {b merge.summary {mc "Summarize Merge Commits"}} - {i-1..5 merge.verbosity {mc "Merge Verbosity"}} - {b merge.diffstat {mc "Show Diffstat After Merge"}} - {t merge.tool {mc "Use Merge Tool"}} - - {b gui.trustmtime {mc "Trust File Modification Timestamps"}} - {b gui.pruneduringfetch {mc "Prune Tracking Branches During Fetch"}} - {b gui.matchtrackingbranch {mc "Match Tracking Branches"}} - {b gui.textconv {mc "Use Textconv For Diffs and Blames"}} - {b gui.fastcopyblame {mc "Blame Copy Only On Changed Files"}} - {i-0..100 gui.maxrecentrepo {mc "Maximum Length of Recent Repositories List"}} - {i-20..200 gui.copyblamethreshold {mc "Minimum Letters To Blame Copy On"}} - {i-0..300 gui.blamehistoryctx {mc "Blame History Context Radius (days)"}} - {i-1..99 gui.diffcontext {mc "Number of Diff Context Lines"}} - {t gui.diffopts {mc "Additional Diff Parameters"}} - {i-0..99 gui.commitmsgwidth {mc "Commit Message Text Width"}} - {t gui.newbranchtemplate {mc "New Branch Name Template"}} - {c gui.encoding {mc "Default File Contents Encoding"}} - {b gui.warndetachedcommit {mc "Warn before committing to a detached head"}} - {s gui.stageuntracked {mc "Staging of untracked files"} {list "yes" "no" "ask"}} - {b gui.displayuntracked {mc "Show untracked files"}} - {i-1..99 gui.tabsize {mc "Tab spacing"}} - } { - set type [lindex $option 0] - set name [lindex $option 1] - set text [eval [lindex $option 2]] - incr optid - foreach f {repo global} { - switch -glob -- $type { - b { - ${NS}::checkbutton $w.$f.$optid -text $text \ - -variable ${f}_config_new($name) \ - -onvalue true \ - -offvalue false - pack $w.$f.$optid -side top -anchor w - } - i-* { - regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max - ${NS}::frame $w.$f.$optid - ${NS}::label $w.$f.$optid.l -text "$text:" - pack $w.$f.$optid.l -side left -anchor w -fill x - tspinbox $w.$f.$optid.v \ - -textvariable ${f}_config_new($name) \ - -from $min \ - -to $max \ - -increment 1 \ - -width [expr {1 + [string length $max]}] - bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end} - pack $w.$f.$optid.v -side right -anchor e -padx 5 - pack $w.$f.$optid -side top -anchor w -fill x - } - c - - t { - ${NS}::frame $w.$f.$optid - ${NS}::label $w.$f.$optid.l -text "$text:" - ${NS}::entry $w.$f.$optid.v \ - -width 20 \ - -textvariable ${f}_config_new($name) - pack $w.$f.$optid.l -side left -anchor w - pack $w.$f.$optid.v -side left -anchor w \ - -fill x -expand 1 \ - -padx 5 - if {$type eq {c}} { - menu $w.$f.$optid.m - build_encoding_menu $w.$f.$optid.m \ - [list set ${f}_config_new($name)] 1 - ${NS}::button $w.$f.$optid.b \ - -text [mc "Change"] \ - -command [list popup_btn_menu \ - $w.$f.$optid.m $w.$f.$optid.b] - pack $w.$f.$optid.b -side left -anchor w - } - pack $w.$f.$optid -side top -anchor w -fill x - } - s { - set opts [eval [lindex $option 3]] - ${NS}::frame $w.$f.$optid - ${NS}::label $w.$f.$optid.l -text "$text:" - if {$use_ttk} { - ttk::combobox $w.$f.$optid.v \ - -textvariable ${f}_config_new($name) \ - -values $opts -state readonly - } else { - eval tk_optionMenu $w.$f.$optid.v \ - ${f}_config_new($name) \ - $opts - } - pack $w.$f.$optid.l -side left -anchor w -fill x - pack $w.$f.$optid.v -side right -anchor e -padx 5 - pack $w.$f.$optid -side top -anchor w -fill x - } - } - } - } - - set all_dicts [linsert \ - [spellcheck::available_langs] \ - 0 \ - none] - incr optid - foreach f {repo global} { - if {![info exists ${f}_config_new(gui.spellingdictionary)]} { - if {[info exists ui_comm_spell]} { - set value [$ui_comm_spell lang] - } else { - set value none - } - set ${f}_config_new(gui.spellingdictionary) $value - } - - ${NS}::frame $w.$f.$optid - ${NS}::label $w.$f.$optid.l -text [mc "Spelling Dictionary:"] - if {$use_ttk} { - ttk::combobox $w.$f.$optid.v \ - -textvariable ${f}_config_new(gui.spellingdictionary) \ - -values $all_dicts -state readonly - } else { - eval tk_optionMenu $w.$f.$optid.v \ - ${f}_config_new(gui.spellingdictionary) \ - $all_dicts - } - pack $w.$f.$optid.l -side left -anchor w -fill x - pack $w.$f.$optid.v -side right -anchor e -padx 5 - pack $w.$f.$optid -side top -anchor w -fill x - } - unset all_dicts - - set all_fonts [lsort [font families]] - foreach option $font_descs { - set name [lindex $option 0] - set font [lindex $option 1] - set text [eval [lindex $option 2]] - - set global_config_new(gui.$font^^family) \ - [font configure $font -family] - set global_config_new(gui.$font^^size) \ - [font configure $font -size] - - ${NS}::frame $w.global.$name - ${NS}::label $w.global.$name.l -text "$text:" - ${NS}::button $w.global.$name.b \ - -text [mc "Change Font"] \ - -command [list \ - tchoosefont \ - $w \ - [mc "Choose %s" $text] \ - global_config_new(gui.$font^^family) \ - global_config_new(gui.$font^^size) \ - ] - ${NS}::label $w.global.$name.f -textvariable global_config_new(gui.$font^^family) - ${NS}::label $w.global.$name.s -textvariable global_config_new(gui.$font^^size) - ${NS}::label $w.global.$name.pt -text [mc "pt."] - pack $w.global.$name.l -side left -anchor w - pack $w.global.$name.b -side right -anchor e - pack $w.global.$name.pt -side right -anchor w - pack $w.global.$name.s -side right -anchor w - pack $w.global.$name.f -side right -anchor w - pack $w.global.$name -side top -anchor w -fill x - } - - bind $w <Visibility> "grab $w; focus $w.buttons.save" - bind $w <Key-Escape> "destroy $w" - bind $w <Key-Return> [list do_save_config $w] - - if {[is_MacOSX]} { - set t [mc "Preferences"] - } else { - set t [mc "Options"] - } - wm title $w "[appname] ([reponame]): $t" - wm deiconify $w - tkwait window $w -} - -proc do_restore_defaults {} { - global font_descs default_config repo_config system_config - global repo_config_new global_config_new - - foreach name [array names default_config] { - set repo_config_new($name) $system_config($name) - set global_config_new($name) $system_config($name) - } - - foreach option $font_descs { - set name [lindex $option 0] - set repo_config(gui.$name) $system_config(gui.$name) - } - apply_config - - foreach option $font_descs { - set name [lindex $option 0] - set font [lindex $option 1] - set global_config_new(gui.$font^^family) \ - [font configure $font -family] - set global_config_new(gui.$font^^size) \ - [font configure $font -size] - } -} - -proc do_save_config {w} { - if {![config_check_encodings]} return - if {[catch {save_config} err]} { - error_popup [strcat [mc "Failed to completely save options:"] "\n\n$err"] - } - reshow_diff - destroy $w -} diff --git a/lib/remote.tcl b/lib/remote.tcl deleted file mode 100644 index 4e5c784418..0000000000 --- a/lib/remote.tcl +++ /dev/null @@ -1,333 +0,0 @@ -# git-gui remote management -# Copyright (C) 2006, 2007 Shawn Pearce - -set some_heads_tracking 0; # assume not - -proc is_tracking_branch {name} { - global tracking_branches - foreach spec $tracking_branches { - set t [lindex $spec 0] - if {$t eq $name || [string match $t $name]} { - return 1 - } - } - return 0 -} - -proc all_tracking_branches {} { - global tracking_branches - - set all [list] - set pat [list] - set cmd [list] - - foreach spec $tracking_branches { - set dst [lindex $spec 0] - if {[string range $dst end-1 end] eq {/*}} { - lappend pat $spec - lappend cmd [string range $dst 0 end-2] - } else { - lappend all $spec - } - } - - if {$pat ne {}} { - set fd [eval git_read for-each-ref --format=%(refname) $cmd] - while {[gets $fd n] > 0} { - foreach spec $pat { - set dst [string range [lindex $spec 0] 0 end-2] - set len [string length $dst] - if {[string equal -length $len $dst $n]} { - set src [string range [lindex $spec 2] 0 end-2] - set spec [list \ - $n \ - [lindex $spec 1] \ - $src[string range $n $len end] \ - ] - lappend all $spec - } - } - } - close $fd - } - - return [lsort -index 0 -unique $all] -} - -proc load_all_remotes {} { - global repo_config - global all_remotes tracking_branches some_heads_tracking - global remote_url - - set some_heads_tracking 0 - set all_remotes [list] - set trck [list] - - set rh_str refs/heads/ - set rh_len [string length $rh_str] - set rm_dir [gitdir remotes] - if {[file isdirectory $rm_dir]} { - set all_remotes [glob \ - -types f \ - -tails \ - -nocomplain \ - -directory $rm_dir *] - - foreach name $all_remotes { - catch { - set fd [open [file join $rm_dir $name] r] - while {[gets $fd line] >= 0} { - if {[regexp {^URL:[ ]*(.+)$} $line line url]} { - set remote_url($name) $url - continue - } - if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \ - $line line src dst]} continue - if {[string index $src 0] eq {+}} { - set src [string range $src 1 end] - } - if {![string equal -length 5 refs/ $src]} { - set src $rh_str$src - } - if {![string equal -length 5 refs/ $dst]} { - set dst $rh_str$dst - } - if {[string equal -length $rh_len $rh_str $dst]} { - set some_heads_tracking 1 - } - lappend trck [list $dst $name $src] - } - close $fd - } - } - } - - foreach line [array names repo_config remote.*.url] { - if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue - lappend all_remotes $name - set remote_url($name) $repo_config(remote.$name.url) - - if {[catch {set fl $repo_config(remote.$name.fetch)}]} { - set fl {} - } - foreach line $fl { - if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue - if {[string index $src 0] eq {+}} { - set src [string range $src 1 end] - } - if {![string equal -length 5 refs/ $src]} { - set src $rh_str$src - } - if {![string equal -length 5 refs/ $dst]} { - set dst $rh_str$dst - } - if {[string equal -length $rh_len $rh_str $dst]} { - set some_heads_tracking 1 - } - lappend trck [list $dst $name $src] - } - } - - set tracking_branches [lsort -index 0 -unique $trck] - set all_remotes [lsort -unique $all_remotes] -} - -proc add_fetch_entry {r} { - global repo_config - set remote_m .mbar.remote - set fetch_m $remote_m.fetch - set prune_m $remote_m.prune - set remove_m $remote_m.remove - set enable 0 - if {![catch {set a $repo_config(remote.$r.url)}]} { - if {![catch {set a $repo_config(remote.$r.fetch)}]} { - set enable 1 - } - } else { - catch { - set fd [open [gitdir remotes $r] r] - while {[gets $fd n] >= 0} { - if {[regexp {^Pull:[ \t]*([^:]+):} $n]} { - set enable 1 - break - } - } - close $fd - } - } - - if {$enable} { - make_sure_remote_submenues_exist $remote_m - - $fetch_m add command \ - -label $r \ - -command [list fetch_from $r] - $prune_m add command \ - -label $r \ - -command [list prune_from $r] - $remove_m add command \ - -label $r \ - -command [list remove_remote $r] - } -} - -proc add_push_entry {r} { - global repo_config - set remote_m .mbar.remote - set push_m $remote_m.push - set enable 0 - if {![catch {set a $repo_config(remote.$r.url)}]} { - if {![catch {set a $repo_config(remote.$r.push)}]} { - set enable 1 - } - } else { - catch { - set fd [open [gitdir remotes $r] r] - while {[gets $fd n] >= 0} { - if {[regexp {^Push:[ \t]*([^:]+):} $n]} { - set enable 1 - break - } - } - close $fd - } - } - - if {$enable} { - if {![winfo exists $push_m]} { - menu $push_m - $remote_m insert 0 cascade \ - -label [mc "Push to"] \ - -menu $push_m - } - - $push_m add command \ - -label $r \ - -command [list push_to $r] - } -} - -proc make_sure_remote_submenues_exist {remote_m} { - set fetch_m $remote_m.fetch - set prune_m $remote_m.prune - set remove_m $remote_m.remove - - if {![winfo exists $fetch_m]} { - menu $remove_m - $remote_m insert 0 cascade \ - -label [mc "Remove Remote"] \ - -menu $remove_m - - menu $prune_m - $remote_m insert 0 cascade \ - -label [mc "Prune from"] \ - -menu $prune_m - - menu $fetch_m - $remote_m insert 0 cascade \ - -label [mc "Fetch from"] \ - -menu $fetch_m - } -} - -proc update_all_remotes_menu_entry {} { - global all_remotes - - if {[git-version < 1.6.6]} { return } - - set have_remote 0 - foreach r $all_remotes { - incr have_remote - } - - set remote_m .mbar.remote - set fetch_m $remote_m.fetch - set prune_m $remote_m.prune - if {$have_remote > 1} { - make_sure_remote_submenues_exist $remote_m - if {[$fetch_m type end] eq "command" \ - && [$fetch_m entrycget end -label] ne "All"} { - - $fetch_m insert end separator - $fetch_m insert end command \ - -label "All" \ - -command fetch_from_all - - $prune_m insert end separator - $prune_m insert end command \ - -label "All" \ - -command prune_from_all - } - } else { - if {[winfo exists $fetch_m]} { - if {[$fetch_m type end] eq "command" \ - && [$fetch_m entrycget end -label] eq "All"} { - - delete_from_menu $fetch_m end - delete_from_menu $fetch_m end - - delete_from_menu $prune_m end - delete_from_menu $prune_m end - } - } - } -} - -proc populate_remotes_menu {} { - global all_remotes - - foreach r $all_remotes { - add_fetch_entry $r - add_push_entry $r - } - - update_all_remotes_menu_entry -} - -proc add_single_remote {name location} { - global all_remotes repo_config - lappend all_remotes $name - - git remote add $name $location - - # XXX: Better re-read the config so that we will never get out - # of sync with git remote implementation? - set repo_config(remote.$name.url) $location - set repo_config(remote.$name.fetch) "+refs/heads/*:refs/remotes/$name/*" - - add_fetch_entry $name - add_push_entry $name - - update_all_remotes_menu_entry -} - -proc delete_from_menu {menu name} { - if {[winfo exists $menu]} { - $menu delete $name - } -} - -proc remove_remote {name} { - global all_remotes repo_config - - git remote rm $name - - catch { - # Missing values are ok - unset repo_config(remote.$name.url) - unset repo_config(remote.$name.fetch) - unset repo_config(remote.$name.push) - } - - set i [lsearch -exact $all_remotes $name] - set all_remotes [lreplace $all_remotes $i $i] - - set remote_m .mbar.remote - delete_from_menu $remote_m.fetch $name - delete_from_menu $remote_m.prune $name - delete_from_menu $remote_m.remove $name - # Not all remotes are in the push menu - catch { delete_from_menu $remote_m.push $name } - - update_all_remotes_menu_entry -} diff --git a/lib/remote_add.tcl b/lib/remote_add.tcl deleted file mode 100644 index 50029d0cee..0000000000 --- a/lib/remote_add.tcl +++ /dev/null @@ -1,190 +0,0 @@ -# git-gui remote adding support -# Copyright (C) 2008 Petr Baudis - -class remote_add { - -field w ; # widget path -field w_name ; # new remote name widget -field w_loc ; # new remote location widget - -field name {}; # name of the remote the user has chosen -field location {}; # location of the remote the user has chosen - -field opt_action fetch; # action to do after registering the remote locally - -constructor dialog {} { - global repo_config use_ttk NS - - make_dialog top w - wm withdraw $top - wm title $top [append "[appname] ([reponame]): " [mc "Add Remote"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - ${NS}::label $w.header -text [mc "Add New Remote"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.create -text [mc Add] \ - -default active \ - -command [cb _add] - pack $w.buttons.create -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.desc -text [mc "Remote Details"] - - ${NS}::label $w.desc.name_l -text [mc "Name:"] - set w_name $w.desc.name_t - ${NS}::entry $w_name \ - -width 40 \ - -textvariable @name \ - -validate key \ - -validatecommand [cb _validate_name %d %S] - grid $w.desc.name_l $w_name -sticky we -padx {0 5} - - ${NS}::label $w.desc.loc_l -text [mc "Location:"] - set w_loc $w.desc.loc_t - ${NS}::entry $w_loc \ - -width 40 \ - -textvariable @location - grid $w.desc.loc_l $w_loc -sticky we -padx {0 5} - - grid columnconfigure $w.desc 1 -weight 1 - pack $w.desc -anchor nw -fill x -pady 5 -padx 5 - - ${NS}::labelframe $w.action -text [mc "Further Action"] - - ${NS}::radiobutton $w.action.fetch \ - -text [mc "Fetch Immediately"] \ - -value fetch \ - -variable @opt_action - pack $w.action.fetch -anchor nw - - ${NS}::radiobutton $w.action.push \ - -text [mc "Initialize Remote Repository and Push"] \ - -value push \ - -variable @opt_action - pack $w.action.push -anchor nw - - ${NS}::radiobutton $w.action.none \ - -text [mc "Do Nothing Else Now"] \ - -value none \ - -variable @opt_action - pack $w.action.none -anchor nw - - grid columnconfigure $w.action 1 -weight 1 - pack $w.action -anchor nw -fill x -pady 5 -padx 5 - - bind $w <Visibility> [cb _visible] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _add]\;break - wm deiconify $top - tkwait window $w -} - -method _add {} { - global repo_config env - global M1B - - if {$name eq {}} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Please supply a remote name."] - focus $w_name - return - } - - # XXX: We abuse check-ref-format here, but - # that should be ok. - if {[catch {git check-ref-format "remotes/$name"}]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "'%s' is not an acceptable remote name." $name] - focus $w_name - return - } - - if {[catch {add_single_remote $name $location}]} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Failed to add remote '%s' of location '%s'." $name $location] - focus $w_name - return - } - - switch -- $opt_action { - fetch { - set c [console::new \ - [mc "fetch %s" $name] \ - [mc "Fetching the %s" $name]] - console::exec $c [list git fetch $name] - } - push { - set cmds [list] - - # Parse the location - if { [regexp {(?:git\+)?ssh://([^/]+)(/.+)} $location xx host path] - || [regexp {([^:][^:]+):(.+)} $location xx host path]} { - set ssh ssh - if {[info exists env(GIT_SSH)]} { - set ssh $env(GIT_SSH) - } - lappend cmds [list exec $ssh $host mkdir -p $location && git --git-dir=$path init --bare] - } elseif { ! [regexp {://} $location xx] } { - lappend cmds [list exec mkdir -p $location] - lappend cmds [list exec git --git-dir=$location init --bare] - } else { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Do not know how to initialize repository at location '%s'." $location] - destroy $w - return - } - - set c [console::new \ - [mc "push %s" $name] \ - [mc "Setting up the %s (at %s)" $name $location]] - - lappend cmds [list exec git push -v --all $name] - console::chain $c $cmds - } - none { - } - } - - destroy $w -} - -method _validate_name {d S} { - if {$d == 1} { - if {[regexp {[~^:?*\[\0- ]} $S]} { - return 0 - } - } - return 1 -} - -method _visible {} { - grab $w - $w_name icursor end - focus $w_name -} - -} diff --git a/lib/remote_branch_delete.tcl b/lib/remote_branch_delete.tcl deleted file mode 100644 index fcc06d03a1..0000000000 --- a/lib/remote_branch_delete.tcl +++ /dev/null @@ -1,359 +0,0 @@ -# git-gui remote branch deleting support -# Copyright (C) 2007 Shawn Pearce - -class remote_branch_delete { - -field w -field head_m - -field urltype {url} -field remote {} -field url {} - -field checktype {head} -field check_head {} - -field status {} -field idle_id {} -field full_list {} -field head_list {} -field active_ls {} -field head_cache -field full_cache -field cached - -constructor dialog {} { - global all_remotes M1B use_ttk NS - - make_dialog top w - wm title $top [append "[appname] ([reponame]): " [mc "Delete Branch Remotely"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - } - - ${NS}::label $w.header -text [mc "Delete Branch Remotely"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.delete -text [mc Delete] \ - -default active \ - -command [cb _delete] - pack $w.buttons.delete -side right - ${NS}::button $w.buttons.cancel -text [mc "Cancel"] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.dest -text [mc "From Repository"] - if {$all_remotes ne {}} { - ${NS}::radiobutton $w.dest.remote_r \ - -text [mc "Remote:"] \ - -value remote \ - -variable @urltype - if {$use_ttk} { - ttk::combobox $w.dest.remote_m -textvariable @remote \ - -values $all_remotes -state readonly - } else { - eval tk_optionMenu $w.dest.remote_m @remote $all_remotes - } - grid $w.dest.remote_r $w.dest.remote_m -sticky w - if {[lsearch -sorted -exact $all_remotes origin] != -1} { - set remote origin - } else { - set remote [lindex $all_remotes 0] - } - set urltype remote - trace add variable @remote write [cb _write_remote] - } else { - set urltype url - } - ${NS}::radiobutton $w.dest.url_r \ - -text [mc "Arbitrary Location:"] \ - -value url \ - -variable @urltype - ${NS}::entry $w.dest.url_t \ - -width 50 \ - -textvariable @url \ - -validate key \ - -validatecommand { - if {%d == 1 && [regexp {\s} %S]} {return 0} - return 1 - } - trace add variable @url write [cb _write_url] - grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5} - grid columnconfigure $w.dest 1 -weight 1 - pack $w.dest -anchor nw -fill x -pady 5 -padx 5 - - ${NS}::labelframe $w.heads -text [mc "Branches"] - slistbox $w.heads.l \ - -height 10 \ - -width 70 \ - -listvariable @head_list \ - -selectmode extended - - ${NS}::frame $w.heads.footer - ${NS}::label $w.heads.footer.status \ - -textvariable @status \ - -anchor w \ - -justify left - ${NS}::button $w.heads.footer.rescan \ - -text [mc "Rescan"] \ - -command [cb _rescan] - pack $w.heads.footer.status -side left -fill x - pack $w.heads.footer.rescan -side right - - pack $w.heads.footer -side bottom -fill x - pack $w.heads.l -side left -fill both -expand 1 - pack $w.heads -fill both -expand 1 -pady 5 -padx 5 - - ${NS}::labelframe $w.validate -text [mc "Delete Only If"] - ${NS}::radiobutton $w.validate.head_r \ - -text [mc "Merged Into:"] \ - -value head \ - -variable @checktype - set head_m [tk_optionMenu $w.validate.head_m @check_head {}] - trace add variable @head_list write [cb _write_head_list] - trace add variable @check_head write [cb _write_check_head] - grid $w.validate.head_r $w.validate.head_m -sticky w - ${NS}::radiobutton $w.validate.always_r \ - -text [mc "Always (Do not perform merge checks)"] \ - -value always \ - -variable @checktype - grid $w.validate.always_r -columnspan 2 -sticky w - grid columnconfigure $w.validate 1 -weight 1 - pack $w.validate -anchor nw -fill x -pady 5 -padx 5 - - trace add variable @urltype write [cb _write_urltype] - _rescan $this - - bind $w <Key-F5> [cb _rescan] - bind $w <$M1B-Key-r> [cb _rescan] - bind $w <$M1B-Key-R> [cb _rescan] - bind $w <Key-Return> [cb _delete] - bind $w <Key-Escape> [list destroy $w] - return $w -} - -method _delete {} { - switch $urltype { - remote {set uri $remote} - url {set uri $url} - } - - set cache $urltype:$uri - set crev {} - if {$checktype eq {head}} { - if {$check_head eq {}} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "A branch is required for 'Merged Into'."] - return - } - set crev $full_cache("$cache\nrefs/heads/$check_head") - } - - set not_merged [list] - set need_fetch 0 - set have_selection 0 - set push_cmd [list git push] - lappend push_cmd -v - lappend push_cmd $uri - - foreach i [$w.heads.l curselection] { - set ref [lindex $full_list $i] - if {$crev ne {}} { - set obj $full_cache("$cache\n$ref") - if {[catch {set m [git merge-base $obj $crev]}]} { - set need_fetch 1 - set m {} - } - if {$obj ne $m} { - lappend not_merged [lindex $head_list $i] - continue - } - } - - lappend push_cmd :$ref - set have_selection 1 - } - - if {$not_merged ne {}} { - set msg [mc "The following branches are not completely merged into %s: - - - %s" $check_head [join $not_merged "\n - "]] - - if {$need_fetch} { - append msg "\n\n" [mc "One or more of the merge tests failed because you have not fetched the necessary commits. Try fetching from %s first." $uri] - } - - tk_messageBox \ - -icon info \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message $msg - if {!$have_selection} return - } - - if {!$have_selection} { - tk_messageBox \ - -icon error \ - -type ok \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Please select one or more branches to delete."] - return - } - - if {$checktype ne {head}} { - if {[tk_messageBox \ - -icon warning \ - -type yesno \ - -title [wm title $w] \ - -parent $w \ - -message [mc "Recovering deleted branches is difficult.\n\nDelete the selected branches?"]] ne yes} { - return - } - } - - destroy $w - - set cons [console::new \ - "push $uri" \ - [mc "Deleting branches from %s" $uri]] - console::exec $cons $push_cmd -} - -method _rescan {{force 1}} { - switch $urltype { - remote {set uri $remote} - url {set uri $url} - } - - if {$force} { - unset -nocomplain cached($urltype:$uri) - } - - if {$idle_id ne {}} { - after cancel $idle_id - set idle_id {} - } - - _load $this $urltype:$uri $uri -} - -method _write_remote {args} { set urltype remote } -method _write_url {args} { set urltype url } -method _write_check_head {args} { set checktype head } - -method _write_head_list {args} { - global current_branch _last_merged_branch - - $head_m delete 0 end - foreach abr $head_list { - $head_m insert end radiobutton \ - -label $abr \ - -value $abr \ - -variable @check_head - } - if {[lsearch -exact -sorted $head_list $check_head] < 0} { - if {[lsearch -exact -sorted $head_list $current_branch] < 0} { - set check_head {} - } else { - set check_head $current_branch - } - } - set lmb [lsearch -exact -sorted $head_list $_last_merged_branch] - if {$lmb >= 0} { - $w.heads.l conf -state normal - $w.heads.l select set $lmb - $w.heads.l yview $lmb - $w.heads.l conf -state disabled - } -} - -method _write_urltype {args} { - if {$urltype eq {url}} { - if {$idle_id ne {}} { - after cancel $idle_id - } - _load $this none: {} - set idle_id [after 1000 [cb _rescan 0]] - } else { - _rescan $this 0 - } -} - -method _load {cache uri} { - if {$active_ls ne {}} { - catch {close $active_ls} - } - - if {$uri eq {}} { - $w.heads.l conf -state disabled - set head_list [list] - set full_list [list] - set status [mc "No repository selected."] - return - } - - if {[catch {set x $cached($cache)}]} { - set status [mc "Scanning %s..." $uri] - $w.heads.l conf -state disabled - set head_list [list] - set full_list [list] - set head_cache($cache) [list] - set full_cache($cache) [list] - set active_ls [git_read ls-remote $uri] - fconfigure $active_ls \ - -blocking 0 \ - -translation lf \ - -encoding utf-8 - fileevent $active_ls readable [cb _read $cache $active_ls] - } else { - set status {} - set full_list $full_cache($cache) - set head_list $head_cache($cache) - $w.heads.l conf -state normal - } -} - -method _read {cache fd} { - if {$fd ne $active_ls} { - catch {close $fd} - return - } - - while {[gets $fd line] >= 0} { - if {[string match {*^{}} $line]} continue - if {[regexp {^([0-9a-f]{40}) (.*)$} $line _junk obj ref]} { - if {[regsub ^refs/heads/ $ref {} abr]} { - lappend head_list $abr - lappend head_cache($cache) $abr - lappend full_list $ref - lappend full_cache($cache) $ref - set full_cache("$cache\n$ref") $obj - } - } - } - - if {[eof $fd]} { - if {[catch {close $fd} err]} { - set status $err - set head_list [list] - set full_list [list] - } else { - set status {} - set cached($cache) 1 - $w.heads.l conf -state normal - } - } -} ifdeleted { - catch {close $fd} -} - -} diff --git a/lib/search.tcl b/lib/search.tcl deleted file mode 100644 index ef1e55521d..0000000000 --- a/lib/search.tcl +++ /dev/null @@ -1,300 +0,0 @@ -# incremental search panel -# based on code from gitk, Copyright (C) Paul Mackerras - -class searchbar { - -field w -field ctext - -field searchstring {} -field regexpsearch -field default_regexpsearch -field casesensitive -field default_casesensitive -field smartcase -field searchdirn -forwards - -field history -field history_index - -field smarktop -field smarkbot - -constructor new {i_w i_text args} { - global use_ttk NS - set w $i_w - set ctext $i_text - - set default_regexpsearch [is_config_true gui.search.regexp] - switch -- [get_config gui.search.case] { - no { - set default_casesensitive 0 - set smartcase 0 - } - smart { - set default_casesensitive 0 - set smartcase 1 - } - yes - - default { - set default_casesensitive 1 - set smartcase 0 - } - } - - set history [list] - - ${NS}::frame $w - ${NS}::label $w.l -text [mc Find:] - tentry $w.ent -textvariable ${__this}::searchstring -background lightgreen - ${NS}::button $w.bn -text [mc Next] -command [cb find_next] - ${NS}::button $w.bp -text [mc Prev] -command [cb find_prev] - ${NS}::checkbutton $w.re -text [mc RegExp] \ - -variable ${__this}::regexpsearch -command [cb _incrsearch] - ${NS}::checkbutton $w.cs -text [mc Case] \ - -variable ${__this}::casesensitive -command [cb _incrsearch] - pack $w.l -side left - pack $w.cs -side right - pack $w.re -side right - pack $w.bp -side right - pack $w.bn -side right - pack $w.ent -side left -expand 1 -fill x - - eval grid conf $w -sticky we $args - grid remove $w - - trace add variable searchstring write [cb _incrsearch_cb] - bind $w.ent <Return> [cb find_next] - bind $w.ent <Shift-Return> [cb find_prev] - bind $w.ent <Key-Up> [cb _prev_search] - bind $w.ent <Key-Down> [cb _next_search] - - bind $w <Destroy> [list delete_this $this] - return $this -} - -method show {} { - if {![visible $this]} { - grid $w - $w.ent delete 0 end - set regexpsearch $default_regexpsearch - set casesensitive $default_casesensitive - set history_index [llength $history] - } - focus -force $w.ent -} - -method hide {} { - if {[visible $this]} { - focus $ctext - grid remove $w - _save_search $this - } -} - -method visible {} { - return [winfo ismapped $w] -} - -method editor {} { - return $w.ent -} - -method _get_new_anchor {} { - # use start of selection if it is visible, - # or the bounds of the visible area - set top [$ctext index @0,0] - set bottom [$ctext index @0,[winfo height $ctext]] - set sel [$ctext tag ranges sel] - if {$sel ne {}} { - set spos [lindex $sel 0] - if {[lindex $spos 0] >= [lindex $top 0] && - [lindex $spos 0] <= [lindex $bottom 0]} { - return $spos - } - } - if {$searchdirn eq "-forwards"} { - return $top - } else { - return $bottom - } -} - -method _get_wrap_anchor {dir} { - if {$dir eq "-forwards"} { - return 1.0 - } else { - return end - } -} - -method _do_search {start {mlenvar {}} {dir {}} {endbound {}}} { - set cmd [list $ctext search] - if {$mlenvar ne {}} { - upvar $mlenvar mlen - lappend cmd -count mlen - } - if {$regexpsearch} { - lappend cmd -regexp - } - if {!$casesensitive} { - lappend cmd -nocase - } - if {$dir eq {}} { - set dir $searchdirn - } - lappend cmd $dir -- $searchstring - if {[catch { - if {$endbound ne {}} { - set here [eval $cmd [list $start] [list $endbound]] - } else { - set here [eval $cmd [list $start]] - if {$here eq {}} { - set here [eval $cmd [_get_wrap_anchor $this $dir]] - } - } - } err]} { set here {} } - return $here -} - -method _incrsearch_cb {name ix op} { - after idle [cb _incrsearch] -} - -method _incrsearch {} { - $ctext tag remove found 1.0 end - if {[catch {$ctext index anchor}]} { - $ctext mark set anchor [_get_new_anchor $this] - } - if {$searchstring ne {}} { - if {$smartcase && [regexp {[[:upper:]]} $searchstring]} { - set casesensitive 1 - } - set here [_do_search $this anchor mlen] - if {$here ne {}} { - $ctext see $here - $ctext tag remove sel 1.0 end - $ctext tag add sel $here "$here + $mlen c" - #$w.ent configure -background lightgreen - $w.ent state !pressed - _set_marks $this 1 - } else { - #$w.ent configure -background lightpink - $w.ent state pressed - } - } elseif {$smartcase} { - # clearing the field resets the smart case detection - set casesensitive 0 - } -} - -method _save_search {} { - if {$searchstring eq {}} { - return - } - if {[llength $history] > 0} { - foreach {s_regexp s_case s_expr} [lindex $history end] break - } else { - set s_regexp $regexpsearch - set s_case $casesensitive - set s_expr "" - } - if {$searchstring eq $s_expr} { - # update modes - set history [lreplace $history end end \ - [list $regexpsearch $casesensitive $searchstring]] - } else { - lappend history [list $regexpsearch $casesensitive $searchstring] - } - set history_index [llength $history] -} - -method _prev_search {} { - if {$history_index > 0} { - incr history_index -1 - foreach {s_regexp s_case s_expr} [lindex $history $history_index] break - $w.ent delete 0 end - $w.ent insert 0 $s_expr - set regexpsearch $s_regexp - set casesensitive $s_case - } -} - -method _next_search {} { - if {$history_index < [llength $history]} { - incr history_index - } - if {$history_index < [llength $history]} { - foreach {s_regexp s_case s_expr} [lindex $history $history_index] break - } else { - set s_regexp $default_regexpsearch - set s_case $default_casesensitive - set s_expr "" - } - $w.ent delete 0 end - $w.ent insert 0 $s_expr - set regexpsearch $s_regexp - set casesensitive $s_case -} - -method find_prev {} { - find_next $this -backwards -} - -method find_next {{dir -forwards}} { - focus $w.ent - $w.ent icursor end - set searchdirn $dir - $ctext mark unset anchor - if {$searchstring ne {}} { - _save_search $this - set start [_get_new_anchor $this] - if {$dir eq "-forwards"} { - set start "$start + 1c" - } - set match [_do_search $this $start mlen] - $ctext tag remove sel 1.0 end - if {$match ne {}} { - $ctext see $match - $ctext tag add sel $match "$match + $mlen c" - } - } -} - -method _mark_range {first last} { - set mend $first.0 - while {1} { - set match [_do_search $this $mend mlen -forwards $last.end] - if {$match eq {}} break - set mend "$match + $mlen c" - $ctext tag add found $match $mend - } -} - -method _set_marks {doall} { - set topline [lindex [split [$ctext index @0,0] .] 0] - set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0] - if {$doall || $botline < $smarktop || $topline > $smarkbot} { - # no overlap with previous - _mark_range $this $topline $botline - set smarktop $topline - set smarkbot $botline - } else { - if {$topline < $smarktop} { - _mark_range $this $topline [expr {$smarktop-1}] - set smarktop $topline - } - if {$botline > $smarkbot} { - _mark_range $this [expr {$smarkbot+1}] $botline - set smarkbot $botline - } - } -} - -method scrolled {} { - if {$searchstring ne {}} { - after idle [cb _set_marks 0] - } -} - -} diff --git a/lib/shortcut.tcl b/lib/shortcut.tcl deleted file mode 100644 index 78878ef89d..0000000000 --- a/lib/shortcut.tcl +++ /dev/null @@ -1,140 +0,0 @@ -# git-gui desktop icon creators -# Copyright (C) 2006, 2007 Shawn Pearce - -proc do_windows_shortcut {} { - global _gitworktree - set fn [tk_getSaveFile \ - -parent . \ - -title [append "[appname] ([reponame]): " [mc "Create Desktop Icon"]] \ - -initialfile "Git [reponame].lnk"] - if {$fn != {}} { - if {[file extension $fn] ne {.lnk}} { - set fn ${fn}.lnk - } - if {[catch { - win32_create_lnk $fn [list \ - [info nameofexecutable] \ - [file normalize $::argv0] \ - ] \ - [file normalize $_gitworktree] - } err]} { - error_popup [strcat [mc "Cannot write shortcut:"] "\n\n$err"] - } - } -} - -proc do_cygwin_shortcut {} { - global argv0 _gitworktree - - if {[catch { - set desktop [exec cygpath \ - --windows \ - --absolute \ - --long-name \ - --desktop] - }]} { - set desktop . - } - set fn [tk_getSaveFile \ - -parent . \ - -title [append "[appname] ([reponame]): " [mc "Create Desktop Icon"]] \ - -initialdir $desktop \ - -initialfile "Git [reponame].lnk"] - if {$fn != {}} { - if {[file extension $fn] ne {.lnk}} { - set fn ${fn}.lnk - } - if {[catch { - set sh [exec cygpath \ - --windows \ - --absolute \ - /bin/sh.exe] - set me [exec cygpath \ - --unix \ - --absolute \ - $argv0] - win32_create_lnk $fn [list \ - $sh -c \ - "CHERE_INVOKING=1 source /etc/profile;[sq $me] &" \ - ] \ - [file normalize $_gitworktree] - } err]} { - error_popup [strcat [mc "Cannot write shortcut:"] "\n\n$err"] - } - } -} - -proc do_macosx_app {} { - global argv0 env - - set fn [tk_getSaveFile \ - -parent . \ - -title [append "[appname] ([reponame]): " [mc "Create Desktop Icon"]] \ - -initialdir [file join $env(HOME) Desktop] \ - -initialfile "Git [reponame].app"] - if {$fn != {}} { - if {[file extension $fn] ne {.app}} { - set fn ${fn}.app - } - if {[catch { - set Contents [file join $fn Contents] - set MacOS [file join $Contents MacOS] - set exe [file join $MacOS git-gui] - - file mkdir $MacOS - - set fd [open [file join $Contents Info.plist] w] - puts $fd {<?xml version="1.0" encoding="UTF-8"?> -<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd"> -<plist version="1.0"> -<dict> - <key>CFBundleDevelopmentRegion</key> - <string>English</string> - <key>CFBundleExecutable</key> - <string>git-gui</string> - <key>CFBundleIdentifier</key> - <string>org.spearce.git-gui</string> - <key>CFBundleInfoDictionaryVersion</key> - <string>6.0</string> - <key>CFBundlePackageType</key> - <string>APPL</string> - <key>CFBundleSignature</key> - <string>????</string> - <key>CFBundleVersion</key> - <string>1.0</string> - <key>NSPrincipalClass</key> - <string>NSApplication</string> -</dict> -</plist>} - close $fd - - set fd [open $exe w] - puts $fd "#!/bin/sh" - foreach name [lsort [array names env]] { - set value $env($name) - switch -- $name { - GIT_DIR { set value [file normalize [gitdir]] } - } - - switch -glob -- $name { - SSH_* - - GIT_* { - puts $fd "if test \"z\$$name\" = z; then" - puts $fd " export $name=[sq $value]" - puts $fd "fi &&" - } - } - } - puts $fd "export PATH=[sq [file dirname $::_git]]:\$PATH &&" - puts $fd "cd [sq [file normalize [pwd]]] &&" - puts $fd "exec \\" - puts $fd " [sq [info nameofexecutable]] \\" - puts $fd " [sq [file normalize $argv0]]" - close $fd - - file attributes $exe -permissions u+x,g+x,o+x - } err]} { - error_popup [strcat [mc "Cannot write icon:"] "\n\n$err"] - } - } -} diff --git a/lib/spellcheck.tcl b/lib/spellcheck.tcl deleted file mode 100644 index 538d61c792..0000000000 --- a/lib/spellcheck.tcl +++ /dev/null @@ -1,415 +0,0 @@ -# git-gui spellchecking support through ispell/aspell -# Copyright (C) 2008 Shawn Pearce - -class spellcheck { - -field s_fd {} ; # pipe to ispell/aspell -field s_version {} ; # ispell/aspell version string -field s_lang {} ; # current language code -field s_prog aspell; # are we actually old ispell? -field s_failed 0 ; # is $s_prog bogus and not working? - -field w_text ; # text widget we are spelling -field w_menu ; # context menu for the widget -field s_menuidx 0 ; # last index of insertion into $w_menu - -field s_i {} ; # timer registration for _run callbacks -field s_clear 0 ; # did we erase misspelled tags yet? -field s_seen [list] ; # lines last seen from $w_text in _run -field s_checked [list] ; # lines already checked -field s_pending [list] ; # [$line $data] sent to ispell/aspell -field s_suggest ; # array, list of suggestions, keyed by misspelling - -constructor init {pipe_fd ui_text ui_menu} { - set w_text $ui_text - set w_menu $ui_menu - array unset s_suggest - - bind_button3 $w_text [cb _popup_suggest %X %Y @%x,%y] - _connect $this $pipe_fd - return $this -} - -method _connect {pipe_fd} { - fconfigure $pipe_fd \ - -encoding utf-8 \ - -eofchar {} \ - -translation lf - - if {[gets $pipe_fd s_version] <= 0} { - if {[catch {close $pipe_fd} err]} { - - # Eh? Is this actually ispell choking on aspell options? - # - if {$s_prog eq {aspell} - && [regexp -nocase {^Usage: } $err] - && ![catch { - set pipe_fd [open [list | $s_prog -v] r] - gets $pipe_fd s_version - close $pipe_fd - }] - && $s_version ne {}} { - if {{@(#) } eq [string range $s_version 0 4]} { - set s_version [string range $s_version 5 end] - } - set s_failed 1 - error_popup [strcat \ - [mc "Unsupported spell checker"] \ - ":\n\n$s_version"] - set s_version {} - return - } - - regsub -nocase {^Error: } $err {} err - if {$s_fd eq {}} { - error_popup [strcat [mc "Spell checking is unavailable"] ":\n\n$err"] - } else { - error_popup [strcat \ - [mc "Invalid spell checking configuration"] \ - ":\n\n$err\n\n" \ - [mc "Reverting dictionary to %s." $s_lang]] - } - } else { - error_popup [mc "Spell checker silently failed on startup"] - } - return - } - - if {{@(#) } ne [string range $s_version 0 4]} { - catch {close $pipe_fd} - error_popup [strcat [mc "Unrecognized spell checker"] ":\n\n$s_version"] - return - } - set s_version [string range [string trim $s_version] 5 end] - regexp \ - {International Ispell Version .* \(but really (Aspell .*?)\)$} \ - $s_version _junk s_version - regexp {^Aspell (\d)+\.(\d+)} $s_version _junk major minor - - puts $pipe_fd ! ; # enable terse mode - - # fetch the language - if {$major > 0 || ($major == 0 && $minor >= 60)} { - puts $pipe_fd {$$cr master} - flush $pipe_fd - gets $pipe_fd s_lang - regexp {[/\\]([^/\\]+)\.[^\.]+$} $s_lang _ s_lang - } else { - set s_lang {} - } - - if {$::default_config(gui.spellingdictionary) eq {} - && [get_config gui.spellingdictionary] eq {}} { - set ::default_config(gui.spellingdictionary) $s_lang - } - - if {$s_fd ne {}} { - catch {close $s_fd} - } - set s_fd $pipe_fd - - fconfigure $s_fd -blocking 0 - fileevent $s_fd readable [cb _read] - - $w_text tag conf misspelled \ - -foreground red \ - -underline 1 - - array unset s_suggest - set s_seen [list] - set s_checked [list] - set s_pending [list] - _run $this -} - -method lang {{n {}}} { - if {$n ne {} && $s_lang ne $n && !$s_failed} { - set spell_cmd [list |] - lappend spell_cmd aspell - lappend spell_cmd --master=$n - lappend spell_cmd --mode=none - lappend spell_cmd --encoding=UTF-8 - lappend spell_cmd pipe - _connect $this [open $spell_cmd r+] - } - return $s_lang -} - -method version {} { - if {$s_version ne {}} { - return "$s_version, $s_lang" - } - return {} -} - -method stop {} { - while {$s_menuidx > 0} { - $w_menu delete 0 - incr s_menuidx -1 - } - $w_text tag delete misspelled - - catch {close $s_fd} - catch {after cancel $s_i} - set s_fd {} - set s_i {} - set s_lang {} -} - -method _popup_suggest {X Y pos} { - while {$s_menuidx > 0} { - $w_menu delete 0 - incr s_menuidx -1 - } - - set b_loc [$w_text index "$pos wordstart"] - set e_loc [_wordend $this $b_loc] - set orig [$w_text get $b_loc $e_loc] - set tags [$w_text tag names $b_loc] - - if {[lsearch -exact $tags misspelled] >= 0} { - if {[info exists s_suggest($orig)]} { - set cnt 0 - foreach s $s_suggest($orig) { - if {$cnt < 5} { - $w_menu insert $s_menuidx command \ - -label $s \ - -command [cb _replace $b_loc $e_loc $s] - incr s_menuidx - incr cnt - } else { - break - } - } - } else { - $w_menu insert $s_menuidx command \ - -label [mc "No Suggestions"] \ - -state disabled - incr s_menuidx - } - $w_menu insert $s_menuidx separator - incr s_menuidx - } - - $w_text mark set saved-insert insert - tk_popup $w_menu $X $Y -} - -method _replace {b_loc e_loc word} { - $w_text configure -autoseparators 0 - $w_text edit separator - - $w_text delete $b_loc $e_loc - $w_text insert $b_loc $word - - $w_text edit separator - $w_text configure -autoseparators 1 - $w_text mark set insert saved-insert -} - -method _restart_timer {} { - set s_i [after 300 [cb _run]] -} - -proc _match_length {max_line arr_name} { - upvar $arr_name a - - if {[llength $a] > $max_line} { - set a [lrange $a 0 $max_line] - } - while {[llength $a] <= $max_line} { - lappend a {} - } -} - -method _wordend {pos} { - set pos [$w_text index "$pos wordend"] - set tags [$w_text tag names $pos] - while {[lsearch -exact $tags misspelled] >= 0} { - set pos [$w_text index "$pos +1c"] - set tags [$w_text tag names $pos] - } - return $pos -} - -method _run {} { - set cur_pos [$w_text index {insert -1c}] - set cur_line [lindex [split $cur_pos .] 0] - set max_line [lindex [split [$w_text index end] .] 0] - _match_length $max_line s_seen - _match_length $max_line s_checked - - # Nothing in the message buffer? Nothing to spellcheck. - # - if {$cur_line == 1 - && $max_line == 2 - && [$w_text get 1.0 end] eq "\n"} { - array unset s_suggest - _restart_timer $this - return - } - - set active 0 - for {set n 1} {$n <= $max_line} {incr n} { - set s [$w_text get "$n.0" "$n.end"] - - # Don't spellcheck the current line unless we are at - # a word boundary. The user might be typing on it. - # - if {$n == $cur_line - && ![regexp {^\W$} [$w_text get $cur_pos insert]]} { - - # If the current word is misspelled remove the tag - # but force a spellcheck later. - # - set tags [$w_text tag names $cur_pos] - if {[lsearch -exact $tags misspelled] >= 0} { - $w_text tag remove misspelled \ - "$cur_pos wordstart" \ - [_wordend $this $cur_pos] - lset s_seen $n $s - lset s_checked $n {} - } - - continue - } - - if {[lindex $s_seen $n] eq $s - && [lindex $s_checked $n] ne $s} { - # Don't send empty lines to Aspell it doesn't check them. - # - if {$s eq {}} { - lset s_checked $n $s - continue - } - - # Don't send typical s-b-o lines as the emails are - # almost always misspelled according to Aspell. - # - if {[regexp -nocase {^[a-z-]+-by:.*<.*@.*>$} $s]} { - $w_text tag remove misspelled "$n.0" "$n.end" - lset s_checked $n $s - continue - } - - puts $s_fd ^$s - lappend s_pending [list $n $s] - set active 1 - } else { - # Delay until another idle loop to make sure we don't - # spellcheck lines the user is actively changing. - # - lset s_seen $n $s - } - } - - if {$active} { - set s_clear 1 - flush $s_fd - } else { - _restart_timer $this - } -} - -method _read {} { - while {[gets $s_fd line] >= 0} { - set lineno [lindex $s_pending 0 0] - set line [string trim $line] - - if {$s_clear} { - $w_text tag remove misspelled "$lineno.0" "$lineno.end" - set s_clear 0 - } - - if {$line eq {}} { - lset s_checked $lineno [lindex $s_pending 0 1] - set s_pending [lrange $s_pending 1 end] - set s_clear 1 - continue - } - - set sugg [list] - switch -- [string range $line 0 1] { - {& } { - set line [split [string range $line 2 end] :] - set info [split [lindex $line 0] { }] - set orig [lindex $info 0] - set offs [lindex $info 2] - foreach s [split [lindex $line 1] ,] { - lappend sugg [string range $s 1 end] - } - } - {# } { - set info [split [string range $line 2 end] { }] - set orig [lindex $info 0] - set offs [lindex $info 1] - } - default { - puts stderr "<spell> $line" - continue - } - } - - incr offs -1 - set b_loc "$lineno.$offs" - set e_loc [$w_text index "$lineno.$offs wordend"] - set curr [$w_text get $b_loc $e_loc] - - # At least for English curr = "bob", orig = "bob's" - # so Tk didn't include the 's but Aspell did. We - # try to round out the word. - # - while {$curr ne $orig - && [string equal -length [string length $curr] $curr $orig]} { - set n_loc [$w_text index "$e_loc +1c"] - set n_curr [$w_text get $b_loc $n_loc] - if {$n_curr eq $curr} { - break - } - set curr $n_curr - set e_loc $n_loc - } - - if {$curr eq $orig} { - $w_text tag add misspelled $b_loc $e_loc - if {[llength $sugg] > 0} { - set s_suggest($orig) $sugg - } else { - unset -nocomplain s_suggest($orig) - } - } else { - unset -nocomplain s_suggest($orig) - } - } - - fconfigure $s_fd -block 1 - if {[eof $s_fd]} { - if {![catch {close $s_fd} err]} { - set err [mc "Unexpected EOF from spell checker"] - } - catch {after cancel $s_i} - $w_text tag remove misspelled 1.0 end - error_popup [strcat [mc "Spell Checker Failed"] "\n\n" $err] - return - } - fconfigure $s_fd -block 0 - - if {[llength $s_pending] == 0} { - _restart_timer $this - } -} - -proc available_langs {} { - set langs [list] - catch { - set fd [open [list | aspell dump dicts] r] - while {[gets $fd line] >= 0} { - if {$line eq {}} continue - lappend langs $line - } - close $fd - } - return $langs -} - -} diff --git a/lib/sshkey.tcl b/lib/sshkey.tcl deleted file mode 100644 index aa6457bbb5..0000000000 --- a/lib/sshkey.tcl +++ /dev/null @@ -1,128 +0,0 @@ -# git-gui about git-gui dialog -# Copyright (C) 2006, 2007 Shawn Pearce - -proc find_ssh_key {} { - foreach name {~/.ssh/id_dsa.pub ~/.ssh/id_rsa.pub ~/.ssh/identity.pub} { - if {[file exists $name]} { - set fh [open $name r] - set cont [read $fh] - close $fh - return [list $name $cont] - } - } - - return {} -} - -proc do_ssh_key {} { - global sshkey_title have_tk85 sshkey_fd use_ttk NS - - set w .sshkey_dialog - if {[winfo exists $w]} { - raise $w - return - } - - Dialog $w - wm transient $w . - - set finfo [find_ssh_key] - if {$finfo eq {}} { - set sshkey_title [mc "No keys found."] - set gen_state normal - } else { - set sshkey_title [mc "Found a public key in: %s" [lindex $finfo 0]] - set gen_state disabled - } - - ${NS}::frame $w.header - ${NS}::label $w.header.lbl -textvariable sshkey_title -anchor w - ${NS}::button $w.header.gen -text [mc "Generate Key"] \ - -command [list make_ssh_key $w] -state $gen_state - pack $w.header.lbl -side left -expand 1 -fill x - pack $w.header.gen -side right - pack $w.header -fill x -pady 5 -padx 5 - - text $w.contents -width 60 -height 10 -wrap char -relief sunken - pack $w.contents -fill both -expand 1 - if {$have_tk85} { - set clr darkblue - if {$use_ttk} { set clr [ttk::style lookup . -selectbackground] } - $w.contents configure -inactiveselectbackground $clr - } - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.close -text [mc Close] \ - -default active -command [list destroy $w] - pack $w.buttons.close -side right - ${NS}::button $w.buttons.copy -text [mc "Copy To Clipboard"] \ - -command [list tk_textCopy $w.contents] - pack $w.buttons.copy -side left - pack $w.buttons -side bottom -fill x -pady 5 -padx 5 - - if {$finfo ne {}} { - $w.contents insert end [lindex $finfo 1] sel - } - $w.contents configure -state disabled - - bind $w <Visibility> "grab $w; focus $w.buttons.close" - bind $w <Key-Escape> "destroy $w" - bind $w <Key-Return> "destroy $w" - bind $w <Destroy> kill_sshkey - wm title $w [mc "Your OpenSSH Public Key"] - tk::PlaceWindow $w widget . - tkwait window $w -} - -proc make_ssh_key {w} { - global sshkey_title sshkey_output sshkey_fd - - set sshkey_title [mc "Generating..."] - $w.header.gen configure -state disabled - - set cmdline [list sh -c {echo | ssh-keygen -q -t rsa -f ~/.ssh/id_rsa 2>&1}] - - if {[catch { set sshkey_fd [_open_stdout_stderr $cmdline] } err]} { - error_popup [mc "Could not start ssh-keygen:\n\n%s" $err] - return - } - - set sshkey_output {} - fconfigure $sshkey_fd -blocking 0 - fileevent $sshkey_fd readable [list read_sshkey_output $sshkey_fd $w] -} - -proc kill_sshkey {} { - global sshkey_fd - if {![info exists sshkey_fd]} return - catch { kill_file_process $sshkey_fd } - catch { close $sshkey_fd } -} - -proc read_sshkey_output {fd w} { - global sshkey_fd sshkey_output sshkey_title - - set sshkey_output "$sshkey_output[read $fd]" - if {![eof $fd]} return - - fconfigure $fd -blocking 1 - unset sshkey_fd - - $w.contents configure -state normal - if {[catch {close $fd} err]} { - set sshkey_title [mc "Generation failed."] - $w.contents insert end $err - $w.contents insert end "\n" - $w.contents insert end $sshkey_output - } else { - set finfo [find_ssh_key] - if {$finfo eq {}} { - set sshkey_title [mc "Generation succeeded, but no keys found."] - $w.contents insert end $sshkey_output - } else { - set sshkey_title [mc "Your key is in: %s" [lindex $finfo 0]] - $w.contents insert end [lindex $finfo 1] sel - } - } - $w.contents configure -state disable -} diff --git a/lib/status_bar.tcl b/lib/status_bar.tcl deleted file mode 100644 index 02111a1742..0000000000 --- a/lib/status_bar.tcl +++ /dev/null @@ -1,131 +0,0 @@ -# git-gui status bar mega-widget -# Copyright (C) 2007 Shawn Pearce - -class status_bar { - -field w ; # our own window path -field w_l ; # text widget we draw messages into -field w_c ; # canvas we draw a progress bar into -field c_pack ; # script to pack the canvas with -field status {}; # single line of text we show -field prefix {}; # text we format into status -field units {}; # unit of progress -field meter {}; # current core git progress meter (if active) - -constructor new {path} { - global use_ttk NS - set w $path - set w_l $w.l - set w_c $w.c - - ${NS}::frame $w - if {!$use_ttk} { - $w configure -borderwidth 1 -relief sunken - } - ${NS}::label $w_l \ - -textvariable @status \ - -anchor w \ - -justify left - pack $w_l -side left - set c_pack [cb _oneline_pack] - - bind $w <Destroy> [cb _delete %W] - return $this -} - -method _oneline_pack {} { - $w_c conf -width 100 - pack $w_c -side right -} - -constructor two_line {path} { - global NS - set w $path - set w_l $w.l - set w_c $w.c - - ${NS}::frame $w - ${NS}::label $w_l \ - -textvariable @status \ - -anchor w \ - -justify left - pack $w_l -anchor w -fill x - set c_pack [list pack $w_c -fill x] - - bind $w <Destroy> [cb _delete %W] - return $this -} - -method start {msg uds} { - if {[winfo exists $w_c]} { - $w_c coords bar 0 0 0 20 - } else { - canvas $w_c \ - -height [expr {int([winfo reqheight $w_l] * 0.6)}] \ - -borderwidth 1 \ - -relief groove \ - -highlightt 0 - $w_c create rectangle 0 0 0 20 -tags bar -fill navy - eval $c_pack - } - - set status $msg - set prefix $msg - set units $uds - set meter {} -} - -method update {have total} { - set pdone 0 - set cdone 0 - if {$total > 0} { - set pdone [expr {100 * $have / $total}] - set cdone [expr {[winfo width $w_c] * $have / $total}] - } - - set prec [string length [format %i $total]] - set status [mc "%s ... %*i of %*i %s (%3i%%)" \ - $prefix \ - $prec $have \ - $prec $total \ - $units $pdone] - $w_c coords bar 0 0 $cdone 20 -} - -method update_meter {buf} { - append meter $buf - set r [string last "\r" $meter] - if {$r == -1} { - return - } - - set prior [string range $meter 0 $r] - set meter [string range $meter [expr {$r + 1}] end] - set p "\\((\\d+)/(\\d+)\\)" - if {[regexp ":\\s*\\d+% $p\(?:, done.\\s*\n|\\s*\r)\$" $prior _j a b]} { - update $this $a $b - } elseif {[regexp "$p\\s+done\r\$" $prior _j a b]} { - update $this $a $b - } -} - -method stop {{msg {}}} { - destroy $w_c - if {$msg ne {}} { - set status $msg - } -} - -method show {msg {test {}}} { - if {$test eq {} || $status eq $test} { - set status $msg - } -} - -method _delete {current} { - if {$current eq $w} { - delete_this - } -} - -} diff --git a/lib/themed.tcl b/lib/themed.tcl deleted file mode 100644 index 8b88d3678b..0000000000 --- a/lib/themed.tcl +++ /dev/null @@ -1,265 +0,0 @@ -# Functions for supporting the use of themed Tk widgets in git-gui. -# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> - -proc InitTheme {} { - # Create a color label style (bg can be overridden by widget option) - ttk::style layout Color.TLabel { - Color.Label.border -sticky news -children { - Color.label.fill -sticky news -children { - Color.Label.padding -sticky news -children { - Color.Label.label -sticky news}}}} - eval [linsert [ttk::style configure TLabel] 0 \ - ttk::style configure Color.TLabel] - ttk::style configure Color.TLabel \ - -borderwidth 0 -relief flat -padding 2 - ttk::style map Color.TLabel -background {{} gold} - # We also need a padded label. - ttk::style configure Padded.TLabel \ - -padding {5 5} -borderwidth 1 -relief solid - # We need a gold frame. - ttk::style layout Gold.TFrame { - Gold.Frame.border -sticky nswe -children { - Gold.Frame.fill -sticky nswe}} - ttk::style configure Gold.TFrame -background gold -relief flat - # listboxes should have a theme border so embed in ttk::frame - ttk::style layout SListbox.TFrame { - SListbox.Frame.Entry.field -sticky news -border true -children { - SListbox.Frame.padding -sticky news - } - } - - # Handle either current Tk or older versions of 8.5 - if {[catch {set theme [ttk::style theme use]}]} { - set theme $::ttk::currentTheme - } - - if {[lsearch -exact {default alt classic clam} $theme] != -1} { - # Simple override of standard ttk::entry to change the field - # packground according to a state flag. We should use 'user1' - # but not all versions of 8.5 support that so make use of 'pressed' - # which is not normally in use for entry widgets. - ttk::style layout Edged.Entry [ttk::style layout TEntry] - ttk::style map Edged.Entry {*}[ttk::style map TEntry] - ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \ - -fieldbackground lightgreen - ttk::style map Edged.Entry -fieldbackground { - {pressed !disabled} lightpink - } - } else { - # For fancier themes, in particular the Windows ones, the field - # element may not support changing the background color. So instead - # override the fill using the default fill element. If we overrode - # the vista theme field element we would loose the themed border - # of the widget. - catch { - ttk::style element create color.fill from default - } - - ttk::style layout Edged.Entry { - Edged.Entry.field -sticky nswe -border 0 -children { - Edged.Entry.border -sticky nswe -border 1 -children { - Edged.Entry.padding -sticky nswe -children { - Edged.Entry.color.fill -sticky nswe -children { - Edged.Entry.textarea -sticky nswe - } - } - } - } - } - - ttk::style configure Edged.Entry {*}[ttk::style configure TEntry] \ - -background lightgreen -padding 0 -borderwidth 0 - ttk::style map Edged.Entry {*}[ttk::style map TEntry] \ - -background {{pressed !disabled} lightpink} - } - - if {[lsearch [bind . <<ThemeChanged>>] InitTheme] == -1} { - bind . <<ThemeChanged>> +[namespace code [list InitTheme]] - } -} - -proc gold_frame {w args} { - global use_ttk - if {$use_ttk} { - eval [linsert $args 0 ttk::frame $w -style Gold.TFrame] - } else { - eval [linsert $args 0 frame $w -background gold] - } -} - -proc tlabel {w args} { - global use_ttk - if {$use_ttk} { - set cmd [list ttk::label $w -style Color.TLabel] - foreach {k v} $args { - switch -glob -- $k { - -activebackground {} - default { lappend cmd $k $v } - } - } - eval $cmd - } else { - eval [linsert $args 0 label $w] - } -} - -# The padded label gets used in the about class. -proc paddedlabel {w args} { - global use_ttk - if {$use_ttk} { - eval [linsert $args 0 ttk::label $w -style Padded.TLabel] - } else { - eval [linsert $args 0 label $w \ - -padx 5 -pady 5 \ - -justify left \ - -anchor w \ - -borderwidth 1 \ - -relief solid] - } -} - -# Create a toplevel for use as a dialog. -# If available, sets the EWMH dialog hint and if ttk is enabled -# place a themed frame over the surface. -proc Dialog {w args} { - eval [linsert $args 0 toplevel $w -class Dialog] - catch {wm attributes $w -type dialog} - pave_toplevel $w - return $w -} - -# Tk toplevels are not themed - so pave it over with a themed frame to get -# the base color correct per theme. -proc pave_toplevel {w} { - global use_ttk - if {$use_ttk && ![winfo exists $w.!paving]} { - set paving [ttk::frame $w.!paving] - place $paving -x 0 -y 0 -relwidth 1 -relheight 1 - lower $paving - } -} - -# Create a scrolled listbox with appropriate border for the current theme. -# On many themes the border for a scrolled listbox needs to go around the -# listbox and the scrollbar. -proc slistbox {w args} { - global use_ttk NS - if {$use_ttk} { - set f [ttk::frame $w -style SListbox.TFrame -padding 2] - } else { - set f [frame $w -relief flat] - } - if {[catch { - if {$use_ttk} { - eval [linsert $args 0 listbox $f.list -relief flat \ - -highlightthickness 0 -borderwidth 0] - } else { - eval [linsert $args 0 listbox $f.list] - } - ${NS}::scrollbar $f.vs -command [list $f.list yview] - $f.list configure -yscrollcommand [list $f.vs set] - grid $f.list $f.vs -sticky news - grid rowconfigure $f 0 -weight 1 - grid columnconfigure $f 0 -weight 1 - bind $f.list <<ListboxSelect>> \ - [list event generate $w <<ListboxSelect>>] - interp hide {} $w - interp alias {} $w {} $f.list - } err]} { - destroy $f - return -code error $err - } - return $w -} - -# fetch the background color from a widget. -proc get_bg_color {w} { - global use_ttk - if {$use_ttk} { - set bg [ttk::style lookup [winfo class $w] -background] - } else { - set bg [$w cget -background] - } - return $bg -} - -# ttk::spinbox didn't get added until 8.6 -proc tspinbox {w args} { - global use_ttk - if {$use_ttk && [llength [info commands ttk::spinbox]] > 0} { - eval [linsert $args 0 ttk::spinbox $w] - } else { - eval [linsert $args 0 spinbox $w] - } -} - -proc tentry {w args} { - global use_ttk - if {$use_ttk} { - InitTheme - ttk::entry $w -style Edged.Entry - } else { - entry $w - } - - rename $w _$w - interp alias {} $w {} tentry_widgetproc $w - eval [linsert $args 0 tentry_widgetproc $w configure] - return $w -} -proc tentry_widgetproc {w cmd args} { - global use_ttk - switch -- $cmd { - state { - if {$use_ttk} { - return [uplevel 1 [list _$w $cmd] $args] - } else { - if {[lsearch -exact $args pressed] != -1} { - _$w configure -background lightpink - } else { - _$w configure -background lightgreen - } - } - } - configure { - if {$use_ttk} { - if {[set n [lsearch -exact $args -background]] != -1} { - set args [lreplace $args $n [incr n]] - if {[llength $args] == 0} {return} - } - } - return [uplevel 1 [list _$w $cmd] $args] - } - default { return [uplevel 1 [list _$w $cmd] $args] } - } -} - -# Tk 8.6 provides a standard font selection dialog. This uses the native -# dialogs on Windows and MacOSX or a standard Tk dialog on X11. -proc tchoosefont {w title familyvar sizevar} { - if {[package vsatisfies [package provide Tk] 8.6]} { - upvar #0 $familyvar family - upvar #0 $sizevar size - tk fontchooser configure -parent $w -title $title \ - -font [list $family $size] \ - -command [list on_choosefont $familyvar $sizevar] - tk fontchooser show - } else { - choose_font::pick $w $title $familyvar $sizevar - } -} - -# Called when the Tk 8.6 fontchooser selects a font. -proc on_choosefont {familyvar sizevar font} { - upvar #0 $familyvar family - upvar #0 $sizevar size - set font [font actual $font] - set family [dict get $font -family] - set size [dict get $font -size] -} - -# Local variables: -# mode: tcl -# indent-tabs-mode: t -# tab-width: 4 -# End: diff --git a/lib/tools.tcl b/lib/tools.tcl deleted file mode 100644 index 6ec94113db..0000000000 --- a/lib/tools.tcl +++ /dev/null @@ -1,165 +0,0 @@ -# git-gui Tools menu implementation - -proc tools_list {} { - global repo_config - - set names {} - foreach item [array names repo_config guitool.*.cmd] { - lappend names [string range $item 8 end-4] - } - return [lsort $names] -} - -proc tools_populate_all {} { - global tools_menubar tools_menutbl - global tools_tailcnt - - set mbar_end [$tools_menubar index end] - set mbar_base [expr {$mbar_end - $tools_tailcnt}] - if {$mbar_base >= 0} { - $tools_menubar delete 0 $mbar_base - } - - array unset tools_menutbl - - foreach fullname [tools_list] { - tools_populate_one $fullname - } -} - -proc tools_create_item {parent args} { - global tools_menubar tools_tailcnt - if {$parent eq $tools_menubar} { - set pos [expr {[$parent index end]-$tools_tailcnt+1}] - eval [list $parent insert $pos] $args - } else { - eval [list $parent add] $args - } -} - -proc tools_populate_one {fullname} { - global tools_menubar tools_menutbl tools_id - - if {![info exists tools_id]} { - set tools_id 0 - } - - set names [split $fullname '/'] - set parent $tools_menubar - for {set i 0} {$i < [llength $names]-1} {incr i} { - set subname [join [lrange $names 0 $i] '/'] - if {[info exists tools_menutbl($subname)]} { - set parent $tools_menutbl($subname) - } else { - set subid $parent.t$tools_id - tools_create_item $parent cascade \ - -label [lindex $names $i] -menu $subid - menu $subid - set tools_menutbl($subname) $subid - set parent $subid - incr tools_id - } - } - - tools_create_item $parent command \ - -label [lindex $names end] \ - -command [list tools_exec $fullname] -} - -proc tools_exec {fullname} { - global repo_config env current_diff_path - global current_branch is_detached - - if {[is_config_true "guitool.$fullname.needsfile"]} { - if {$current_diff_path eq {}} { - error_popup [mc "Running %s requires a selected file." $fullname] - return - } - } - - catch { unset env(ARGS) } - catch { unset env(REVISION) } - - if {[get_config "guitool.$fullname.revprompt"] ne {} || - [get_config "guitool.$fullname.argprompt"] ne {}} { - set dlg [tools_askdlg::dialog $fullname] - if {![tools_askdlg::execute $dlg]} { - return - } - } elseif {[is_config_true "guitool.$fullname.confirm"]} { - if {[is_config_true "guitool.$fullname.needsfile"]} { - if {[ask_popup [mc "Are you sure you want to run %1\$s on file \"%2\$s\"?" $fullname $current_diff_path]] ne {yes}} { - return - } - } else { - if {[ask_popup [mc "Are you sure you want to run %s?" $fullname]] ne {yes}} { - return - } - } - } - - set env(GIT_GUITOOL) $fullname - set env(FILENAME) $current_diff_path - if {$is_detached} { - set env(CUR_BRANCH) "" - } else { - set env(CUR_BRANCH) $current_branch - } - - set cmdline $repo_config(guitool.$fullname.cmd) - if {[is_config_true "guitool.$fullname.noconsole"]} { - tools_run_silent [list sh -c $cmdline] \ - [list tools_complete $fullname {}] - } else { - regsub {/} $fullname { / } title - set w [console::new \ - [mc "Tool: %s" $title] \ - [mc "Running: %s" $cmdline]] - console::exec $w [list sh -c $cmdline] \ - [list tools_complete $fullname $w] - } - - unset env(GIT_GUITOOL) - unset env(FILENAME) - unset env(CUR_BRANCH) - catch { unset env(ARGS) } - catch { unset env(REVISION) } -} - -proc tools_run_silent {cmd after} { - lappend cmd 2>@1 - set fd [_open_stdout_stderr $cmd] - - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [list tools_consume_input $fd $after] -} - -proc tools_consume_input {fd after} { - read $fd - if {[eof $fd]} { - fconfigure $fd -blocking 1 - if {[catch {close $fd}]} { - uplevel #0 $after 0 - } else { - uplevel #0 $after 1 - } - } -} - -proc tools_complete {fullname w {ok 1}} { - if {$w ne {}} { - console::done $w $ok - } - - if {$ok} { - set msg [mc "Tool completed successfully: %s" $fullname] - } else { - set msg [mc "Tool failed: %s" $fullname] - } - - if {[is_config_true "guitool.$fullname.norescan"]} { - ui_status $msg - } else { - rescan [list ui_status $msg] - } -} diff --git a/lib/tools_dlg.tcl b/lib/tools_dlg.tcl deleted file mode 100644 index 7eeda9daf2..0000000000 --- a/lib/tools_dlg.tcl +++ /dev/null @@ -1,414 +0,0 @@ -# git-gui Tools menu dialogs - -class tools_add { - -field w ; # widget path -field w_name ; # new remote name widget -field w_cmd ; # new remote location widget - -field name {}; # name of the tool -field command {}; # command to execute -field add_global 0; # add to the --global config -field no_console 0; # disable using the console -field needs_file 0; # ensure filename is set -field confirm 0; # ask for confirmation -field ask_branch 0; # ask for a revision -field ask_args 0; # ask for additional args - -constructor dialog {} { - global repo_config use_ttk NS - - make_dialog top w - wm title $top [append "[appname] ([reponame]): " [mc "Add Tool"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - wm transient $top . - } - - ${NS}::label $w.header -text [mc "Add New Tool Command"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::checkbutton $w.buttons.global \ - -text [mc "Add globally"] \ - -variable @add_global - pack $w.buttons.global -side left -padx 5 - ${NS}::button $w.buttons.create -text [mc Add] \ - -default active \ - -command [cb _add] - pack $w.buttons.create -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.desc -text [mc "Tool Details"] - - ${NS}::label $w.desc.name_cmnt -anchor w\ - -text [mc "Use '/' separators to create a submenu tree:"] - grid x $w.desc.name_cmnt -sticky we -padx {0 5} -pady {0 2} - ${NS}::label $w.desc.name_l -text [mc "Name:"] - set w_name $w.desc.name_t - ${NS}::entry $w_name \ - -width 40 \ - -textvariable @name \ - -validate key \ - -validatecommand [cb _validate_name %d %S] - grid $w.desc.name_l $w_name -sticky we -padx {0 5} - - ${NS}::label $w.desc.cmd_l -text [mc "Command:"] - set w_cmd $w.desc.cmd_t - ${NS}::entry $w_cmd \ - -width 40 \ - -textvariable @command - grid $w.desc.cmd_l $w_cmd -sticky we -padx {0 5} -pady {0 3} - - grid columnconfigure $w.desc 1 -weight 1 - pack $w.desc -anchor nw -fill x -pady 5 -padx 5 - - ${NS}::checkbutton $w.confirm \ - -text [mc "Show a dialog before running"] \ - -variable @confirm -command [cb _check_enable_dlg] - - ${NS}::labelframe $w.dlg -labelwidget $w.confirm - - ${NS}::checkbutton $w.dlg.askbranch \ - -text [mc "Ask the user to select a revision (sets \$REVISION)"] \ - -variable @ask_branch -state disabled - pack $w.dlg.askbranch -anchor w -padx 15 - - ${NS}::checkbutton $w.dlg.askargs \ - -text [mc "Ask the user for additional arguments (sets \$ARGS)"] \ - -variable @ask_args -state disabled - pack $w.dlg.askargs -anchor w -padx 15 - - pack $w.dlg -anchor nw -fill x -pady {0 8} -padx 5 - - ${NS}::checkbutton $w.noconsole \ - -text [mc "Don't show the command output window"] \ - -variable @no_console - pack $w.noconsole -anchor w -padx 5 - - ${NS}::checkbutton $w.needsfile \ - -text [mc "Run only if a diff is selected (\$FILENAME not empty)"] \ - -variable @needs_file - pack $w.needsfile -anchor w -padx 5 - - bind $w <Visibility> [cb _visible] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _add]\;break - tkwait window $w -} - -method _check_enable_dlg {} { - if {$confirm} { - $w.dlg.askbranch configure -state normal - $w.dlg.askargs configure -state normal - } else { - $w.dlg.askbranch configure -state disabled - $w.dlg.askargs configure -state disabled - } -} - -method _add {} { - global repo_config - - if {$name eq {}} { - error_popup [mc "Please supply a name for the tool."] - focus $w_name - return - } - - set item "guitool.$name.cmd" - - if {[info exists repo_config($item)]} { - error_popup [mc "Tool '%s' already exists." $name] - focus $w_name - return - } - - set cmd [list git config] - if {$add_global} { lappend cmd --global } - set items {} - if {$no_console} { lappend items "guitool.$name.noconsole" } - if {$needs_file} { lappend items "guitool.$name.needsfile" } - if {$confirm} { - if {$ask_args} { lappend items "guitool.$name.argprompt" } - if {$ask_branch} { lappend items "guitool.$name.revprompt" } - if {!$ask_args && !$ask_branch} { - lappend items "guitool.$name.confirm" - } - } - - if {[catch { - eval $cmd [list $item $command] - foreach citem $items { eval $cmd [list $citem yes] } - } err]} { - error_popup [mc "Could not add tool:\n%s" $err] - } else { - set repo_config($item) $command - foreach citem $items { set repo_config($citem) yes } - - tools_populate_all - } - - destroy $w -} - -method _validate_name {d S} { - if {$d == 1} { - if {[regexp {[~?*&\[\0\"\\\{]} $S]} { - return 0 - } - } - return 1 -} - -method _visible {} { - grab $w - $w_name icursor end - focus $w_name -} - -} - -class tools_remove { - -field w ; # widget path -field w_names ; # name list - -constructor dialog {} { - global repo_config global_config system_config use_ttk NS - - load_config 1 - - make_dialog top w - wm title $top [append "[appname] ([reponame]): " [mc "Remove Tool"]] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - wm transient $top . - } - - ${NS}::label $w.header -text [mc "Remove Tool Commands"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.create -text [mc Remove] \ - -default active \ - -command [cb _remove] - pack $w.buttons.create -side right - ${NS}::button $w.buttons.cancel -text [mc Cancel] \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::frame $w.list - set w_names $w.list.l - slistbox $w_names \ - -height 10 \ - -width 30 \ - -selectmode extended \ - -exportselection false - pack $w.list.l -side left -fill both -expand 1 - pack $w.list -fill both -expand 1 -pady 5 -padx 5 - - set local_cnt 0 - foreach fullname [tools_list] { - # Cannot delete system tools - if {[info exists system_config(guitool.$fullname.cmd)]} continue - - $w_names insert end $fullname - if {![info exists global_config(guitool.$fullname.cmd)]} { - $w_names itemconfigure end -foreground blue - incr local_cnt - } - } - - if {$local_cnt > 0} { - ${NS}::label $w.colorlbl -foreground blue \ - -text [mc "(Blue denotes repository-local tools)"] - pack $w.colorlbl -fill x -pady 5 -padx 5 - } - - bind $w <Visibility> [cb _visible] - bind $w <Key-Escape> [list destroy $w] - bind $w <Key-Return> [cb _remove]\;break - tkwait window $w -} - -method _remove {} { - foreach i [$w_names curselection] { - set name [$w_names get $i] - - catch { git config --remove-section guitool.$name } - catch { git config --global --remove-section guitool.$name } - } - - load_config 0 - tools_populate_all - - destroy $w -} - -method _visible {} { - grab $w - focus $w_names -} - -} - -class tools_askdlg { - -field w ; # widget path -field w_rev {}; # revision browser -field w_args {}; # arguments - -field is_ask_args 0; # has arguments field -field is_ask_revs 0; # has revision browser - -field is_ok 0; # ok to start -field argstr {}; # arguments - -constructor dialog {fullname} { - global M1B use_ttk NS - - set title [get_config "guitool.$fullname.title"] - if {$title eq {}} { - regsub {/} $fullname { / } title - } - - make_dialog top w -autodelete 0 - wm title $top [append "[appname] ([reponame]): " $title] - if {$top ne {.}} { - wm geometry $top "+[winfo rootx .]+[winfo rooty .]" - wm transient $top . - } - - set prompt [get_config "guitool.$fullname.prompt"] - if {$prompt eq {}} { - set command [get_config "guitool.$fullname.cmd"] - set prompt [mc "Run Command: %s" $command] - } - - ${NS}::label $w.header -text $prompt -font font_uibold -anchor center - pack $w.header -side top -fill x - - set argprompt [get_config "guitool.$fullname.argprompt"] - set revprompt [get_config "guitool.$fullname.revprompt"] - - set is_ask_args [expr {$argprompt ne {}}] - set is_ask_revs [expr {$revprompt ne {}}] - - if {$is_ask_args} { - if {$argprompt eq {yes} || $argprompt eq {true} || $argprompt eq {1}} { - set argprompt [mc "Arguments"] - } - - ${NS}::labelframe $w.arg -text $argprompt - - set w_args $w.arg.txt - ${NS}::entry $w_args \ - -width 40 \ - -textvariable @argstr - pack $w_args -padx 5 -pady 5 -fill both - pack $w.arg -anchor nw -fill both -pady 5 -padx 5 - } - - if {$is_ask_revs} { - if {$revprompt eq {yes} || $revprompt eq {true} || $revprompt eq {1}} { - set revprompt [mc "Revision"] - } - - if {[is_config_true "guitool.$fullname.revunmerged"]} { - set w_rev [::choose_rev::new_unmerged $w.rev $revprompt] - } else { - set w_rev [::choose_rev::new $w.rev $revprompt] - } - - pack $w.rev -anchor nw -fill both -expand 1 -pady 5 -padx 5 - } - - ${NS}::frame $w.buttons - if {$is_ask_revs} { - ${NS}::button $w.buttons.visualize \ - -text [mc Visualize] \ - -command [cb _visualize] - pack $w.buttons.visualize -side left - } - ${NS}::button $w.buttons.ok \ - -text [mc OK] \ - -command [cb _start] - pack $w.buttons.ok -side right - ${NS}::button $w.buttons.cancel \ - -text [mc "Cancel"] \ - -command [cb _cancel] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - bind $w <$M1B-Key-Return> [cb _start] - bind $w <Key-Return> [cb _start] - bind $w <Key-Escape> [cb _cancel] - wm protocol $w WM_DELETE_WINDOW [cb _cancel] - - bind $w <Visibility> [cb _visible] - return $this -} - -method execute {} { - tkwait window $w - set rv $is_ok - delete_this - return $rv -} - -method _visible {} { - grab $w - if {$is_ask_args} { - focus $w_args - } elseif {$is_ask_revs} { - $w_rev focus_filter - } -} - -method _cancel {} { - wm protocol $w WM_DELETE_WINDOW {} - destroy $w -} - -method _rev {} { - if {[catch {$w_rev commit_or_die}]} { - return {} - } - return [$w_rev get] -} - -method _visualize {} { - global current_branch - set rev [_rev $this] - if {$rev ne {}} { - do_gitk [list --left-right "$current_branch...$rev"] - } -} - -method _start {} { - global env - - if {$is_ask_revs} { - set name [_rev $this] - if {$name eq {}} { - return - } - set env(REVISION) $name - } - - if {$is_ask_args} { - set env(ARGS) $argstr - } - - set is_ok 1 - _cancel $this -} - -} diff --git a/lib/transport.tcl b/lib/transport.tcl deleted file mode 100644 index e5d211edea..0000000000 --- a/lib/transport.tcl +++ /dev/null @@ -1,232 +0,0 @@ -# git-gui transport (fetch/push) support -# Copyright (C) 2006, 2007 Shawn Pearce - -proc fetch_from {remote} { - set w [console::new \ - [mc "fetch %s" $remote] \ - [mc "Fetching new changes from %s" $remote]] - set cmds [list] - lappend cmds [list exec git fetch $remote] - if {[is_config_true gui.pruneduringfetch]} { - lappend cmds [list exec git remote prune $remote] - } - console::chain $w $cmds -} - -proc prune_from {remote} { - set w [console::new \ - [mc "remote prune %s" $remote] \ - [mc "Pruning tracking branches deleted from %s" $remote]] - console::exec $w [list git remote prune $remote] -} - -proc fetch_from_all {} { - set w [console::new \ - [mc "fetch all remotes"] \ - [mc "Fetching new changes from all remotes"]] - - set cmd [list git fetch --all] - if {[is_config_true gui.pruneduringfetch]} { - lappend cmd --prune - } - - console::exec $w $cmd -} - -proc prune_from_all {} { - global all_remotes - - set w [console::new \ - [mc "remote prune all remotes"] \ - [mc "Pruning tracking branches deleted from all remotes"]] - - set cmd [list git remote prune] - - foreach r $all_remotes { - lappend cmd $r - } - - console::exec $w $cmd -} - -proc push_to {remote} { - set w [console::new \ - [mc "push %s" $remote] \ - [mc "Pushing changes to %s" $remote]] - set cmd [list git push] - lappend cmd -v - lappend cmd $remote - console::exec $w $cmd -} - -proc start_push_anywhere_action {w} { - global push_urltype push_remote push_url push_thin push_tags - global push_force - global repo_config - - set is_mirror 0 - set r_url {} - switch -- $push_urltype { - remote { - set r_url $push_remote - catch {set is_mirror $repo_config(remote.$push_remote.mirror)} - } - url {set r_url $push_url} - } - if {$r_url eq {}} return - - set cmd [list git push] - lappend cmd -v - if {$push_thin} { - lappend cmd --thin - } - if {$push_force} { - lappend cmd --force - } - if {$push_tags} { - lappend cmd --tags - } - lappend cmd $r_url - if {$is_mirror} { - set cons [console::new \ - [mc "push %s" $r_url] \ - [mc "Mirroring to %s" $r_url]] - } else { - set cnt 0 - foreach i [$w.source.l curselection] { - set b [$w.source.l get $i] - lappend cmd "refs/heads/$b:refs/heads/$b" - incr cnt - } - if {$cnt == 0} { - return - } elseif {$cnt == 1} { - set unit branch - } else { - set unit branches - } - - set cons [console::new \ - [mc "push %s" $r_url] \ - [mc "Pushing %s %s to %s" $cnt $unit $r_url]] - } - console::exec $cons $cmd - destroy $w -} - -trace add variable push_remote write \ - [list radio_selector push_urltype remote] - -proc do_push_anywhere {} { - global all_remotes current_branch - global push_urltype push_remote push_url push_thin push_tags - global push_force use_ttk NS - - set w .push_setup - toplevel $w - catch {wm attributes $w -type dialog} - wm withdraw $w - wm geometry $w "+[winfo rootx .]+[winfo rooty .]" - pave_toplevel $w - - ${NS}::label $w.header -text [mc "Push Branches"] \ - -font font_uibold -anchor center - pack $w.header -side top -fill x - - ${NS}::frame $w.buttons - ${NS}::button $w.buttons.create -text [mc Push] \ - -default active \ - -command [list start_push_anywhere_action $w] - pack $w.buttons.create -side right - ${NS}::button $w.buttons.cancel -text [mc "Cancel"] \ - -default normal \ - -command [list destroy $w] - pack $w.buttons.cancel -side right -padx 5 - pack $w.buttons -side bottom -fill x -pady 10 -padx 10 - - ${NS}::labelframe $w.source -text [mc "Source Branches"] - slistbox $w.source.l \ - -height 10 \ - -width 70 \ - -selectmode extended - foreach h [load_all_heads] { - $w.source.l insert end $h - if {$h eq $current_branch} { - $w.source.l select set end - $w.source.l yview end - } - } - pack $w.source.l -side left -fill both -expand 1 - pack $w.source -fill both -expand 1 -pady 5 -padx 5 - - ${NS}::labelframe $w.dest -text [mc "Destination Repository"] - if {$all_remotes ne {}} { - ${NS}::radiobutton $w.dest.remote_r \ - -text [mc "Remote:"] \ - -value remote \ - -variable push_urltype - if {$use_ttk} { - ttk::combobox $w.dest.remote_m -state readonly \ - -exportselection false \ - -textvariable push_remote \ - -values $all_remotes - } else { - eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes - } - grid $w.dest.remote_r $w.dest.remote_m -sticky w - if {[lsearch -sorted -exact $all_remotes origin] != -1} { - set push_remote origin - } else { - set push_remote [lindex $all_remotes 0] - } - set push_urltype remote - } else { - set push_urltype url - } - ${NS}::radiobutton $w.dest.url_r \ - -text [mc "Arbitrary Location:"] \ - -value url \ - -variable push_urltype - ${NS}::entry $w.dest.url_t \ - -width 50 \ - -textvariable push_url \ - -validate key \ - -validatecommand { - if {%d == 1 && [regexp {\s} %S]} {return 0} - if {%d == 1 && [string length %S] > 0} { - set push_urltype url - } - return 1 - } - grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5} - grid columnconfigure $w.dest 1 -weight 1 - pack $w.dest -anchor nw -fill x -pady 5 -padx 5 - - ${NS}::labelframe $w.options -text [mc "Transfer Options"] - ${NS}::checkbutton $w.options.force \ - -text [mc "Force overwrite existing branch (may discard changes)"] \ - -variable push_force - grid $w.options.force -columnspan 2 -sticky w - ${NS}::checkbutton $w.options.thin \ - -text [mc "Use thin pack (for slow network connections)"] \ - -variable push_thin - grid $w.options.thin -columnspan 2 -sticky w - ${NS}::checkbutton $w.options.tags \ - -text [mc "Include tags"] \ - -variable push_tags - grid $w.options.tags -columnspan 2 -sticky w - grid columnconfigure $w.options 1 -weight 1 - pack $w.options -anchor nw -fill x -pady 5 -padx 5 - - set push_url {} - set push_force 0 - set push_thin 0 - set push_tags 0 - - bind $w <Visibility> "grab $w; focus $w.buttons.create" - bind $w <Key-Escape> "destroy $w" - bind $w <Key-Return> [list start_push_anywhere_action $w] - wm title $w [append "[appname] ([reponame]): " [mc "Push"]] - wm deiconify $w - tkwait window $w -} diff --git a/lib/win32.tcl b/lib/win32.tcl deleted file mode 100644 index db91ab84a5..0000000000 --- a/lib/win32.tcl +++ /dev/null @@ -1,26 +0,0 @@ -# git-gui Misc. native Windows 32 support -# Copyright (C) 2007 Shawn Pearce - -proc win32_read_lnk {lnk_path} { - return [exec cscript.exe \ - /E:jscript \ - /nologo \ - [file join $::oguilib win32_shortcut.js] \ - $lnk_path] -} - -proc win32_create_lnk {lnk_path lnk_exec lnk_dir} { - global oguilib - - set lnk_args [lrange $lnk_exec 1 end] - set lnk_exec [lindex $lnk_exec 0] - - eval [list exec wscript.exe \ - /E:jscript \ - /nologo \ - [file nativename [file join $oguilib win32_shortcut.js]] \ - $lnk_path \ - [file nativename [file join $oguilib git-gui.ico]] \ - $lnk_dir \ - $lnk_exec] $lnk_args -} diff --git a/lib/win32_shortcut.js b/lib/win32_shortcut.js deleted file mode 100644 index 117923f886..0000000000 --- a/lib/win32_shortcut.js +++ /dev/null @@ -1,34 +0,0 @@ -// git-gui Windows shortcut support -// Copyright (C) 2007 Shawn Pearce - -var WshShell = WScript.CreateObject("WScript.Shell"); -var argv = WScript.Arguments; -var argi = 0; -var lnk_path = argv.item(argi++); -var ico_path = argi < argv.length ? argv.item(argi++) : undefined; -var dir_path = argi < argv.length ? argv.item(argi++) : undefined; -var lnk_exec = argi < argv.length ? argv.item(argi++) : undefined; -var lnk_args = ''; -while (argi < argv.length) { - var s = argv.item(argi++); - if (lnk_args != '') - lnk_args += ' '; - if (s.indexOf(' ') >= 0) { - lnk_args += '"'; - lnk_args += s; - lnk_args += '"'; - } else { - lnk_args += s; - } -} - -var lnk = WshShell.CreateShortcut(lnk_path); -if (argv.length == 1) { - WScript.echo(lnk.TargetPath); -} else { - lnk.TargetPath = lnk_exec; - lnk.Arguments = lnk_args; - lnk.IconLocation = ico_path + ", 0"; - lnk.WorkingDirectory = dir_path; - lnk.Save(); -} |