texlive[45239] Master: Some package filtering options; cosmetic
commits+siepo at tug.org
commits+siepo at tug.org
Thu Sep 7 22:09:36 CEST 2017
Revision: 45239
http://tug.org/svn/texlive?view=revision&revision=45239
Author: siepo
Date: 2017-09-07 22:09:36 +0200 (Thu, 07 Sep 2017)
Log Message:
-----------
Some package filtering options; cosmetic changes; README moved to doc/support/tlshell
Modified Paths:
--------------
trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
trunk/Master/tlpkg/tlpsrc/tlshell.tlpsrc
Added Paths:
-----------
trunk/Master/texmf-dist/doc/support/tlshell/
trunk/Master/texmf-dist/doc/support/tlshell/README
Removed Paths:
-------------
trunk/Master/texmf-dist/scripts/tlshell/README
Copied: trunk/Master/texmf-dist/doc/support/tlshell/README (from rev 45238, trunk/Master/texmf-dist/scripts/tlshell/README)
===================================================================
--- trunk/Master/texmf-dist/doc/support/tlshell/README (rev 0)
+++ trunk/Master/texmf-dist/doc/support/tlshell/README 2017-09-07 20:09:36 UTC (rev 45239)
@@ -0,0 +1,7 @@
+Tlshell is to become a replacement for tlmgrgui, based on Tcl/Tk
+rather than on the Perl/Tk module.
+
+At the moment everything is still in flux and not suitable for
+general testing.
+
+Siep Kroonenberg
Deleted: trunk/Master/texmf-dist/scripts/tlshell/README
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/README 2017-09-07 11:22:02 UTC (rev 45238)
+++ trunk/Master/texmf-dist/scripts/tlshell/README 2017-09-07 20:09:36 UTC (rev 45239)
@@ -1,7 +0,0 @@
-Tlshell is to become a replacement for tlmgrgui, based on Tcl/Tk
-rather than on the Perl/Tk module.
-
-At the moment everything is still in flux and not suitable for
-general testing.
-
-Siep Kroonenberg
Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-09-07 11:22:02 UTC (rev 45238)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-09-07 20:09:36 UTC (rev 45239)
@@ -1,4 +1,10 @@
#!/usr/bin/env wish
+
+# Copyright 2017 Siep Kroonenberg
+
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
package require Tk
# searchpath:
@@ -12,6 +18,31 @@
# security: disable send
catch {rename send {}}
+set ddebug 0
+proc do_debug {s} {
+ if {$::ddebug} {
+ puts stderr $s
+ # catch in case the widget concerned has not yet been created
+ catch {.lw.dbg.tx configure -state normal; .lw.dbg.tx insert end "$s\n"}
+ }
+}
+
+proc get_stack {} {
+ set level [info level]
+ set s ""
+ for {set i 1} {$i < $level} {incr i} {
+ append s [format "Level %u: %s\n" $i [info level $i]]
+ }
+ 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.
+
+set mrk [format %c 0x25a3] ; # 'white square containing black small square'
+set nomrk [format %c 0x25a1] ; # 'white square'
+
set progname [info script]
regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy progname
set procid [pid]
@@ -22,35 +53,44 @@
set err_log {}
set out_log {}
-# dicts of package dicts
-set pkgs {}
-if 0 {
-set pkgs_local {}
-set pkgs_remote {}
-set pkgs pkgs_local
+# 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
+
+# filtering the package list, parameter should be package NAME
+set filt ""
+
+proc filt_local {p} {
+ return [dict get $::pkgs $p localrev]
}
-set prmpt "tlmgr>"
-set busy 0
+proc filt_collections {p} {
+ set c [dict get $::pkgs $p "category"]
+ return [expr \"$c\" eq \"Collection\"]
+}
-set ddebug 0
-if $::ddebug {
- frame .dbg
- pack [ttk::scrollbar .dbg.scroll -command ".dbg.tx yview"] \
- -side right -fill y
- pack [text .dbg.tx -height 10 -bd 2 -relief groove -wrap word \
- -yscrollcommand ".dbg.scroll set"] \
- -expand 1 -fill both
- .dbg.tx yview moveto 1
-}
-proc do_debug {s} {
- if {$::ddebug} {
- puts stderr $s
- .dbg.tx configure -state normal
- .dbg.tx insert end "$s\n"
+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]
}
+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
@@ -81,7 +121,7 @@
}
proc read_err {} {
- do_debug "read_err"
+ #do_debug "read_err"
set len 0
while 1 {
set len [chan gets $::err l]
@@ -88,7 +128,7 @@
if {$len >= 0} {
lappend ::err_log $l
} else {
- return
+ break
}
}
}
@@ -100,117 +140,101 @@
# EOF is indicated by a return value of -1.
proc read_line {} {
+ incr ::lnum
set l "" ; # will contain the line to be read
if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} {
do_debug "read_line: failing to read"
catch {chan close $::tlshl}
err_exit
+ # note. the right way to terminate is terminating the shell
} elseif {$len >= 0} {
# do_debug "read: $l"
if {[string first $::prmpt $l] == 0} {
# prompt line: done with command
+ enable_widgets 1
read_err
- enable_widgets 1
- $::pipe_cb "finish"
+ if {$::pipe_cb ne ""} {
+ do_debug "$::lnum: prompt found, $l"
+ $::pipe_cb "finish"
+ }
} else {
lappend ::out_log $l
- $::pipe_cb "line" "$l"
+ if {$::pipe_cb ne ""} {$::pipe_cb "line" "$l"}
}
}
-}
+} ; # read_line
-proc show_err {} {
- do_debug "show_err"
- .err.tx configure -state normal
- .err.tx delete 1.0 end
+# copy error strings to error 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"
+ .lw.err.tx configure -state normal
+ .lw.err.tx delete 1.0 end
if {[llength $::err_log] > 0} {
- foreach l $::err_log {.err.tx insert end "$l\n"}
- .err.tx yview moveto 1
- .logs select .err
+ foreach l $::err_log {.lw.err.tx insert end "$l\n"}
+ .lw.err.tx yview moveto 1
+ .lw.logs select .lw.err
}
if {$::tcl_platform(os) ne "Darwin"} {
# os x: text widget disabled => no selection possible
- .err.tx configure -state disabled
+ .lw.err.tx configure -state disabled
}
-}
+} ; # show_err_log
-proc focus_popup {it} {
- set ::pipe_cb package_popup_cb
- run_cmd "info $it"
+# package info popup for the package having focus
+proc popup_focused {itm} {
+ run_cmd "info $itm" package_popup_cb
}
-set mrk [format %c 9635] ; # black square, in decimal
-set nomrk [format %c 9633] ; # white square, in decimal
+# 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 toggle_marked {it cl} {
+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 $it] {
- .pkglist tag remove marked $it
- .pkglist set $it mk $::nomrk
+ if [.pkglist tag has marked $itm] {
+ .pkglist tag remove marked $itm
+ .pkglist set $itm mk $::nomrk
} else {
- .pkglist tag add marked $it
- .pkglist set $it mk $::mrk
+ .pkglist tag add marked $itm
+ .pkglist set $itm mk $::mrk
}
-}
+} ; # toggle_marked
-# combined display of local and remote package database information
-# in treeview widget
+##### callbacks for file events of tlmgr pipe ::tlshl (names *_cb) #####
-#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 ""}} {}
-
-set pipe_cb empty_cb
-
-## template for non-empty pipe callback:
+## template for pipe callback:
#proc template_cb {mode {l ""}} {
# if {$mode eq "line"} {
# # do something
@@ -224,20 +248,27 @@
# }
#}
+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"} {
- .log.tx configure -state normal
- .log.tx insert end "$l\n"
+ .lw.log.tx configure -state normal
+ .lw.log.tx insert end "$l\n"
} elseif {$mode eq "init"} {
- .log.tx configure -state normal
- .log.tx delete 1.0 end
+ .lw.log.tx configure -state normal
+ .lw.log.tx delete 1.0 end
} elseif {$mode eq "finish"} {
- .log.tx yview moveto 1
- .logs select .log
+ .lw.log.tx yview moveto 1
+ .lw.logs select .lw.log
# error log on top if it contains anything
- show_err
+ show_err_log
if {$::tcl_platform(os) ne "Darwin"} {
- .log.tx configure -state disabled
+ .lw.log.tx configure -state disabled
}
.ent.e configure -state normal
} else {
@@ -247,29 +278,40 @@
} ; # 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"} {
- set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$}
- if {[regexp $re $l m pname lrev rrev catg pdescr]} {
- # do_debug "Match: $pname -- $lrev -- $rrev -- $catg -- $pdescr"
+ #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 "lrev" $lrev "rrev" $rrev "category" $catg shortdesc $pdescr]
- if {$lrev == 0} { set lrev {}}
- .pkglist insert {} end -id $pname -values \
- [list $::nomrk $pname $lrev $rrev $pdescr]
+ [list "localrev" $lrev "remoterev" $rrev \
+ "category" $catg shortdesc $pdescr]
} else {
- do_debug "No match: $l"
+ #do_debug "$::lnum no match: $l"
}
return
} elseif {$mode eq "init"} {
- # is this useful? or will the garbage collector take care of it?
- foreach nm [dict keys $::pkgs] {dict set ::pkgs $nm {}}
- set ::pkgs {}
+ # 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"
@@ -277,54 +319,6 @@
}
} ; # packages_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"]
@@ -333,15 +327,16 @@
# procs involving running tlmgr commands #########################
-proc run_cmd {cmd} {
+proc run_cmd {cmd {cb ""}} {
+ set ::pipe_cb $cb
do_debug "run_cmd \"$cmd\""
enable_widgets 0
set ::out_log {}
set ::err_log {}
- $::pipe_cb "init"
+ set ::lnum 0
+ if {$::pipe_cb ne ""} {$::pipe_cb "init"}
chan puts $::tlshl $cmd
chan flush $::tlshl
- do_debug "puts and flush"
}
proc run_entry {} {
@@ -351,44 +346,92 @@
if {$cmd eq ""} return
do_debug $cmd
.ent.e delete 0 end
- .ent.prv configure -text $cmd
- .ent.e configure -state disabled
- set ::pipe_cb log_widget_cb
- run_cmd $cmd
+ #.ent.prv configure -text $cmd
+ run_cmd $cmd log_widget_cb
}
-proc package_popup {it} {
- # tk_messageBox -message $it
- set ::pipe_cb package_popup_cb
- run_cmd "info $it"
+proc package_popup {itm} {
+ # tk_messageBox -message $itm
+ run_cmd "info $itm" package_popup_cb
}
-# $db should be either local or remote
-if 0 {
-proc dump_db {db} {
- do_debug "reading $db"
- set ::pkgs pkgs_$db
- set ::pipe_cb dump_db_cb
- run_cmd "dump-tlpdb --$db"
+# 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
+ }
}
-}
-# complete package list
-proc list_packages {} {
- set ::pipe_cb packages_cb
- run_cmd "info --data name,localrev,remoterev,category,shortdesc"
-}
+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
+ }
+} ; # show_local_packages
+
+proc show_collections {} {
+ set ::filt filt_collections
+ if {! $::have_remote} {
+ set ::do_remote 1
+ get_and_display_packages
+ } else {
+ display_packages
+ }
+} ; # show_collections
+
+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
+ }
+} ; # show_upgradable
+
# (re)initialization procs ############################
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
- set ::pipe_cb empty_cb
+ vwait ::started
+ show_local_packages
}
proc restart_self {} {
@@ -406,6 +449,19 @@
exit
}
+# dummy widgets for vertical spacing
+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 make_widgets {} {
wm title . "$::progname $::procid"
@@ -413,39 +469,44 @@
# width of '0', as a rough estimate of 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 [label .more -justify left -text "Buttons (more to come)"] \
- -in .buttons -column 0 -columnspan 3 -row 0 -sticky w
grid [ttk::button .pkgl -text "Show all packages" \
- -command list_packages] \
- -in .buttons -column 0 -row 1 -sticky w
- if 0 {
+ -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 {dump_db local}] \
- -in .buttons -column 0 -row 1 -sticky w
- grid [ttk::button .remotes -text "Show all packages" \
- -command {dump_db remote}] \
- -in .buttons -column 1 -row 1 -sticky w
- }
- pack .buttons -side top -fill x -expand 1
+ -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
# command entry
+ spacing .
frame .ent
- grid [label .ent.l -text "Type command:" -justify left] -row 0 -column 0 \
- -sticky w
- grid [ttk::button .ent.b -text Run -command run_entry] \
- -row 0 -column 2 -sticky w
- grid [entry .ent.e -width 20] -row 0 -column 1 -sticky ew
+ 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
bind .ent.e <Return> run_entry
- 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
- grid [label .ent.busy -justify right -textvariable ::busy] \
- -row 1 -column 2
- grid columnconfigure .ent 1 -weight 1
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
+
# packages list (tlmgrgui uses an old HList widget)
+ spacing .
frame .fpkg
ttk::treeview .pkglist -columns \
{mk name localrev remoterev shortdesc} \
@@ -469,56 +530,73 @@
grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew
grid columnconfigure .fpkg 0 -weight 1
pack .fpkg -side top -expand 1
+
bind .pkglist <space> {toggle_marked [.pkglist focus] "#1"}
bind .pkglist <Return> {toggle_marked [.pkglist focus] "#1"}
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]}
+ {popup_focused [.pkglist identify item %x %y]}
bind .pkglist <ButtonRelease-2> \
- {focus_popup [.pkglist identify item %x %y]}
+ {popup_focused [.pkglist identify item %x %y]}
bind .pkglist <ButtonRelease-3> \
- {focus_popup [.pkglist identify item %x %y]}
+ {popup_focused [.pkglist identify item %x %y]}
bind .pkglist <Control-ButtonRelease-1> \
- {focus_popup [.pkglist identify item %x %y]}
+ {popup_focused [.pkglist identify item %x %y]}
- # log displays
- frame .log
- pack [ttk::scrollbar .log.scroll -command ".log.tx yview"] \
+ # 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
+ ttk::button .showlogs -text "Show logs" -command {wm state .lw normal}
+ pack .showlogs -in .endbuttons -side right -padx 3
+ pack .endbuttons -side bottom -fill x -expand 1
+
+ # log displays: new toplevel
+ toplevel .lw
+ frame .lw.log
+ pack [ttk::scrollbar .lw.log.scroll -command ".lw.log.tx yview"] \
-side right -fill y
- pack [text .log.tx -height 10 -bd 2 -relief groove -wrap word \
- -yscrollcommand ".log.scroll set"] \
+ pack [text .lw.log.tx -height 10 -bd 2 -relief groove -wrap word \
+ -yscrollcommand ".lw.log.scroll set"] \
-expand 1 -fill both
- .log.tx yview moveto 1
+ .lw.log.tx yview moveto 1
- frame .err
- pack [ttk::scrollbar .err.scroll -command ".err.tx yview"] \
+ frame .lw.err
+ pack [ttk::scrollbar .lw.err.scroll -command ".lw.err.tx yview"] \
-side right -fill y
- pack [text .err.tx -height 10 -bd 2 -relief groove -wrap word \
- -yscrollcommand ".err.scroll set"] \
+ pack [text .lw.err.tx -height 10 -bd 2 -relief groove -wrap word \
+ -yscrollcommand ".lw.err.scroll set"] \
-expand 1 -fill both
- .err.tx yview moveto 1
+ .lw.err.tx yview moveto 1
- # .dbg notbook tab created early on
+ if $::ddebug {
+ 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 \
+ -yscrollcommand ".lw.dbg.scroll set"] \
+ -expand 1 -fill both
+ .lw.dbg.tx yview moveto 1
+ }
- ttk::notebook .logs
- .logs add .log -text "Output"
- .logs add .err -text "Errors"
+ ttk::notebook .lw.logs
+ .lw.logs add .lw.log -text "Output"
+ .lw.logs add .lw.err -text "Errors"
if $::ddebug {
- .logs add .dbg -text "Debug"
- raise .dbg .logs
+ .lw.logs add .lw.dbg -text "Debug"
+ raise .lw.dbg .lw.logs
}
- raise .err .logs
- raise .log .logs
- pack .logs -side top -fill x -expand 1 -padx 3 -pady 6
+ raise .lw.err .lw.logs
+ raise .lw.log .lw.logs
+ pack .lw.logs -in .lw -side top -fill both -expand 1 -padx 3
- # finally...
- frame .endbuttons
- pack [ttk::button .q -text Quit -command exit] \
- -in .endbuttons -side right
- pack [ttk::button .r -text "Restart self" -command restart_self] \
- -in .endbuttons -side right
- pack .endbuttons -side bottom -fill x -expand 1
+ ttk::button .lw.close -text close -command {wm withdraw .lw}
+ pack .lw.close -side bottom -anchor e -padx 3 -pady 3
+
+ wm withdraw .lw
} ; # make_widgets
proc enable_widgets {yesno} {
@@ -542,6 +620,7 @@
# final buttons
.q configure -state $ttk_st
.r configure -state $ttk_st
+ .showlogs configure -state $ttk_st
} ; # enable_widgets
proc initialize {} {
Modified: trunk/Master/tlpkg/tlpsrc/tlshell.tlpsrc
===================================================================
--- trunk/Master/tlpkg/tlpsrc/tlshell.tlpsrc 2017-09-07 11:22:02 UTC (rev 45238)
+++ trunk/Master/tlpkg/tlpsrc/tlshell.tlpsrc 2017-09-07 20:09:36 UTC (rev 45239)
@@ -1 +1,2 @@
+docpattern d texmf-dist/doc/support/tlshell
binpattern f bin/${ARCH}/${PKGNAME}
More information about the tex-live-commits
mailing list