texlive[45547] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Bug
commits+siepo at tug.org
commits+siepo at tug.org
Mon Oct 16 18:40:54 CEST 2017
Revision: 45547
http://tug.org/svn/texlive?view=revision&revision=45547
Author: siepo
Date: 2017-10-16 18:40:54 +0200 (Mon, 16 Oct 2017)
Log Message:
-----------
Bug fixes; improved filtering and searching
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-10-16 13:30:51 UTC (rev 45546)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-10-16 16:40:54 UTC (rev 45547)
@@ -1,4 +1,4 @@
-#!/usr/bin/env wish8.5
+#!/usr/bin/env wish
# Copyright 2017 Siep Kroonenberg
@@ -60,6 +60,8 @@
set tempsub "" ; # subdir for temp files, set during initialization
proc search_nocase {needle haystack} {
+ if {$needle eq ""} {return -1}
+ if {$haystack eq ""} {return -1}
return [string first [string tolower $needle] [string tolower $haystack]]
}
@@ -84,6 +86,12 @@
set n_updates 0
set tlshell_updatable 0
+# selecting packages for display
+set stat_opt "inst"
+set dtl_opt "all"
+# searching packages for display
+set search_desc 0
+
##### handling tlmgr via pipe and stderr tempfile #####
set prmpt "tlmgr>"
@@ -273,6 +281,13 @@
do_debug "check_tlmgr_uptodate: should not get here"
} ; # check_tlmgr_uptodate
+proc is_updatable {nm} {
+ set pk [dict get $::pkgs $nm]
+ set lr [dict get $pk localrev]
+ set rr [dict get $pk remoterev]
+ return [expr $lr > 0 && $rr > 0 && $rr > $lr]
+}
+
proc update_globals {} {
if {! $::have_remote} return
set ::n_updates 0
@@ -378,7 +393,7 @@
# tlmgr restarts itself automatically, reload remote
get_packages_info_remote
set ::sel_opt "inst"
- display_packages_info is_local
+ display_packages_info
} ; # update_tlmgr
proc update_all {} {
@@ -394,7 +409,7 @@
#wm withdraw .lw
update_local_revnumbers
set ::sel_opt "inst"
- display_packages_info is_local
+ display_packages_info
} ; # update_all
##### building GUI #####
@@ -435,7 +450,7 @@
ttk::label .topf.luptodate -anchor w
pgrid .topf.luptodate -row 1 -column 1
- pgrid [ttk::label .topf.llcmd -anchor w -text "Last command: "] \
+ pgrid [ttk::label .topf.llcmd -anchor w -text "Last tlmgr command: "] \
-row 2 -column 0
pgrid [ttk::label .topf.lcmd -anchor w] -row 2 -column 1
pack .topf -in .bg -side top -anchor w
@@ -462,40 +477,57 @@
spacing .bg
- # searching package list
- ttk::frame .srt
- ppack [ttk::label .srt.l -text "Package name or short description..."] \
- -side left
- ppack [ttk::entry .srt.e -width 30] -side left
- #ppack [ttk::button .srt.b -text "Advanced search"] -side right
- pack .srt -in .bg -side top -fill x -expand 1
+ # package list
+ ttk::label .lpack -text "Package list" -font TkHeadingFont -anchor w
+ ppack .lpack -in .bg -side top -fill x
- bind .srt.e <KeyRelease> {+update_packages_display}
+ # controlling package list
+ ttk::frame .pkfilter
+ # filter on status: inst, all, upd
+ ttk::label .pkfilter.lstat -font TkHeadingFont -text "Status"
+ ttk::radiobutton .pkfilter.inst -text Installed -value inst \
+ -variable ::stat_opt -command show_packages_info
+ ttk::radiobutton .pkfilter.alls -text All -value all \
+ -variable ::stat_opt -command show_packages_info
+ ttk::radiobutton .pkfilter.upd -text Updatable -value upd \
+ -variable ::stat_opt -command show_packages_info
+ grid .pkfilter.lstat -column 0 -row 0 -sticky w -padx {3 50}
+ pgrid .pkfilter.inst -column 0 -row 1 -sticky w
+ pgrid .pkfilter.alls -column 0 -row 2 -sticky w
+ pgrid .pkfilter.upd -column 0 -row 3 -sticky w
- # controlling package list; display only matched entries
- # have to think about complex matches
- ttk::frame .fp_ctrl
- ppack [ttk::label .fp_ctrl.pkgl -text "Show packages:"] -side left
- ttk::radiobutton .fp_ctrl.inst -text Installed -value inst \
- -variable ::sel_opt -command show_packages_info
- ttk::radiobutton .fp_ctrl.all -text All -value all \
- -variable ::sel_opt -command show_packages_info
- ttk::radiobutton .fp_ctrl.upd -text Updatable -value upd \
- -variable ::sel_opt -command show_packages_info
- ttk::radiobutton .fp_ctrl.coll -text Collections -value coll \
- -variable ::sel_opt -command show_packages_info
- # ttk::radiobutton .fp_ctrl.match -text Match -value match \
- # -variable ::sel_opt -command show_packages_info
- #ttk::label
- ttk::entry .fp_ctrl.match
- ppack .fp_ctrl.inst -side left
- ppack .fp_ctrl.all -side left
- ppack .fp_ctrl.upd -side left
- ppack .fp_ctrl.coll -side left
-# ppack .fp_ctrl.match -side left
- set ::sel_opt inst
- pack .fp_ctrl -in .bg -side top -fill x
+ # filter on detail level: all, coll, schm
+ ttk::label .pkfilter.ldtl -font TkHeadingFont -text "Detail > Global"
+ ttk::radiobutton .pkfilter.alld -text All -value all \
+ -variable ::dtl_opt -command show_packages_info
+ ttk::radiobutton .pkfilter.coll -text "Collections and schemes" -value coll \
+ -variable ::dtl_opt -command show_packages_info
+ ttk::radiobutton .pkfilter.schm -text "Only schemes" -value schm \
+ -variable ::dtl_opt -command show_packages_info
+ pgrid .pkfilter.ldtl -column 1 -row 0 -sticky w
+ pgrid .pkfilter.alld -column 1 -row 1 -sticky w
+ pgrid .pkfilter.coll -column 1 -row 2 -sticky w
+ pgrid .pkfilter.schm -column 1 -row 3 -sticky w
+ pack .pkfilter -in .bg -side top -fill x
+
+ # search
+ ttk::frame .pksearch
+ ppack [ttk::label .pksearch.l \
+ -text "Search package names"] \
+ -side left
+ pack [ttk::entry .pksearch.e -width 30] -side left -padx {3 0} -pady 3
+ # cancel search: \u2A2F is vector or cross product
+ pack [button .pksearch.can -text "\u2A2F" -padx 3 -pady 0 -borderwidth 0 \
+ -command {.pksearch.e delete 0 end}] -side left -padx {0 6}
+ .pksearch.can configure -command \
+ {.pksearch.e delete 0 end; show_packages_info}
+ ppack [ttk::checkbutton .pksearch.d -variable ::search_desc \
+ -text "Also search short descriptions"] -side left
+ pack .pksearch -in .bg -side top -fill x -expand 1
+ bind .pksearch.e <KeyRelease> {+display_packages_info}
+ bind .pksearch.d <ButtonRelease> {+toggle_search_desc}
+
# packages list (tlmgrgui uses an old HList widget)
ttk::frame .fpkg
ttk::treeview .pkglist -columns \
@@ -550,6 +582,7 @@
# log displays: new toplevel, again with themed background frame
toplevel .lw
+ wm title .lw Logs
pack [ttk::frame .lw.bg]
ttk::frame .lw.log
@@ -649,36 +682,11 @@
tk_messageBox -message [join $::out_log "\n"]
}
-## filter procs; parameter is package name ##
-
-proc is_local {p} {
- return [dict get $::pkgs $p localrev]
-}
-
-proc is_collection {p} {
- set c [dict get $::pkgs $p "category"]
- return [expr \"$c\" eq \"Collection\"]
-}
-
-proc is_updatable {p} {
- #do_debug "Is $p updatable"
- if [catch {dict get $::pkgs $p} pk] {
- return 0
- } else {
- if [catch {dict get $::pkgs $p localrev} lr] {set lr 0}
- if [catch {dict get $::pkgs $p remoterev} rr] {set rr 0}
- # do_debug "Revisions $p are local $lr and remote $rr"
- return [expr $lr > 0 && $rr > 0 && $rr > $lr]
- }
-}
-
## data to be displayed ##
# sorted display data for packages to be displayed
set filtered [dict create]
# matching package names
-# previous match string
-set prv ""
## selection tags
@@ -710,33 +718,64 @@
# ::pkgs should already be up to date
# (re)create ::filtered dictionary; disregard search string
-proc initialize_display_info {{filt ""}} {
+proc initialize_display_info {} {
do_debug \
- "initialize_packages_info with remote $::have_remote and filt >$filt<"
+ "initialize_packages_info for $::stat_opt and $::dtl_opt"
foreach nm [lsort [dict keys $::filtered]] {
dict unset ::filtered $nm
}
- dict for {nm pk} $::pkgs {
- if {$filt eq "" || [$filt $nm]} {
- # collect data to be displayed for $nm
- dict lappend ::filtered $nm $::nomrk
- dict lappend ::filtered $nm $nm
- set v [dict get $pk localrev]
- if {$v eq "0" || $v == 0} {set v ""}
- dict lappend ::filtered $nm $v
- set v [dict get $pk remoterev]
- if {$v eq "0" || $v == 0} {set v ""}
- dict lappend ::filtered $nm $v
- dict lappend ::filtered $nm [dict get $pk shortdesc]
- } ; # else omit
+ foreach nm [lsort [dict keys $::pkgs]] {
+ set pk [dict get $::pkgs $nm]
+ set do_show 1
+ set lr [dict get $pk localrev]
+ set rr [dict get $pk remoterev]
+ set ct [dict get $pk category]
+ if {$::stat_opt eq "inst" && $lr == 0} {
+ set do_show 0
+ } elseif {$::stat_opt eq "upd" && ($lr == 0 || $rr == 0 || $rr <= $lr)} {
+ set do_show 0
+ }
+ if {! $do_show} continue
+ if {$::dtl_opt eq "schm" && $ct ne "Scheme"} {
+ set do_show 0
+ } elseif {$::dtl_opt eq "coll" && \
+ $ct ne "Scheme" && $ct ne "Collection"} {
+ set do_show 0
+ }
+ if {! $do_show} continue
+
+ # collect data to be displayed for $nm
+ dict lappend ::filtered $nm $::nomrk
+ dict lappend ::filtered $nm $nm
+ set v [dict get $pk localrev]
+ if {$v eq "0" || $v == 0} {set v ""}
+ dict lappend ::filtered $nm $v
+ set v [dict get $pk remoterev]
+ if {$v eq "0" || $v == 0} {set v ""}
+ dict lappend ::filtered $nm $v
+ dict lappend ::filtered $nm [dict get $pk shortdesc]
}
} ; # initialize_display_info
-# initial display obeys filter, but no search string
+# display packages obeying filter and search string
+# even on a relatively slow system, regenerating the entire list
+# at every keystroke is acceptably responsive
proc display_packages_info {} {
+ set curr [.pksearch.e get]
.pkglist delete [.pkglist children {}]
- foreach {nm pk} $::filtered {
- .pkglist insert {} end -id $nm -values $pk
+ dict for {nm pk} $::filtered {
+ set do_show 0
+ if {$curr eq ""} {
+ set do_show 1
+ } elseif {[search_nocase $curr $nm] >= 0} {
+ set do_show 1
+ } elseif {$::search_desc && \
+ [search_nocase $curr [dict get $::pkgs $nm shortdesc]] >= 0} {
+ set do_show 1
+ }
+ if $do_show {
+ .pkglist insert {} end -id $nm -values $pk
+ }
}
# also update displayed status info
@@ -751,30 +790,12 @@
enable_update_buttons 1
} ; # display_packages_info
-# to be called on changes in the searchbox
-proc update_packages_display {} {
- set curr [.srt.e get]
- if {$curr eq $::prv} return ; # leave list as-is
- # note. 'search_nocase' returns -1 if either needle or haystack is empty.
- # can we count on this?
- if {[search_nocase $::prv $curr] < 0} {
- # new selection not necessarily a subset of the old one
- .pkglist delete [.pkglist children {}]
- dict for {nm pk} $::filtered {
- if {[search_nocase $curr $nm] >= 0 || \
- [search_nocase $curr [dict get $::pkgs $nm shortdesc]] >= 0} {
- .pkglist insert {} end -id $nm -values $pk
- }
- }
- } else {
- foreach nm [.pkglist children {}] {
- if {[search_nocase $curr $nm] < 0 && \
- [search_nocase $curr [dict get $::pkgs $nm shortdesc]] < 0} {
- .pkglist delete [list $nm]
- }
- }
- }
- set ::prv $curr
+proc toggle_search_desc {} {
+ # when this proc is called, ::search_desc is not yet toggled
+ # so we temporarily toggle and untoggle it
+ set ::search_desc [expr $::search_desc ? 0 : 1]
+ display_packages_info
+ set ::search_desc [expr $::search_desc ? 0 : 1]
}
# selection tags in package list
@@ -791,27 +812,12 @@
# are invoked separately.
proc show_packages_info {} {
# first, reset search
- .srt.e delete 0 end
- switch $::sel_opt {
- "inst" {
- if {! [llength [dict keys $::pkgs]]} {get_packages_info_local}
- set filt "is_local"
- }
- "all" {
- if {! $::have_remote} {get_packages_info_remote}
- set filt ""
- }
- "upd" {
- if {! $::have_remote} {get_packages_info_remote}
- set filt "is_updatable"
- }
- "coll" {
- if {! $::have_remote} {get_packages_info _remote}
- set filt "is_collection"
- }
- }
- initialize_display_info $filt
- set ::matched [dict keys $::filtered]
+ #.pksearch.e delete 0 end
+ # make sure requested info is available
+ if {! [llength [dict keys $::pkgs]]} {get_packages_info_local}
+ if {$::stat_opt ne "inst" && ! $::have_remote} get_packages_info_remote
+ # build ::filtered dictionary of info to be displayed
+ initialize_display_info
display_packages_info
} ; # show_packages_info
More information about the tex-live-commits
mailing list