diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2017-10-12 18:21:11 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2017-10-12 18:21:11 +0000 |
commit | 123e3aac600ec67a402331141905c1d6af44e9f2 (patch) | |
tree | e633b5a0672c774284a9112f1a562f6116ab8d3b /Master/texmf-dist/scripts/tlshell | |
parent | fa79130908eed3e87903a6b9ecc2f2c7dd014c83 (diff) |
Simple search added
git-svn-id: svn://tug.org/texlive/trunk@45527 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/tlshell')
-rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 238 |
1 files changed, 156 insertions, 82 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index a46d1b4bab9..4d2e51b5242 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -1,4 +1,4 @@ -#!/usr/bin/env wish +#!/usr/bin/env wish8.5 # Copyright 2017 Siep Kroonenberg @@ -59,6 +59,10 @@ proc maketemp {ext} { 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 @@ set out_log {} # 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 @@ proc read_line {} { 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 @@ proc read_line {} { 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 {cmd {cb ""}} { } proc run_cmd_waiting {cmd} { - run_cmd $cmd ; # "waiting_cb" + run_cmd $cmd vwait ::done_waiting } @@ -255,17 +261,12 @@ proc get_repo {} { ## 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 @@ proc get_packages_info_local {} { 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 @@ proc get_packages_info_remote {} { 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 @@ proc update_local_revnumbers {} { 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 @@ proc update_self {} { 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 @@ proc update_all {} { 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 @@ proc make_widgets {} { # 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 .bg - spacing . + # 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 - # controlling package list + 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 @@ proc make_widgets {} { -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 @@ proc make_widgets {} { 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 @@ proc make_widgets {} { {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 @@ proc make_widgets {} { -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 @@ proc make_widgets {} { -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 @@ proc make_widgets {} { .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 @@ proc make_widgets {} { } 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 @@ proc enable_update_buttons {yesno} { 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 @@ proc popup_focused {itm} { 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 @@ proc is_updatable {p} { } } -# 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 @@ proc toggle_marked {itm cl} { } } ; # 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 @@ proc display_packages_info {{filt ""}} { 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 @@ proc display_packages_info {{filt ""}} { # 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 @@ proc show_packages_info {} { 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 @@ proc initialize {} { # 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 @@ proc initialize {} { 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 |