texlive[45527] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Simple
commits+siepo at tug.org
commits+siepo at tug.org
Thu Oct 12 20:21:12 CEST 2017
Revision: 45527
http://tug.org/svn/texlive?view=revision&revision=45527
Author: siepo
Date: 2017-10-12 20:21:11 +0200 (Thu, 12 Oct 2017)
Log Message:
-----------
Simple search added
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-12 05:19:26 UTC (rev 45526)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-10-12 18:21:11 UTC (rev 45527)
@@ -1,4 +1,4 @@
-#!/usr/bin/env wish
+#!/usr/bin/env wish8.5
# Copyright 2017 Siep Kroonenberg
@@ -59,6 +59,10 @@
set tempsub "" ; # subdir for temp files, set during initialization
+proc search_nocase {needle haystack} {
+ return [string first [string tolower $needle] [string tolower $haystack]]
+}
+
##### tl global status variables #####
set progname [info script]
@@ -75,8 +79,8 @@
# dict of (local and global) package dicts
set pkgs [dict create]
-set have_remote 0 ; # remote packages info loaded
-set need_update_self 0
+set have_remote 0 ; # remote packages info not loaded
+set need_update_tlmgr 0
set n_updates 0
set tlshell_updatable 0
@@ -123,7 +127,8 @@
do_debug "read_line: failing to read"
catch {chan close $::tlshl}
err_exit
- # note. the right way to terminate is terminating the shell
+ # note. the right way to terminate is terminating the GUI shell.
+ # This closes stdin of tlmgr shell.
} elseif {$len >= 0} {
# do_debug "read: $l"
if $::ddebug {puts $::flid $l}
@@ -135,6 +140,7 @@
do_debug "$::lnum: prompt found, $l"
$::pipe_cb "finish"
}
+ # for vwait:
set ::done_waiting 1
} else {
lappend ::out_log $l
@@ -230,7 +236,7 @@
}
proc run_cmd_waiting {cmd} {
- run_cmd $cmd ; # "waiting_cb"
+ run_cmd $cmd
vwait ::done_waiting
}
@@ -255,17 +261,12 @@
## package-related:
-proc package_popup {itm} {
- run_cmd_waiting "info $itm"
- tk_messageBox -message [join $::out_log "\n"]
-}
-
proc check_tlmgr_updatable {} {
run_cmd_waiting "update --self --list"
foreach l $::out_log {
if [regexp {^total-bytes[ \t]+([0-9]+)$} $l m b] {
do_debug "matches, $b"
- set ::need_update_self [expr {$b > 0} ? 1 : 0]
+ set ::need_update_tlmgr [expr {$b > 0} ? 1 : 0]
return
}
}
@@ -293,7 +294,7 @@
dict unset ::pkgs $nm
}
set ::have_remote 0
- set ::need_update_self 0
+ set ::need_update_tlmgr 0
set ::updatable 0
set ::tlshell_updatable 0
@@ -322,7 +323,7 @@
dict unset ::pkgs $k
}
}
- set ::need_update_self 0
+ set ::need_update_tlmgr 0
set ::updatable 0
set ::tlshell_updatable 0
@@ -367,8 +368,8 @@
update_globals
} ; # update_local_revnumbers
-proc update_self {} {
- if {! $::need_update_self} {
+proc update_tlmgr {} {
+ if {! $::need_update_tlmgr} {
tk_messageBox -message "Nothing to do!"
return
}
@@ -378,10 +379,10 @@
get_packages_info_remote
set ::sel_opt "inst"
display_packages_info is_local
-} ; # update_self
+} ; # update_tlmgr
proc update_all {} {
- if $::need_update_self {
+ if $::need_update_tlmgr {
tk_messageBox -message "Update self first!"
return
} elseif {! $::n_updates} {
@@ -402,19 +403,15 @@
set idummy -1
proc spacing {w} {
incr ::idummy
- pack [label $w.$::idummy -text " "]
+ pack [ttk::label $w.$::idummy -text " "]
}
proc pgrid {wdg args} { ; # grid command with padding
- set l [list grid $wdg -padx 3 -pady 3 -sticky w]
- foreach v $args {lappend l $v}
- eval [join $l " "]
+ grid $wdg {*}$args -padx 3 -pady 3 -sticky w
}
proc ppack {wdg args} { ; # pack command with padding
- set l [list pack $wdg -padx 3 -pady 3]
- foreach v $args {lappend l $v}
- eval [join $l " "]
+ pack $wdg {*}$args -padx 3 -pady 3
}
proc make_widgets {} {
@@ -424,45 +421,59 @@
# width of '0', as a rough estimate of average character width
set cw [font measure TkTextFont "0"]
+ # encompassing themed frame to guarantee a uniform background
+ pack [ttk::frame .bg]
+
# various info
- frame .topf
+ ttk::frame .topf
- pgrid [label .topf.llrepo -text Repository -anchor w] -row 0 -column 0
- pgrid [label .topf.lrepo -textvariable ::repo] -row 0 -column 1
+ pgrid [ttk::label .topf.llrepo -text Repository -anchor w] -row 0 -column 0
+ pgrid [ttk::label .topf.lrepo -textvariable ::repo] -row 0 -column 1
- pgrid [label .topf.lluptodate -text "TL Manager up to date?" -anchor w] \
- -row 1 -column 0
- label .topf.luptodate -anchor w
+ ttk::label .topf.lluptodate -text "TL Manager up to date?" -anchor w
+ pgrid .topf.lluptodate -row 1 -column 0
+ ttk::label .topf.luptodate -anchor w
pgrid .topf.luptodate -row 1 -column 1
- pgrid [label .topf.llcmd -anchor w -text "Last command: "] \
+ pgrid [ttk::label .topf.llcmd -anchor w -text "Last command: "] \
-row 2 -column 0
- pgrid [label .topf.lcmd -anchor w] -row 2 -column 1
- pack .topf -side top -anchor w
+ pgrid [ttk::label .topf.lcmd -anchor w] -row 2 -column 1
+ pack .topf -in .bg -side top -anchor w
# some buttons
- spacing .
- frame .butf
+ spacing .bg
+ ttk::frame .butf
ttk::button .butf.all -text "Update all" -command update_all
ppack .butf.all -side left
.butf.all configure -state disabled
- ttk::button .butf.self -text "Update self" -command update_self
+ ttk::button .butf.self -text "Update self" -command update_tlmgr
.butf.self configure -state disabled
ppack .butf.self -side left
- pack .butf -side top -anchor w
+ pack .butf -in .bg -side top -anchor w
# command entry
- spacing .
- frame .ent
- ppack [label .ent.l -text "Type command:"] -side left
- ppack [entry .ent.e -width 40] -side left -padx 3
+ spacing .bg
+ ttk::frame .ent
+ ppack [ttk::label .ent.l -text "Type command:"] -side left
+ ppack [ttk::entry .ent.e -width 40] -side left -padx 3
ppack [ttk::button .ent.b -text Go -command run_entry] -side left
bind .ent.e <Return> run_entry
- pack .ent -fill x -side top -expand 1
+ pack .ent -in .bg -fill x -side top -expand 1
- spacing .
+ spacing .bg
- # controlling package list
+ # 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
+
+ bind .srt.e <KeyRelease> {+update_packages_display}
+
+ # 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 \
@@ -473,15 +484,20 @@
-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 -side top -fill x
+ pack .fp_ctrl -in .bg -side top -fill x
# packages list (tlmgrgui uses an old HList widget)
- frame .fpkg
+ ttk::frame .fpkg
ttk::treeview .pkglist -columns \
{mk name localrev remoterev shortdesc} \
-show headings -height 8 -selectmode extended \
@@ -503,7 +519,7 @@
grid .pkvsb -in .fpkg -row 0 -column 1 -sticky ns
grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew
grid columnconfigure .fpkg 0 -weight 1
- pack .fpkg -side top -expand 1
+ pack .fpkg -in .bg -side top -expand 1
bind .pkglist <space> {toggle_marked [.pkglist focus] "#1"}
bind .pkglist <Return> {toggle_marked [.pkglist focus] "#1"}
@@ -519,8 +535,8 @@
{popup_focused [.pkglist identify item %x %y]}
# bottom of main window
- frame .endbuttons
- label .busy -textvariable ::busy -font TkHeadingFont -anchor w
+ ttk::frame .endbuttons
+ ttk::label .busy -textvariable ::busy -font TkHeadingFont -anchor w
ppack .busy -in .endbuttons -side left
ppack [ttk::button .q -text Quit -command exit] \
-in .endbuttons -side right
@@ -530,11 +546,13 @@
-in .endbuttons -side right
ttk::button .showlogs -text "Show logs" -command {wm state .lw normal}
ppack .showlogs -in .endbuttons -side right
- pack .endbuttons -side bottom -fill x -expand 1
+ pack .endbuttons -in .bg -side bottom -fill x -expand 1
- # log displays: new toplevel
+ # log displays: new toplevel, again with themed background frame
toplevel .lw
- frame .lw.log
+ pack [ttk::frame .lw.bg]
+
+ ttk::frame .lw.log
pack [ttk::scrollbar .lw.log.scroll -command ".lw.log.tx yview"] \
-side right -fill y
ppack [text .lw.log.tx -height 10 -bd 2 -relief groove -wrap word \
@@ -542,7 +560,7 @@
-expand 1 -fill both
.lw.log.tx yview moveto 1
- frame .lw.err
+ ttk::frame .lw.err
pack [ttk::scrollbar .lw.err.scroll -command ".lw.err.tx yview"] \
-side right -fill y
ppack [text .lw.err.tx -height 10 -bd 2 -relief groove -wrap word \
@@ -551,7 +569,7 @@
.lw.err.tx yview moveto 1
if $::ddebug {
- frame .lw.dbg
+ ttk::frame .lw.dbg
pack [ttk::scrollbar .lw.dbg.scroll -command ".lw.dbg.tx yview"] \
-side right -fill y
ppack [text .lw.dbg.tx -height 10 -bd 2 -relief groove -wrap word \
@@ -569,13 +587,13 @@
}
raise .lw.err .lw.logs
raise .lw.log .lw.logs
- pack .lw.logs -in .lw -side top -fill both -expand 1
+ pack .lw.logs -in .lw.bg -side top -fill both -expand 1
- frame .lw.bottom
+ ttk::frame .lw.bottom
ttk::button .lw.close -text close -command {wm withdraw .lw}
ppack .lw.close -in .lw.bottom -side right -anchor e
- ppack [label .lw.status -anchor w] -in .lw.bottom -side left
- pack .lw.bottom -side top -expand 1 -fill x
+ ppack [ttk::label .lw.status -anchor w] -in .lw.bottom -side left
+ pack .lw.bottom -in .lw.bg -side top -expand 1 -fill x
wm withdraw .lw
} ; # make_widgets
@@ -584,7 +602,7 @@
if {! $yesno || ! $::n_updates} {
.butf.all configure -state disabled
.butf.self configure -state disabled
- } elseif $::need_update_self {
+ } elseif $::need_update_tlmgr {
.butf.all configure -state disabled
.butf.self configure -state !disabled
} else {
@@ -631,7 +649,7 @@
tk_messageBox -message [join $::out_log "\n"]
}
-# filter procs; parameter is package name
+## filter procs; parameter is package name ##
proc is_local {p} {
return [dict get $::pkgs $p localrev]
@@ -654,13 +672,20 @@
}
}
-# display packages: always display both local and remote revision columns.
-# ::pkgs should already be up to date
+## 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
+
# manual selection tags: unicode chars as tags are resolution-independent.
# ATM we only display tags but do not use them otherwise.
-set mrk [format %c 0x25a3] ; # 'white square containing black small square'
-set nomrk [format %c 0x25a1] ; # 'white square'
+set mrk "\u25A3" ; # 'white square containing black small square'
+set nomrk "\u25A1" ; # 'white square'
# sel_opt: which packages to show from package list;
# after updates it will always be set to "inst", after installations "all"
@@ -681,24 +706,41 @@
}
} ; # toggle_marked
-proc display_packages_info {{filt ""}} {
- do_debug "display_packages_info with remote $::have_remote and filt >$filt<"
- .pkglist delete [.pkglist children {}]
+# display packages: always display both local and remote revision columns.
+# ::pkgs should already be up to date
- foreach nm [lsort [dict keys $::pkgs]] {
+# (re)create ::filtered dictionary; disregard search string
+proc initialize_display_info {{filt ""}} {
+ do_debug \
+ "initialize_packages_info with remote $::have_remote and filt >$filt<"
+ 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 in vl
- set vl [list $::nomrk $nm]
- foreach k {localrev remoterev shortdesc} {
- set vv [dict get $::pkgs $nm $k]
- if {$vv eq "0" || $vv == 0} {set vv ""}
- lappend vl $vv
- }
- .pkglist insert {} end -id $nm -values $vl
- } ; # else do not display
+ # 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
}
+} ; # initialize_display_info
+
+# initial display obeys filter, but no search string
+proc display_packages_info {} {
+ .pkglist delete [.pkglist children {}]
+ foreach {nm pk} $::filtered {
+ .pkglist insert {} end -id $nm -values $pk
+ }
+
# also update displayed status info
- if {$::have_remote && $::need_update_self} {
+ if {$::have_remote && $::need_update_tlmgr} {
.topf.luptodate configure -text "Needs updating"
} elseif $::have_remote {
.topf.luptodate configure -text "Up to date"
@@ -709,6 +751,32 @@
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
+}
+
# selection tags in package list
# 1. selections themselves get lost too easily
# 2. the -image option for ttk::treeview tags does not look right
@@ -722,6 +790,8 @@
# is clicked. Otherwise, get_packages_info_... and display_packages_info
# 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}
@@ -740,7 +810,9 @@
set filt "is_collection"
}
}
- display_packages_info $filt
+ initialize_display_info $filt
+ set ::matched [dict keys $::filtered]
+ display_packages_info
} ; # show_packages_info
##### (re)initialization procs #####
@@ -810,7 +882,7 @@
# directory for temp files
set attemptdirs {}
foreach tmp {TMPDIR TEMP TMP} {
- if {[lsearch [array names ::env] $tmp] >= 0} {
+ if {$tmp in [array names ::env]} {
lappend attemptdirs $::env($tmp)
}
}
@@ -845,9 +917,11 @@
set ::err_file [maketemp ".err_tlshl"]
# logfile
- set fname [file join $::tempsub \
+ if $::ddebug {
+ set fname [file join $::tempsub \
[clock format [clock seconds] -format {%H:%M}]]
- set ::flid [open $fname w]
+ set ::flid [open $fname w]
+ }
make_widgets
More information about the tex-live-commits
mailing list