texlive[45151] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Fake
commits+siepo at tug.org
commits+siepo at tug.org
Mon Aug 28 15:42:13 CEST 2017
Revision: 45151
http://tug.org/svn/texlive?view=revision&revision=45151
Author: siepo
Date: 2017-08-28 15:42:12 +0200 (Mon, 28 Aug 2017)
Log Message:
-----------
Fake checkboxes, revised bindings for package list
Modified Paths:
--------------
trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-08-28 06:43:57 UTC (rev 45150)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-08-28 13:42:12 UTC (rev 45151)
@@ -134,59 +134,76 @@
}
}
-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"
+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 [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 [.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
}
- 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
}
+# 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 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 @@
[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 @@
}
} ; # 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 @@
# 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 @@
grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew
grid columnconfigure .fpkg 0 -weight 1
pack .fpkg -side top -expand 1
- bind .pkglist <ButtonRelease> {package_popup [.pkglist identify item %x %y]}
- # focus or selection?
- bind .pkglist <space> {package_popup [.pkglist focus]}
- bind .pkglist <Return> {selection_popup [.pkglist selection]}
+ bind .pkglist <space> {toggle_marked [.pkglist focus] mk}
+ bind .pkglist <Return> {toggle_marked [.pkglist focus] mk}
+ bind .pkglist <ButtonRelease-1> {toggle_marked \
+ [.pkglist identify item %x %y] [.pkglist identify column %x %y]}
+ bind .pkglist <ButtonRelease-2> \
+ {focus_popup [.pkglist identify item %x %y]}
+ bind .pkglist <ButtonRelease-2> \
+ {focus_popup [.pkglist identify item %x %y]}
+ bind .pkglist <ButtonRelease-3> \
+ {focus_popup [.pkglist identify item %x %y]}
+ bind .pkglist <Control-ButtonRelease-1> \
+ {focus_popup [.pkglist identify item %x %y]}
# log displays
frame .log
@@ -515,14 +537,7 @@
.ent.b configure -state $st
.ent.e configure -state $st
# package list
- if $yesno {
- .pkglist configure -takefocus 1
- bind .pkglist <ButtonRelease> \
- {package_popup [.pkglist identify item %x %y]}
- } else {
- .pkglist configure -takefocus 0
- bind .pkglist <ButtonRelease> {}
- }
+ .pkglist state $ttk_st
# do not touch the log windows
# final buttons
.q configure -state $ttk_st
More information about the tex-live-commits
mailing list