From 3da1ba462c57f8bc7238041c9bbb0c7894cf1f26 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Thu, 7 Sep 2017 20:09:36 +0000 Subject: Some package filtering options; cosmetic changes; README moved to doc/support/tlshell git-svn-id: svn://tug.org/texlive/trunk@45239 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/doc/support/tlshell/README | 7 + Master/texmf-dist/scripts/tlshell/README | 7 - Master/texmf-dist/scripts/tlshell/tlshell.tcl | 583 +++++++++++++++----------- 3 files changed, 338 insertions(+), 259 deletions(-) create mode 100644 Master/texmf-dist/doc/support/tlshell/README delete mode 100644 Master/texmf-dist/scripts/tlshell/README (limited to 'Master/texmf-dist') diff --git a/Master/texmf-dist/doc/support/tlshell/README b/Master/texmf-dist/doc/support/tlshell/README new file mode 100644 index 00000000000..c5691a8e61d --- /dev/null +++ b/Master/texmf-dist/doc/support/tlshell/README @@ -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 diff --git a/Master/texmf-dist/scripts/tlshell/README b/Master/texmf-dist/scripts/tlshell/README deleted file mode 100644 index c5691a8e61d..00000000000 --- a/Master/texmf-dist/scripts/tlshell/README +++ /dev/null @@ -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 diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index 34569910fba..534acb4f1de 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -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 @@ package require Tk # 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 tempsub "" ; # subdirectory for temporary files 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 -set prmpt "tlmgr>" -set busy 0 +# dict of (local and global) package dicts +set pkgs [dict create] -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 +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] } -proc do_debug {s} { - if {$::ddebug} { - puts stderr $s - .dbg.tx configure -state normal - .dbg.tx insert end "$s\n" + +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] } +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,14 +121,14 @@ proc err_exit {} { } proc read_err {} { - do_debug "read_err" + #do_debug "read_err" set len 0 while 1 { set len [chan gets $::err l] if {$len >= 0} { lappend ::err_log $l } else { - return + break } } } @@ -100,117 +140,101 @@ proc read_err {} { # 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 - read_err enable_widgets 1 - $::pipe_cb "finish" + read_err + 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"} } } -} - -proc show_err {} { - do_debug "show_err" - .err.tx configure -state normal - .err.tx delete 1.0 end +} ; # read_line + +# 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} { - if {$cl ne "#1"} { - return - } - if [.pkglist tag has marked $it] { - .pkglist tag remove marked $it - .pkglist set $it mk $::nomrk - } else { - .pkglist tag add marked $it - .pkglist set $it mk $::mrk - } -} +proc display_packages {} { -# combined display of local and remote package database information -# in treeview widget + .pkglist delete [.pkglist children {}] -#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 + 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 ############################ -# callbacks for file events of tlmgr pipe ::tlshl (names *_cb) ### +# 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 empty_cb {mode {l ""}} {} +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 -set pipe_cb empty_cb +##### callbacks for file events of tlmgr pipe ::tlshl (names *_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 @@ set pipe_cb empty_cb # } #} +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 @@ proc log_widget_cb {mode {l ""}} { } ; # log_widget_cb proc packages_cb {mode {l ""}} { - if {$mode eq "line"} { + if $::do_remote { set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$} - if {[regexp $re $l m pname lrev rrev catg pdescr]} { - # do_debug "Match: $pname -- $lrev -- $rrev -- $catg -- $pdescr" + } 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 "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 @@ proc packages_cb {mode {l ""}} { } } ; # 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 @@ proc package_popup_cb {mode {l ""}} { # 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 @@ proc run_entry {} { 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 @@ proc restart_self {} { 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 @@ proc make_widgets {} { # 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 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 @@ proc make_widgets {} { grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew grid columnconfigure .fpkg 0 -weight 1 pack .fpkg -side top -expand 1 + bind .pkglist {toggle_marked [.pkglist focus] "#1"} bind .pkglist {toggle_marked [.pkglist focus] "#1"} bind .pkglist {toggle_marked \ [.pkglist identify item %x %y] [.pkglist identify column %x %y]} bind .pkglist \ - {focus_popup [.pkglist identify item %x %y]} + {popup_focused [.pkglist identify item %x %y]} bind .pkglist \ - {focus_popup [.pkglist identify item %x %y]} + {popup_focused [.pkglist identify item %x %y]} bind .pkglist \ - {focus_popup [.pkglist identify item %x %y]} + {popup_focused [.pkglist identify item %x %y]} bind .pkglist \ - {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 @@ proc enable_widgets {yesno} { # final buttons .q configure -state $ttk_st .r configure -state $ttk_st + .showlogs configure -state $ttk_st } ; # enable_widgets proc initialize {} { -- cgit v1.2.3