diff options
Diffstat (limited to 'Master/texmf-dist/scripts/tlshell')
| -rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 774 |
1 files changed, 473 insertions, 301 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index 534acb4f1de..a46d1b4bab9 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -15,6 +15,8 @@ package require Tk # This directory will be prepended to the searchpath. # kpsewhich will disentangle symlinks. +##### general housekeeping ##### + # security: disable send catch {rename send {}} @@ -27,7 +29,7 @@ proc do_debug {s} { } } -proc get_stack {} { +proc get_stacktrace {} { set level [info level] set s "" for {set i 1} {$i < $level} {incr i} { @@ -36,80 +38,53 @@ proc get_stack {} { return $s } -# unicode characters as tag indicators, in hex. This is pretty safe, -# since Tk will use glyphs from other fonts if necessary. -# With bitmaps, we would have to worry about HiDpi displays. +proc maketemp {ext} { + set fname "" + foreach i {0 1 2 3 4 5 6 7 8 9} { ; # ten tries + set fname [file join $::tempsub "[expr int(10000.0*rand())]$ext"] + if {[file exist $fname]} {set fname ""; continue} + # create empty file. although we just want a name, + # we must make sure that it can be created. + set fid [open $fname w] + close $fid + if {! [file exists $fname]} {error "Cannot create temporary file"} + if {$::tcl_platform(platform) eq "unix"} { + file attributes $fname -permissions 0600 + } + break + } + if {$fname eq ""} {error "Cannot create temporary file"} + return $fname +} ; # maketemp -set mrk [format %c 0x25a3] ; # 'white square containing black small square' -set nomrk [format %c 0x25a1] ; # 'white square' +set tempsub "" ; # subdir for temp files, set during initialization + +##### tl global status variables ##### set progname [info script] regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy progname set procid [pid] -set tempsub "" ; # subdirectory for temporary files +# package repository +set repo "" # the stderr and stdout of tlmgr are each read into a list of strings set err_log {} set out_log {} -# callback for reading tlmgr pipe -set pipe_cb "" -set lnum -1 - # dict of (local and global) package dicts set pkgs [dict create] -set do_remote 0 ; # get local packages -set have_remote 0 ; # remote packages loaded +set have_remote 0 ; # remote packages info loaded +set need_update_self 0 +set n_updates 0 +set tlshell_updatable 0 -# filtering the package list, parameter should be package NAME -set filt "" - -proc filt_local {p} { - return [dict get $::pkgs $p localrev] -} - -proc filt_collections {p} { - set c [dict get $::pkgs $p "category"] - return [expr \"$c\" eq \"Collection\"] -} - -proc filt_upgradable {p} { - do_debug "Is $p upgradable?" - set lr [dict get $::pkgs $p localrev] - set rr [dict get $::pkgs $p remoterev] - do_debug "$p: comparing $lr and $rr" - if {$lr == 0} { - return 0 - } elseif {$rr == 0} { - return 0 - } - return [expr $rr > $lr] -} +##### handling tlmgr via pipe and stderr tempfile ##### set prmpt "tlmgr>" set busy 0 -proc maketemp {ext} { - set fname "" - foreach i {0 1 2 3 4 5 6 7 8 9} { ; # ten tries - set fname [file join $::tempsub "[expr int(10000.0*rand())]$ext"] - if {[file exist $fname]} {set fname ""; continue} - # create empty file. although we just want a name, - # we must make sure that it can be created. - set fid [open $fname w] - close $fid - if {! [file exists $fname]} {error "Cannot create temporary file"} - if {$::tcl_platform(platform) eq "unix"} { - file attributes $fname -permissions 0600 - } - break - } - if {$fname eq ""} {error "Cannot create temporary file"} - return $fname -} - # TODO: # replace messagebox with a custom toplevel with a text widget # in case there is a lot of text @@ -134,11 +109,13 @@ proc read_err {} { } # about [chan] gets: -# if a second parameter is supplied +# if a second parameter, in this case l, is supplied # then this variable receives the result, with EOL stripped, # and the return value is the string length, possibly 0 # EOF is indicated by a return value of -1. +# a caller of run_cmd needs to explicitly invoke 'vwait ::done_waiting' +# if it wants to wait for the command to finish proc read_line {} { incr ::lnum set l "" ; # will contain the line to be read @@ -149,14 +126,16 @@ proc read_line {} { # note. the right way to terminate is terminating the shell } elseif {$len >= 0} { # do_debug "read: $l" + if $::ddebug {puts $::flid $l} if {[string first $::prmpt $l] == 0} { # prompt line: done with command - enable_widgets 1 + enable_widgets 1 ; # this may have to be redone later read_err if {$::pipe_cb ne ""} { do_debug "$::lnum: prompt found, $l" $::pipe_cb "finish" } + set ::done_waiting 1 } else { lappend ::out_log $l if {$::pipe_cb ne ""} {$::pipe_cb "line" "$l"} @@ -164,7 +143,11 @@ proc read_line {} { } } ; # read_line -# copy error strings to error page, which is sent to top. +##### displaying stuff in GUI ##### + +## stderr ## + +# copy error strings to error log page, which is sent to top. # This by itself does not map the logs toplevel .lw proc show_err_log {} { #do_debug "show_err_log" @@ -181,59 +164,12 @@ proc show_err_log {} { } } ; # show_err_log -# package info popup for the package having focus -proc popup_focused {itm} { - run_cmd "info $itm" package_popup_cb -} - -# display packages: always display both local and remote revision columns. -# the caller should have set a filter for the packages to be displayed. -# ::pkgs should already be up to date - -proc display_packages {} { - - .pkglist delete [.pkglist children {}] - - dict for {nm pk} $::pkgs { - if {$::filt eq "" || [$::filt $nm]} { - set vl [list $::nomrk $nm] - foreach k {localrev remoterev shortdesc} { - set vv [dict get $pk $k] - if {$vv eq "0" || $vv == 0} {set vv ""} - lappend vl $vv - } - .pkglist insert {} end -id $nm -values $vl - } ; # else do not display - } - update ; # uncomment if necessary -} ; # display_packages - -##### selection tags in package list ############################ - -# 1. selections themselves get lost too easily -# 2. the -image option for ttk::treeview tags does not look right -# Therefore a do-it-yourself implementation with column #1 reserved for -# a marker, package name in column #2, and column #0 not displayed. -# the marker could have been prefixed to the package name in column #0, -# but I think a separate marker column is a cleaner solution. - -proc toggle_marked {itm cl} { - # if toggle_marked is triggered by a mouse click - # then it should do nothing unless it was a click in column #1 - if {$cl ne "#1"} { - return - } - if [.pkglist tag has marked $itm] { - .pkglist tag remove marked $itm - .pkglist set $itm mk $::nomrk - } else { - .pkglist tag add marked $itm - .pkglist set $itm mk $::mrk - } -} ; # toggle_marked - ##### callbacks for file events of tlmgr pipe ::tlshl (names *_cb) ##### +# callback for reading tlmgr pipe +set pipe_cb "" +set lnum -1 + ## template for pipe callback: #proc template_cb {mode {l ""}} { # if {$mode eq "line"} { @@ -241,20 +177,13 @@ proc toggle_marked {itm cl} { # } elseif {$mode eq "init"} { # # do something # } elseif {$mode eq "finish"} { -# # do something +# # do something BUT DO NOT TRIGGER ANOTHER EVENT LOOP # } else { # lappend ::err_log "Illegal call of whatever_cb" # err_exit # } #} -proc early_cb {mode {l ""}} { - # for reading initial output tlmgr - if {$mode eq "finish"} { - set ::started 1 - } -} - proc log_widget_cb {mode {l ""}} { if {$mode eq "line"} { .lw.log.tx configure -state normal @@ -262,6 +191,9 @@ proc log_widget_cb {mode {l ""}} { } elseif {$mode eq "init"} { .lw.log.tx configure -state normal .lw.log.tx delete 1.0 end + .lw.status configure -text "Running" + .lw.close configure -state disabled + wm state .lw normal } elseif {$mode eq "finish"} { .lw.log.tx yview moveto 1 .lw.logs select .lw.log @@ -270,75 +202,38 @@ proc log_widget_cb {mode {l ""}} { if {$::tcl_platform(os) ne "Darwin"} { .lw.log.tx configure -state disabled } - .ent.e configure -state normal + .lw.status configure -text "" + .lw.close configure -state !disabled } else { lappend ::err_log "Illegal call of log_widget_cb" err_exit } } ; # log_widget_cb -proc packages_cb {mode {l ""}} { - if $::do_remote { - set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$} - } else { - set re {^([^,]+),([0-9]+),([^,]*),(.*)$} - } - if {$mode eq "line"} { - #do_debug $l - if {($::do_remote && [regexp $re $l m pname lrev rrev catg pdescr]) || \ - ((! $::do_remote) && [regexp $re $l m pname lrev catg pdescr])} { - # unknown revision: 0 in database, " " in displayed list - if {! $::do_remote} {set rrev 0} - # double-quotes: remove outer, unescape inner - if {[string index $pdescr 0] eq "\""} { - set pdescr [string range $pdescr 1 end-1] - } - set pdescr [regsub -all "\\\"" $pdescr "\""] - dict set ::pkgs $pname \ - [list "localrev" $lrev "remoterev" $rrev \ - "category" $catg shortdesc $pdescr] - } else { - #do_debug "$::lnum no match: $l" - } - return - } elseif {$mode eq "init"} { - # is it useful to remove items one by one? - # or will the garbage collector take care of it? - foreach nm [dict keys $::pkgs] {dict unset ::pkgs $nm} - do_debug "packages_cb init with do_remote $::do_remote and filt $::filt" - return - } elseif {$mode eq "finish"} { - do_debug "packages_cb finish with do_remote $::do_remote and filt $::filt" - set ::have_remote $::do_remote - #do_debug [get_stack] - display_packages - return - } else { - lappend ::err_log "Illegal call of packages_cb" - err_exit - } -} ; # packages_cb - -proc package_popup_cb {mode {l ""}} { - if {$mode eq "finish"} { - tk_messageBox -message [join $::out_log "\n"] - } -} +##### running tlmgr commands ##### -# procs involving running tlmgr commands ######################### +## general and various: proc run_cmd {cmd {cb ""}} { set ::pipe_cb $cb do_debug "run_cmd \"$cmd\"" + if $::ddebug {puts $::flid "\n$cmd"} + .topf.lcmd configure -text $cmd enable_widgets 0 set ::out_log {} set ::err_log {} set ::lnum 0 + unset -nocomplain ::done_waiting if {$::pipe_cb ne ""} {$::pipe_cb "init"} chan puts $::tlshl $cmd chan flush $::tlshl } +proc run_cmd_waiting {cmd} { + run_cmd $cmd ; # "waiting_cb" + vwait ::done_waiting +} + proc run_entry {} { # TODO: some validation of $cmd do_debug "run_entry" @@ -350,163 +245,242 @@ proc run_entry {} { run_cmd $cmd log_widget_cb } +proc get_repo {} { + run_cmd_waiting "option repository" + set re {repository\t(.*)$} + foreach l $::out_log { + if [regexp $re $l m ::repo] break + } +} ; # get_repo + +## package-related: + proc package_popup {itm} { - # tk_messageBox -message $itm - run_cmd "info $itm" package_popup_cb + run_cmd_waiting "info $itm" + tk_messageBox -message [join $::out_log "\n"] } -# package list; use previously set values for ::do_remote and ::filt -# we already know that we need a package list from tlmgr -proc get_and_display_packages {} { - do_debug "get_and_display_packages: filt $::filt and remote $::do_remote" - foreach k [dict keys $::pkgs] {dict unset ::pkgs $k} - set ::have_remote 0 - if {$::do_remote} { - run_cmd "info --data name,localrev,remoterev,category,shortdesc" \ - packages_cb - } else { - set ::have_remote 0 - run_cmd "info --only-installed --data name,localrev,category,shortdesc" \ - packages_cb +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] + return + } } -} + do_debug "check_tlmgr_uptodate: should not get here" +} ; # check_tlmgr_uptodate -proc show_all_packages {} { - set ::filt "" - if $::have_remote { - display_packages - } else { - set ::do_remote 1 - get_and_display_packages ; # calls display_packages as finish callback - } -} ; # show_all_packages - -proc show_local_packages {} { - set ::filt filt_local - set ::do_remote 0 - if {[llength [dict keys $::pkgs]] == 0} { - do_debug "show_local_packages: no packages loaded" - set ::have_remote 0 - get_and_display_packages - } else { - do_debug "show_local_packages: packages already loaded" - display_packages +proc update_globals {} { + if {! $::have_remote} return + set ::n_updates 0 + foreach nm [dict keys $::pkgs] { + if [is_updatable $nm] {incr ::n_updates} } -} ; # show_local_packages + check_tlmgr_updatable + set ::tlshell_updatable [is_updatable tlshell] +} -proc show_collections {} { - set ::filt filt_collections - if {! $::have_remote} { - set ::do_remote 1 - get_and_display_packages - } else { - display_packages - } -} ; # show_collections +# get fresh package list +# some local packages may not be available online. +# to test, create local dual-platform installation from dvd, try to update +# from more recent linux-only installation -proc show_upgradable {} { - set ::filt filt_upgradable - if {! $::have_remote} { - # get a complete package list - set ::do_remote 1 - do_debug "show_upgradable: remote not yet loaded" - get_and_display_packages - } else { - do_debug "show_upgradable: remote already loaded" - display_packages +# local: start from scratch +proc get_packages_info_local {} { + foreach nm [dict keys $::pkgs] { + dict unset ::pkgs $nm } -} ; # show_upgradable + set ::have_remote 0 + set ::need_update_self 0 + set ::updatable 0 + set ::tlshell_updatable 0 + + run_cmd_waiting \ + "info --only-installed --data name,localrev,category,shortdesc" + set re {^([^,]+),([0-9]+),([^,]*),(.*)$} + foreach l $::out_log { + if [regexp $re $l m nm lrev catg pdescr] { + # double-quotes: remove outer, unescape inner + if {[string index $pdescr 0] eq "\""} { + set pdescr [string range $pdescr 1 end-1] + } + set pdescr [regsub -all "\\\"" $pdescr "\""] + dict set ::pkgs $nm \ + [list "localrev" $lrev "remoterev" 0 \ + "category" $catg shortdesc $pdescr] + } + } +} ; # get_packages_info_local -# (re)initialization procs ############################ +# remote: preserve information on installed packages +proc get_packages_info_remote {} { + # remove non-local database entries + foreach k [dict keys $::pkgs] { + if {! [dict get $::pkgs $k localrev]} { + dict unset ::pkgs $k + } + } + set ::need_update_self 0 + set ::updatable 0 + set ::tlshell_updatable 0 -proc start_tlmgr {} { - # start the TeX Live Manager shell interface - # capture stdout into the pipe, stderr into a temp file - # below, early_cb and vwait ::started together forces tlshell - # to process initial tlmgr output before continuing - set ::pipe_cb early_cb - unset -nocomplain ::started - set ::tlshl [open "|tlmgr --machine-readable shell 2>>$::err_file" w+] - set ::err [open $::err_file r] - chan configure $::tlshl -buffering line -blocking 0 - chan event $::tlshl readable read_line - vwait ::started - show_local_packages -} + run_cmd_waiting "info --data name,localrev,remoterev,category,shortdesc" + set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$} + foreach l $::out_log { + if [regexp $re $l m nm lrev rrev catg pdescr] { + # double-quotes in short description: remove outer, unescape inner + if {[string index $pdescr 0] eq "\""} { + set pdescr [string range $pdescr 1 end-1] + } + set pdescr [regsub -all "\\\"" $pdescr "\""] + if [catch {dict get $::pkgs $nm} pk] { + # package entry does not exist + dict set ::pkgs $nm [dict create "localrev" 0 \ + "remoterev" $rrev "category" $catg shortdesc $pdescr] + } else { + dict set ::pkgs $nm "remoterev" $rrev + dict set ::pkgs $nm "category" $catg + dict set ::pkgs $nm "shortdesc" $pdescr + } + } + } + set ::have_remote 1 + update_globals +} ; # get_packages_info_remote + +## update ::pkgs after installing packages without going online. +## this should be considered a shortcut version of get_packages_info_xxx, +## and should similarly take care of the globals; see above +proc update_local_revnumbers {} { + run_cmd_waiting "info --only-installed --data name,localrev" + set re {^([^,]+),([0-9]+)$} + foreach nm [dict keys $::pkgs] { + dict set ::pkgs $nm "localrev" 0 + } + foreach l $::out_log { + if [regexp $re $l m nm lr] { + dict set ::pkgs $nm "localrev" $lr + } + } + update_globals +} ; # update_local_revnumbers -proc restart_self {} { - do_debug "trying to restart" - if {$::progname eq ""} { - tk_messageBox -message "progname not found; not restarting" +proc update_self {} { + if {! $::need_update_self} { + tk_messageBox -message "Nothing to do!" return } - catch {chan close $::tlshl} - catch {chan close $::err} - exec $::progname & - # on windows, it may take several seconds before - # the old tlshell disappears. - # oh well, windows is still windows.... - exit -} + run_cmd "update --self" log_widget_cb + vwait ::done_waiting + # tlmgr restarts itself automatically, reload remote + get_packages_info_remote + set ::sel_opt "inst" + display_packages_info is_local +} ; # update_self + +proc update_all {} { + if $::need_update_self { + tk_messageBox -message "Update self first!" + return + } elseif {! $::n_updates} { + tk_messageBox -message "Nothing to do!" + return + } + run_cmd "update --all" log_widget_cb + vwait ::done_waiting + #wm withdraw .lw + update_local_revnumbers + set ::sel_opt "inst" + display_packages_info is_local +} ; # update_all + +##### building GUI ##### -# dummy widgets for vertical spacing +# dummy widgets for vertical spacing within $w set idummy -1 proc spacing {w} { incr ::idummy pack [label $w.$::idummy -text " "] } -#proc pgrid {wdg args} { ; # padded grid -# set l [list grid $wdg -padx 3 -pady 3] -# foreach v $args {lappend l $v} -# eval [join $l ""] -#} +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 " "] +} + +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 " "] +} proc make_widgets {} { wm title . "$::progname $::procid" - # width of '0', as a rough estimate of character width + # width of '0', as a rough estimate of average character width set cw [font measure TkTextFont "0"] # various info frame .topf - pack [label .busy -textvariable ::busy] -in .topf -side right -padx 3 - pack [label .more -justify left -text "Buttons (more to come)"] \ - -in .topf -side left -padx 3 - pack .topf -side top -fill x -expand 1 - - # main buttons block - frame .buttons - grid [ttk::button .pkgl -text "Show all packages" \ - -command show_all_packages] \ - -in .buttons -column 0 -row 1 -sticky w -padx 3 -pady 3 - grid [ttk::button .locals -text "Show installed packages" \ - -command {show_local_packages}] \ - -in .buttons -column 1 -row 1 -sticky w -padx 3 -pady 3 - grid [ttk::button .coll -text "Show collections" \ - -command {show_collections}] \ - -in .buttons -column 2 -row 1 -sticky w -padx 3 -pady 3 - grid [ttk::button .upgr -text "Show upgradable" \ - -command {show_upgradable}] \ - -in .buttons -column 3 -row 1 -sticky w - pack .buttons -side top -fill x -expand 1 -padx 3 -pady 3 + + pgrid [label .topf.llrepo -text Repository -anchor w] -row 0 -column 0 + pgrid [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 + pgrid .topf.luptodate -row 1 -column 1 + + pgrid [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 + + # some buttons + spacing . + 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 + .butf.self configure -state disabled + ppack .butf.self -side left + pack .butf -side top -anchor w # command entry spacing . frame .ent - pack [label .ent.l -text "Type command:"] -side left -padx 3 - pack [entry .ent.e -width 40] -side left -padx 3 - pack [ttk::button .ent.b -text Go -command run_entry] -side left -padx 3 + ppack [label .ent.l -text "Type command:"] -side left + ppack [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 - #grid [label .ent.lprv -justify left -text "Last command entry: "] \ - # -row 1 -column 0 - #grid [label .ent.prv -justify left] -row 1 -column 1 -sticky w + spacing . + + # controlling package list + 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 + ppack .fp_ctrl.inst -side left + ppack .fp_ctrl.all -side left + ppack .fp_ctrl.upd -side left + ppack .fp_ctrl.coll -side left + set ::sel_opt inst + pack .fp_ctrl -side top -fill x # packages list (tlmgrgui uses an old HList widget) - spacing . frame .fpkg ttk::treeview .pkglist -columns \ {mk name localrev remoterev shortdesc} \ @@ -525,7 +499,7 @@ proc make_widgets {} { ttk::scrollbar .pkhsb -orient horizontal -command {.pkglist xview} ttk::scrollbar .pkvsb -orient vertical -command {.pkglist yview} - grid .pkglist -in .fpkg -row 0 -column 0 -sticky news + pgrid .pkglist -in .fpkg -row 0 -column 0 -sticky news 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 @@ -546,12 +520,16 @@ proc make_widgets {} { # bottom of main window frame .endbuttons - pack [ttk::button .q -text Quit -command exit] \ - -in .endbuttons -side right -padx 3 -pady 3 - pack [ttk::button .r -text "Restart self" -command restart_self] \ - -in .endbuttons -side right -padx 3 -pady 3 + 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 + ppack [ttk::button .r -text "Restart self" -command restart_self] \ + -in .endbuttons -side right + ppack [ttk::button .t -text "Restart tlmgr" -command restart_tlmgr] \ + -in .endbuttons -side right ttk::button .showlogs -text "Show logs" -command {wm state .lw normal} - pack .showlogs -in .endbuttons -side right -padx 3 + ppack .showlogs -in .endbuttons -side right pack .endbuttons -side bottom -fill x -expand 1 # log displays: new toplevel @@ -559,7 +537,7 @@ proc make_widgets {} { frame .lw.log pack [ttk::scrollbar .lw.log.scroll -command ".lw.log.tx yview"] \ -side right -fill y - pack [text .lw.log.tx -height 10 -bd 2 -relief groove -wrap word \ + ppack [text .lw.log.tx -height 10 -bd 2 -relief groove -wrap word \ -yscrollcommand ".lw.log.scroll set"] \ -expand 1 -fill both .lw.log.tx yview moveto 1 @@ -567,7 +545,7 @@ proc make_widgets {} { frame .lw.err pack [ttk::scrollbar .lw.err.scroll -command ".lw.err.tx yview"] \ -side right -fill y - pack [text .lw.err.tx -height 10 -bd 2 -relief groove -wrap word \ + ppack [text .lw.err.tx -height 10 -bd 2 -relief groove -wrap word \ -yscrollcommand ".lw.err.scroll set"] \ -expand 1 -fill both .lw.err.tx yview moveto 1 @@ -576,7 +554,7 @@ proc make_widgets {} { frame .lw.dbg pack [ttk::scrollbar .lw.dbg.scroll -command ".lw.dbg.tx yview"] \ -side right -fill y - pack [text .lw.dbg.tx -height 10 -bd 2 -relief groove -wrap word \ + ppack [text .lw.dbg.tx -height 10 -bd 2 -relief groove -wrap word \ -yscrollcommand ".lw.dbg.scroll set"] \ -expand 1 -fill both .lw.dbg.tx yview moveto 1 @@ -591,14 +569,30 @@ proc make_widgets {} { } raise .lw.err .lw.logs raise .lw.log .lw.logs - pack .lw.logs -in .lw -side top -fill both -expand 1 -padx 3 + pack .lw.logs -in .lw -side top -fill both -expand 1 + frame .lw.bottom ttk::button .lw.close -text close -command {wm withdraw .lw} - pack .lw.close -side bottom -anchor e -padx 3 -pady 3 + 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 wm withdraw .lw } ; # make_widgets +proc enable_update_buttons {yesno} { + if {! $yesno || ! $::n_updates} { + .butf.all configure -state disabled + .butf.self configure -state disabled + } elseif $::need_update_self { + .butf.all configure -state disabled + .butf.self configure -state !disabled + } else { + .butf.all configure -state !disabled + .butf.self configure -state disabled + } +} + proc enable_widgets {yesno} { if $yesno { set st normal @@ -609,20 +603,190 @@ proc enable_widgets {yesno} { set ttk_st disabled set ::busy "BUSY" } - # buttons - .pkgl configure -state $ttk_st + + enable_update_buttons $yesno + # command entry .ent.b configure -state $st .ent.e configure -state $st - # package list - .pkglist state $ttk_st - # do not touch the log windows + # final buttons .q configure -state $ttk_st .r configure -state $ttk_st + .t configure -state $ttk_st .showlogs configure -state $ttk_st + + .lw.close configure -state $ttk_st + if $yesno { + .lw.status configure -text "Done" + } else { + .lw.status configure -text "Please wait..." + } } ; # enable_widgets +## single-package info ## + +proc popup_focused {itm} { + run_cmd_waiting "info $itm" + 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] + } +} + +# display packages: always display both local and remote revision columns. +# ::pkgs should already be up to date + +# 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' + +# sel_opt: which packages to show from package list; +# after updates it will always be set to "inst", after installations "all" +set sel_opt inst + +proc toggle_marked {itm cl} { + # if toggle_marked is triggered by a mouse click + # then it should do nothing unless it was a click in column #1 + if {$cl ne "#1"} { + return + } + if [.pkglist tag has marked $itm] { + .pkglist tag remove marked $itm + .pkglist set $itm mk $::nomrk + } else { + .pkglist tag add marked $itm + .pkglist set $itm mk $::mrk + } +} ; # toggle_marked + +proc display_packages_info {{filt ""}} { + do_debug "display_packages_info with remote $::have_remote and filt >$filt<" + .pkglist delete [.pkglist children {}] + + foreach nm [lsort [dict keys $::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 + } + # also update displayed status info + if {$::have_remote && $::need_update_self} { + .topf.luptodate configure -text "Needs updating" + } elseif $::have_remote { + .topf.luptodate configure -text "Up to date" + } else { + .topf.luptodate configure -text "Unknown" + } + # ... and status of update buttons + enable_update_buttons 1 +} ; # display_packages_info + +# selection tags in package list +# 1. selections themselves get lost too easily +# 2. the -image option for ttk::treeview tags does not look right +# Therefore a do-it-yourself implementation with column #1 reserved for +# a marker, package name in column #2, and column #0 not displayed at all. +# the marker could have been prefixed to the package name in column #0, +# but I think a separate marker column is a cleaner solution. + +# display packages, invoking get_packages_info if necessary. +# called at end of initialization and when a selection radio button +# is clicked. Otherwise, get_packages_info_... and display_packages_info +# are invoked separately. +proc show_packages_info {} { + 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" + } + } + display_packages_info $filt +} ; # show_packages_info + +##### (re)initialization procs ##### + +proc start_tlmgr {} { + # start the TeX Live Manager shell interface + # capture stdout into the pipe, stderr into a temp file + # below, vwait ::done_waiting forces tlshell + # to process initial tlmgr output before continuing + unset -nocomplain ::done_waiting + set ::tlshl [open "|tlmgr --machine-readable shell 2>>$::err_file" w+] + set ::err [open $::err_file r] + chan configure $::tlshl -buffering line -blocking 0 + chan event $::tlshl readable read_line + vwait ::done_waiting + #get_repo + #if {$::argc && [lindex $::argv 0] eq "remote"} { + # show_packages_info 0 is_local + #} else { + # show_packages_info 1 is_local + #} +} + +proc restart_tlmgr {} { + catch {chan close $::tlshl} + catch {chan close $::err} + start_tlmgr + get_packages_info_remote + display_packages_info +} + +proc restart_self {{param ""}} { + do_debug "trying to restart" + if {$::progname eq ""} { + tk_messageBox -message "progname not found; not restarting" + return + } + catch {chan close $::tlshl} + catch {chan close $::err} + exec $::progname & + # on windows, it may take several seconds before + # the old tlshell disappears. + # oh well, windows is still windows.... + exit +} + proc initialize {} { # prepend TL to process searchpath (not needed on windows) if {$::tcl_platform(platform) ne "windows"} { @@ -680,9 +844,17 @@ proc initialize {} { # temp file for stderr set ::err_file [maketemp ".err_tlshl"] + # logfile + set fname [file join $::tempsub \ + [clock format [clock seconds] -format {%H:%M}]] + set ::flid [open $fname w] + make_widgets start_tlmgr + get_repo + set ::sel_opt "inst" + show_packages_info }; # initialize initialize |