From 44e980f2689e9bc5e6941a51696b3df11a7ade5b Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Mon, 28 Aug 2017 13:42:12 +0000 Subject: Fake checkboxes, revised bindings for package list git-svn-id: svn://tug.org/texlive/trunk@45151 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/scripts/tlshell/tlshell.tcl | 245 ++++++++++++++------------ 1 file changed, 130 insertions(+), 115 deletions(-) (limited to 'Master/texmf-dist/scripts/tlshell') diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index 3dc2064ac47..97c4703fc84 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -134,59 +134,76 @@ proc show_err {} { } } -proc selection_popup {sl} { - tk_messageBox -message [join $sl "\n"] +proc focus_popup {it} { + set ::pipe_cb package_popup_cb + run_cmd "info $it" } -# combined display of local and remote package database information -# in treeview widget -if 0 { -proc display_packages {} { - set pknames {} - .pkglist delete [.pkglist children {}] - if {[llength $::pkgs_remote] > 0} { - set pknames [dict keys $::pkgs_remote] - set n [llength $pknames] - append mess "\n $n remote packages" - } - if {[llength [dict keys $::pkgs_local]] > 0} { - set n [llength [dict keys $::pkgs_local]] - append mess "\n $n local packages" - foreach nm [dict keys $::pkgs_local] { - lappend pknames $nm - do_debug "found $nm" - } +set mrk [format %c 9635] ; # black square, in decimal +set nomrk [format %c 9633] ; # white square, in decimal + +proc toggle_marked {it cl} { + if {$cl ne "#1"} { + return } - if {[llength $pknames] <= 0} {return} - - set pknames [lsort -unique $pknames] - foreach nm $pknames { - set in_l 0 - if {[lsearch $::pkgs_local $nm] >= 0} {set in_l 1} - set in_r 0 - if {[lsearch $::pkgs_remote $nm] >= 0} {set in_r 1} - set vl [list $nm] - if $in_l { - lappend vl [dict get $::pkgs_local $nm revision] - } else { - lappend vl {} - } - if $in_r { - lappend vl [dict get $::pkgs_remote $nm revision] - } else { - lappend vl {} - } - if $in_l { - lappend vl [dict get $::pkgs_local $nm shortdesc] - } else { - lappend vl [dict get $::pkgs_remote $nm shortdesc] - } - .pkglist insert {} end -id $nm -values $vl + if [.pkglist tag has marked $it] { + .pkglist tag remove marked $it + .pkglist set $it mk $::nomrk + } else { + .pkglist tag add marked $it + .pkglist set $it mk $::mrk } - update ; # uncomment if necessary -} ; # display_packages } +# combined display of local and remote package database information +# in treeview widget + +#proc display_packages {} { +# set pknames {} +# .pkglist delete [.pkglist children {}] +# if {[llength $::pkgs_remote] > 0} { +# set pknames [dict keys $::pkgs_remote] +# set n [llength $pknames] +# append mess "\n $n remote packages" +# } +# if {[llength [dict keys $::pkgs_local]] > 0} { +# set n [llength [dict keys $::pkgs_local]] +# append mess "\n $n local packages" +# foreach nm [dict keys $::pkgs_local] { +# lappend pknames $nm +# do_debug "found $nm" +# } +# } +# if {[llength $pknames] <= 0} {return} +# +# set pknames [lsort -unique $pknames] +# foreach nm $pknames { +# set in_l 0 +# if {[lsearch $::pkgs_local $nm] >= 0} {set in_l 1} +# set in_r 0 +# if {[lsearch $::pkgs_remote $nm] >= 0} {set in_r 1} +# set vl [list $nm] +# if $in_l { +# lappend vl [dict get $::pkgs_local $nm revision] +# } else { +# lappend vl {} +# } +# if $in_r { +# lappend vl [dict get $::pkgs_remote $nm revision] +# } else { +# lappend vl {} +# } +# if $in_l { +# lappend vl [dict get $::pkgs_local $nm shortdesc] +# } else { +# lappend vl [dict get $::pkgs_remote $nm shortdesc] +# } +# .pkglist insert {} end -id $nm -values $vl +# } +# update ; # uncomment if necessary +#} ; # display_packages + + # callbacks for file events of tlmgr pipe ::tlshl (names *_cb) ### proc empty_cb {mode {l ""}} {} @@ -231,9 +248,6 @@ proc log_widget_cb {mode {l ""}} { proc packages_cb {mode {l ""}} { if {$mode eq "line"} { - # .pkglist configure -state normal - # set re {^([ i]) ([^: ]+): (.*)$} - #set re {^[^,]+,([0-9]+),([0-9]+),([^,]*),(\\\".*\\\")?$} set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$} if {[regexp $re $l m pname lrev rrev catg pdescr]} { # do_debug "Match: $pname -- $lrev -- $rrev -- $catg -- $pdescr" @@ -245,7 +259,7 @@ proc packages_cb {mode {l ""}} { [list "lrev" $lrev "rrev" $rrev "category" $catg shortdesc $pdescr] if {$lrev == 0} { set lrev {}} .pkglist insert {} end -id $pname -values \ - [list $pname $lrev $rrev $pdescr] + [list $::nomrk $pname $lrev $rrev $pdescr] } else { do_debug "No match: $l" } @@ -263,55 +277,54 @@ proc packages_cb {mode {l ""}} { } } ; # packages_cb -if 0 { -proc dump_db_cb {mode {l ""}} { - upvar #0 $::pkgs pk - if {$mode eq "line"} { - if {$l eq ""} { - # package records are separated by blank lines - set ::cur_pkg "" - return - } elseif {[string first "name " $l] == 0} { - set nm [string range $l 5 end] - if {$nm eq ""} { - lappend ::err_log "Empty name in database" - err_exit - } - do_debug "package $nm" - set ::cur_pkg $nm - # initialize package sub-dictionary to empty - dict set pk $nm {} - # initialize relevant subkeys to empty - foreach f {shortdesc category revision} { - dict set pk $::cur_pkg $f {} - } - return - } else { - if {$::cur_pkg eq ""} {return} - foreach s {category revision shortdesc} { - set i [string length $s] - incr i - if {[string first "$s " $l] == 0} { - dict set pk $::cur_pkg $s [string range $l $i end] - return - } - } - } - # do not process other information - return - } elseif {$mode eq "init"} { - set pk {} - set ::cur_pkg "" - return - } elseif {$mode eq "finish"} { - display_packages - return - } else { - lappend ::err_log "Illegal call of dump_db_cb" - err_exit - } -} ; # dump_db_cb -} +#proc dump_db_cb {mode {l ""}} { +# upvar #0 $::pkgs pk +# if {$mode eq "line"} { +# if {$l eq ""} { +# # package records are separated by blank lines +# set ::cur_pkg "" +# return +# } elseif {[string first "name " $l] == 0} { +# set nm [string range $l 5 end] +# if {$nm eq ""} { +# lappend ::err_log "Empty name in database" +# err_exit +# } +# do_debug "package $nm" +# set ::cur_pkg $nm +# # initialize package sub-dictionary to empty +# dict set pk $nm {} +# # initialize relevant subkeys to empty +# foreach f {shortdesc category revision} { +# dict set pk $::cur_pkg $f {} +# } +# return +# } else { +# if {$::cur_pkg eq ""} {return} +# foreach s {category revision shortdesc} { +# set i [string length $s] +# incr i +# if {[string first "$s " $l] == 0} { +# dict set pk $::cur_pkg $s [string range $l $i end] +# return +# } +# } +# } +# # do not process other information +# return +# } elseif {$mode eq "init"} { +# set pk {} +# set ::cur_pkg "" +# return +# } elseif {$mode eq "finish"} { +# display_packages +# return +# } else { +# lappend ::err_log "Illegal call of dump_db_cb" +# err_exit +# } +#} ; # dump_db_cb + proc package_popup_cb {mode {l ""}} { if {$mode eq "finish"} { tk_messageBox -message [join $::out_log "\n"] @@ -435,14 +448,15 @@ proc make_widgets {} { # packages list (tlmgrgui uses an old HList widget) frame .fpkg ttk::treeview .pkglist -columns \ - {name localrev remoterev shortdesc} \ + {mk name localrev remoterev shortdesc} \ -show headings -height 8 -selectmode extended \ -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set} foreach \ - col {name localrev remoterev shortdesc} \ - nm {Name "Local Rev." "Remote Rev." Description} { + col {mk name localrev remoterev shortdesc} \ + nm {"" Name "Local Rev." "Remote Rev." Description} { .pkglist heading $col -text $nm -anchor w } + .pkglist column mk -width [expr $cw * 3] .pkglist column name -width [expr $cw * 25] .pkglist column localrev -width [expr $cw * 12] .pkglist column remoterev -width [expr $cw * 12] @@ -455,10 +469,18 @@ proc make_widgets {} { grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew grid columnconfigure .fpkg 0 -weight 1 pack .fpkg -side top -expand 1 - bind .pkglist {package_popup [.pkglist identify item %x %y]} - # focus or selection? - bind .pkglist {package_popup [.pkglist focus]} - bind .pkglist {selection_popup [.pkglist selection]} + bind .pkglist {toggle_marked [.pkglist focus] mk} + bind .pkglist {toggle_marked [.pkglist focus] mk} + bind .pkglist {toggle_marked \ + [.pkglist identify item %x %y] [.pkglist identify column %x %y]} + bind .pkglist \ + {focus_popup [.pkglist identify item %x %y]} + bind .pkglist \ + {focus_popup [.pkglist identify item %x %y]} + bind .pkglist \ + {focus_popup [.pkglist identify item %x %y]} + bind .pkglist \ + {focus_popup [.pkglist identify item %x %y]} # log displays frame .log @@ -515,14 +537,7 @@ proc enable_widgets {yesno} { .ent.b configure -state $st .ent.e configure -state $st # package list - if $yesno { - .pkglist configure -takefocus 1 - bind .pkglist \ - {package_popup [.pkglist identify item %x %y]} - } else { - .pkglist configure -takefocus 0 - bind .pkglist {} - } + .pkglist state $ttk_st # do not touch the log windows # final buttons .q configure -state $ttk_st -- cgit v1.2.3