diff options
Diffstat (limited to 'git-gui/lib')
| -rw-r--r-- | git-gui/lib/blame.tcl | 1 | ||||
| -rw-r--r-- | git-gui/lib/choose_repository.tcl | 27 | ||||
| -rw-r--r-- | git-gui/lib/chord.tcl | 56 | ||||
| -rw-r--r-- | git-gui/lib/index.tcl | 16 | ||||
| -rw-r--r-- | git-gui/lib/merge.tcl | 2 | ||||
| -rw-r--r-- | git-gui/lib/mergetool.tcl | 2 | ||||
| -rw-r--r-- | git-gui/lib/themed.tcl | 38 |
7 files changed, 80 insertions, 62 deletions
diff --git a/git-gui/lib/blame.tcl b/git-gui/lib/blame.tcl index 62ec083667..8441e109be 100644 --- a/git-gui/lib/blame.tcl +++ b/git-gui/lib/blame.tcl @@ -328,6 +328,7 @@ constructor new {i_commit i_path i_jump} { 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 $i <Deactivate> [cb _hide_tooltip] bind_button3 $i " [cb _hide_tooltip] set cursorX %x diff --git a/git-gui/lib/choose_repository.tcl b/git-gui/lib/choose_repository.tcl index e54f3e66d8..af1fee7c75 100644 --- a/git-gui/lib/choose_repository.tcl +++ b/git-gui/lib/choose_repository.tcl @@ -357,31 +357,10 @@ 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 - } + if {[catch {set outdir [git rev-parse --resolve-git-dir $path]}]} { + return 0 } - return 0 + return 1 } proc _objdir {path} { diff --git a/git-gui/lib/chord.tcl b/git-gui/lib/chord.tcl index 275a6cd4a1..e21e7d3d0b 100644 --- a/git-gui/lib/chord.tcl +++ b/git-gui/lib/chord.tcl @@ -27,7 +27,7 @@ # # Turn off the UI while running a couple of async operations. # lock_ui # -# set chord [SimpleChord new { +# set chord [SimpleChord::new { # unlock_ui # # Note: $notice here is not referenced in the calling scope # if {$notice} { info_popup $notice } @@ -37,9 +37,9 @@ # # all operations have been initiated. # set common_note [$chord add_note] # -# # Pass notes as 'after' callbacks to other operations -# async_operation $args [$chord add_note] -# other_async_operation $args [$chord add_note] +# # Activate notes in 'after' callbacks to other operations +# set newnote [$chord add_note] +# async_operation $args [list $newnote activate] # # # Communicate with the chord body # if {$condition} { @@ -48,7 +48,7 @@ # } # # # Activate the common note, making the chord eligible to complete -# $common_note +# $common_note activate # # At this point, the chord will complete at some unknown point in the future. # The common note might have been the first note activated, or the async @@ -60,18 +60,23 @@ # Represents a procedure that conceptually has multiple entrypoints that must # all be called before the procedure executes. Each entrypoint is called a # "note". The chord is only "completed" when all the notes are "activated". -oo::class create SimpleChord { - variable notes body is_completed +class SimpleChord { + field notes + field body + field is_completed + field eval_ns # Constructor: - # set chord [SimpleChord new {body}] + # set chord [SimpleChord::new {body}] # Creates a new chord object with the specified body script. The # body script is evaluated at most once, when a note is activated # and the chord has no other non-activated notes. - constructor {body} { + constructor new {i_body} { set notes [list] - my eval [list set body $body] + set body $i_body set is_completed 0 + set eval_ns "[namespace qualifiers $this]::eval" + return $this } # Method: @@ -80,7 +85,7 @@ oo::class create SimpleChord { # the chord body will be evaluated. This can be used to set variable # values for the chord body to use. method eval {script} { - namespace eval [self] $script + namespace eval $eval_ns $script } # Method: @@ -92,7 +97,7 @@ oo::class create SimpleChord { method add_note {} { if {$is_completed} { error "Cannot add a note to a completed chord" } - set note [ChordNote new [self]] + set note [ChordNote::new $this] lappend notes $note @@ -108,8 +113,8 @@ oo::class create SimpleChord { set is_completed 1 - namespace eval [self] $body - namespace delete [self] + namespace eval $eval_ns $body + delete_this } } } @@ -119,15 +124,17 @@ oo::class create SimpleChord { # final note of the chord is activated (this can be any note in the chord, # with all other notes already previously activated in any order), the chord's # body is evaluated. -oo::class create ChordNote { - variable chord is_activated +class ChordNote { + field chord + field is_activated # Constructor: # Instances of ChordNote are created internally by calling add_note on # SimpleChord objects. - constructor {chord} { - my eval set chord $chord + constructor new {c} { + set chord $c set is_activated 0 + return $this } # Method: @@ -138,20 +145,11 @@ oo::class create ChordNote { } # Method: - # $note + # $note activate # Activates the note, if it has not already been activated, and # completes the chord if there are no other notes awaiting # activation. Subsequent calls will have no further effect. - # - # NB: In TclOO, if an object is invoked like a method without supplying - # any method name, then this internal method `unknown` is what - # actually runs (with no parameters). It is used in the ChordNote - # class for the purpose of allowing the note object to be called as - # a function (see example above). (The `unknown` method can also be - # used to support dynamic dispatch, but must take parameters to - # identify the "unknown" method to be invoked. In this form, this - # proc serves only to make instances behave directly like methods.) - method unknown {} { + method activate {} { if {!$is_activated} { set is_activated 1 $chord notify_note_activation diff --git a/git-gui/lib/index.tcl b/git-gui/lib/index.tcl index 1254145634..d2ec24bd80 100644 --- a/git-gui/lib/index.tcl +++ b/git-gui/lib/index.tcl @@ -60,7 +60,7 @@ proc rescan_on_error {err {after {}}} { $::main_status stop_all unlock_index - rescan [concat $after [list ui_ready]] 0 + rescan [concat $after {ui_ready;}] 0 } proc update_indexinfo {msg path_list after} { @@ -314,7 +314,7 @@ proc unstage_helper {txt paths} { update_indexinfo \ $txt \ $path_list \ - [concat $after [list ui_ready]] + [concat $after {ui_ready;}] } } @@ -366,7 +366,7 @@ proc add_helper {txt paths} { update_index \ $txt \ $path_list \ - [concat $after {ui_status [mc "Ready to commit."]}] + [concat $after {ui_status [mc "Ready to commit."];}] } } @@ -436,7 +436,7 @@ proc revert_helper {txt paths} { # # The asynchronous operations are each indicated below by a comment # before the code block that starts the async operation. - set after_chord [SimpleChord new { + set after_chord [SimpleChord::new { if {[string trim $err] != ""} { rescan_on_error $err } else { @@ -522,10 +522,11 @@ proc revert_helper {txt paths} { ] if {$reply == 1} { + set note [$after_chord add_note] checkout_index \ $txt \ $path_list \ - [$after_chord add_note] \ + [list $note activate] \ $capture_error } } @@ -567,14 +568,15 @@ proc revert_helper {txt paths} { if {$reply == 1} { $after_chord eval { set should_reshow_diff 1 } - delete_files $untracked_list [$after_chord add_note] + set note [$after_chord add_note] + delete_files $untracked_list [list $note activate] } } # Activate the common note. If no other notes were created, this # completes the chord. If other notes were created, then this common # note prevents a race condition where the chord might complete early. - $after_common_note + $after_common_note activate } # Delete all of the specified files, performing deletion in batches to allow the diff --git a/git-gui/lib/merge.tcl b/git-gui/lib/merge.tcl index 8df8ffae55..664803cf3f 100644 --- a/git-gui/lib/merge.tcl +++ b/git-gui/lib/merge.tcl @@ -244,7 +244,7 @@ Continue with resetting the current changes?"] set status_bar_operation [$::main_status \ start \ [mc "Aborting"] \ - [mc "files reset"] + [mc "files reset"]] fileevent $fd readable [namespace code [list \ _reset_wait $fd $status_bar_operation]] } else { diff --git a/git-gui/lib/mergetool.tcl b/git-gui/lib/mergetool.tcl index 120bc4064b..e688b016ef 100644 --- a/git-gui/lib/mergetool.tcl +++ b/git-gui/lib/mergetool.tcl @@ -59,7 +59,7 @@ proc merge_add_resolution {path} { update_index \ [mc "Adding resolution for %s" [short_path $path]] \ [list $path] \ - [concat $after [list ui_ready]] + [concat $after {ui_ready;}] } proc merge_force_stage {stage} { diff --git a/git-gui/lib/themed.tcl b/git-gui/lib/themed.tcl index 88b3119a75..83e3ac795f 100644 --- a/git-gui/lib/themed.tcl +++ b/git-gui/lib/themed.tcl @@ -1,6 +1,44 @@ # Functions for supporting the use of themed Tk widgets in git-gui. # Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> + +namespace eval color { + # Variable colors + # Preffered way to set widget colors is using add_option. + # In some cases, like with tags in_diff/in_sel, we use these colors. + variable select_bg lightgray + variable select_fg black + + proc sync_with_theme {} { + set base_bg [ttk::style lookup . -background] + set base_fg [ttk::style lookup . -foreground] + set text_bg [ttk::style lookup Treeview -background] + set text_fg [ttk::style lookup Treeview -foreground] + set select_bg [ttk::style lookup Default -selectbackground] + set select_fg [ttk::style lookup Default -selectforeground] + + set color::select_bg $select_bg + set color::select_fg $select_fg + + proc add_option {key val} { + option add $key $val widgetDefault + } + # Add options for plain Tk widgets + # Using `option add` instead of tk_setPalette to avoid unintended + # consequences. + if {![is_MacOSX]} { + add_option *Menu.Background $base_bg + add_option *Menu.Foreground $base_fg + add_option *Menu.activeBackground $select_bg + add_option *Menu.activeForeground $select_fg + } + add_option *Text.Background $text_bg + add_option *Text.Foreground $text_fg + add_option *Text.HighlightBackground $base_bg + add_option *Text.HighlightColor $select_bg + } +} + proc ttk_get_current_theme {} { # Handle either current Tk or older versions of 8.5 if {[catch {set theme [ttk::style theme use]}]} { |