texlive[45667] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Package
commits+siepo at tug.org
commits+siepo at tug.org
Wed Nov 1 22:09:04 CET 2017
Revision: 45667
http://tug.org/svn/texlive?view=revision&revision=45667
Author: siepo
Date: 2017-11-01 22:09:04 +0100 (Wed, 01 Nov 2017)
Log Message:
-----------
Package popup menus and rudimentary global menu
Modified Paths:
--------------
trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-11-01 15:50:11 UTC (rev 45666)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-11-01 21:09:04 UTC (rev 45667)
@@ -20,6 +20,17 @@
# security: disable send
catch {rename send {}}
+# menus: disable tearoff feature
+option add *Menu.tearOff 0
+
+if {$::tcl_platform(platform) eq "unix" && \
+ $::tcl_platform(os) ne "Darwin"} {
+ set plain_unix 1
+} else {
+ set plain_unix 0
+}
+
+set test {}
set ddebug 0
proc do_debug {s} {
if {$::ddebug} {
@@ -86,6 +97,11 @@
set n_updates 0
set tlshell_updatable 0
+## data to be displayed ##
+
+# sorted display data for packages
+set filtered [dict create]
+
# selecting packages for display
set stat_opt "inst"
set dtl_opt "all"
@@ -129,7 +145,6 @@
# 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
if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} {
do_debug "read_line: failing to read"
@@ -145,7 +160,7 @@
enable_widgets 1 ; # this may have to be redone later
read_err
if {$::pipe_cb ne ""} {
- do_debug "$::lnum: prompt found, $l"
+ do_debug "prompt found, $l"
$::pipe_cb "finish"
}
# for vwait:
@@ -182,8 +197,11 @@
# callback for reading tlmgr pipe
set pipe_cb ""
-set lnum -1
+# but maybe we just want a boolean whether or not to write
+# to the logs notebook.
+# consider writing log to file, always or on demand
+
## template for pipe callback:
#proc template_cb {mode {l ""}} {
# if {$mode eq "line"} {
@@ -205,9 +223,11 @@
} elseif {$mode eq "init"} {
.lw.log.tx configure -state normal
.lw.log.tx delete 1.0 end
+ .lw.err.tx delete 1.0 end
.lw.status configure -text "Running"
.lw.close configure -state disabled
wm state .lw normal
+ wm deiconify .lw ;# also raises the window
} elseif {$mode eq "finish"} {
.lw.log.tx yview moveto 1
.lw.logs select .lw.log
@@ -236,7 +256,6 @@
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
@@ -267,8 +286,45 @@
}
} ; # get_repo
-## package-related:
+## package-related: what invokes what?
+# The 'globals' are:
+
+# ::have_remote is initialized to false. It is set to true by
+# get_packages_info_remote, and remains true.
+
+# The other globals ones are ::n_updates, ::need_update_tlmgr and
+# ::tlshell_updatable. These are initially set to 0 and re-calculated
+# by update_globals.
+
+# update_globals is invoked by get_packages_info_remote and
+# update_local_revnumbers. It enables and disables buttons as appropriate.
+
+# displayed global status info is updated by update_globals.
+# update button states are set at initialization and updated
+# by update_globals, both via the enable_update_buttons proc
+
+# get_packages_info_local is invoked only once, at initialization. After
+# installations and removals, the collected information is corrected by
+# update_local_revnumbers.
+
+# get_packages_info_remote will be invoked by collect_filtered if
+# ::have_remote is false. Afterwards, ::have_remote will be true, and
+# therefore get_packages_info_remote will not be called again.
+# get_packages_info_remote invokes update_globals.
+
+# update_local_revnumbers will be invoked after any updates. It also
+# invokes update_globals.
+
+# collect_filtered does not only filter, but also organize the
+# information to be displayed. If necessary, it invokes
+# get_packages_info_remote and always invokes display_packes_info.
+# It is invoked at initialization, when filtering options change and
+# at the end of install-, remove- and update procs.
+
+# display_packages_info is mostly invoked by collect_filtered, but
+# also when the search term or the search option changes.
+
proc check_tlmgr_updatable {} {
run_cmd_waiting "update --self --list"
foreach l $::out_log {
@@ -296,15 +352,145 @@
}
check_tlmgr_updatable
set ::tlshell_updatable [is_updatable tlshell]
+
+ # also update displayed status info
+ if {$::have_remote && $::need_update_tlmgr} {
+ .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
}
-# get fresh package list
+# display packages: have columns for both local and remote revision numbers.
+# ::pkgs should already be up to date
+
+# I added a field 'marked' to ::pkgs. It is displayed in the first treeview
+# column. Treeview tags are not involved.
+
+proc mark_sym {mrk} {
+ if $mrk {
+ return "\u25A3" ; # 'white square containing black small square'
+ } else {
+ return "\u25A1" ; # 'white square'
+ }
+} ; # mark_sym
+
+proc toggle_marked {itm cl} {
+ # toggle_marked is triggered by a mouse click only in column #1.
+ # 'marked' should get updated in ::pkgs, ::filtered and in .pkglist.
+
+ if {$cl ne "#1"} {
+ return
+ }
+ # $mrk: negation of current value of marked for $itm
+ set mrk [expr [dict get $::pkgs $itm "marked"] ? 0 : 1]
+ dict set ::pkgs $itm "marked" $mrk
+ dict set ::filtered $itm [lreplace [dict get $::filtered $itm] 0 0 $mrk]
+ .pkglist set $itm mk [mark_sym $mrk]
+} ; # toggle_marked
+
+proc mark_all {m} {
+ foreach nm [dict keys $::pkgs] {
+ dict set ::pkgs $nm "marked" $m
+ }
+ foreach nm [dict keys $::filtered] {
+ dict set ::filtered $nm [lreplace [dict get $::filtered $nm] 0 0 $m]
+ }
+ foreach nm [.pkglist children {}] {
+ .pkglist set $nm mk [mark_sym $m]
+ }
+ # alternatively: regenerate ::filtered and .pkglist from ::pkgs
+}
+
+# (re)create ::filtered dictionary; disregard search string
+proc collect_filtered {} {
+ do_debug \
+ "collect_filtered for $::stat_opt and $::dtl_opt"
+ if {$::stat_opt ne "inst" && ! $::have_remote} {
+ get_packages_info_remote
+ }
+ foreach nm [dict keys $::filtered] {
+ dict unset ::filtered $nm
+ }
+ foreach nm [lsort [dict keys $::pkgs]] {
+ set pk [dict get $::pkgs $nm]
+ set do_show 1
+ set mrk [mark_sym [dict get $pk marked]]
+ set lr [dict get $pk localrev]
+ set rr [dict get $pk remoterev]
+ set ct [dict get $pk category]
+ if {$::stat_opt eq "inst" && $lr == 0} {
+ set do_show 0
+ } elseif {$::stat_opt eq "upd" && ($lr == 0 || $rr == 0 || $rr <= $lr)} {
+ set do_show 0
+ }
+ if {! $do_show} continue
+ if {$::dtl_opt eq "schm" && $ct ne "Scheme"} {
+ set do_show 0
+ } elseif {$::dtl_opt eq "coll" && \
+ $ct ne "Scheme" && $ct ne "Collection"} {
+ set do_show 0
+ }
+ if {! $do_show} continue
+
+ # collect data to be displayed for $nm
+ dict lappend ::filtered $nm $mrk
+ 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]
+ }
+ display_packages_info
+} ; # collect_filtered
+
+# display packages obeying filter and search string.
+# even on a relatively slow system, regenerating the entire list
+# at every keystroke is acceptably responsive.
+# with future more advanced search options, this scheme may not suffice.
+
+proc display_packages_info {} {
+ do_debug [get_stacktrace]
+ set curr [.pksearch.e get]
+ .pkglist delete [.pkglist children {}]
+ dict for {nm pk} $::filtered {
+ set do_show 0
+ if {$curr eq ""} {
+ set do_show 1
+ } elseif {[search_nocase $curr $nm] >= 0} {
+ set do_show 1
+ } elseif {$::search_desc && \
+ [search_nocase $curr [dict get $::pkgs $nm shortdesc]] >= 0} {
+ set do_show 1
+ }
+ if $do_show {
+ .pkglist insert {} end -id $nm -values $pk
+ }
+ }
+} ; # display_packages_info
+
+proc toggle_search_desc {} {
+ # when this proc is called, ::search_desc is not yet toggled
+ # so we temporarily pre-toggle and post-untoggle it
+ set ::search_desc [expr $::search_desc ? 0 : 1]
+ display_packages_info
+ set ::search_desc [expr $::search_desc ? 0 : 1]
+}
+
+# get fresh package list, invoked at program start
# 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
-# local: start from scratch
proc get_packages_info_local {} {
+ # start from scratch
foreach nm [dict keys $::pkgs] {
dict unset ::pkgs $nm
}
@@ -318,13 +504,13 @@
set re {^([^,]+),([0-9]+),([^,]*),(.*)$}
foreach l $::out_log {
if [regexp $re $l m nm lrev catg pdescr] {
- # double-quotes: remove outer, unescape inner
+ # 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 "\""]
+ set pdescr [string map {\\\" \"} $pdescr]
dict set ::pkgs $nm \
- [list "localrev" $lrev "remoterev" 0 \
+ [list "marked" 0 "localrev" $lrev "remoterev" 0 \
"category" $catg shortdesc $pdescr]
}
}
@@ -350,16 +536,14 @@
if {[string index $pdescr 0] eq "\""} {
set pdescr [string range $pdescr 1 end-1]
}
- set pdescr [regsub -all "\\\"" $pdescr "\""]
+ set pdescr [string map {\\\" \"} $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
+ dict set ::pkgs $nm [dict create "marked" 0 "localrev" 0]
}
+ dict set ::pkgs $nm "remoterev" $rrev
+ dict set ::pkgs $nm "category" $catg
+ dict set ::pkgs $nm "shortdesc" $pdescr
}
}
set ::have_remote 1
@@ -366,9 +550,7 @@
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
+## update ::pkgs after installing packages without going online again.
proc update_local_revnumbers {} {
run_cmd_waiting "info --only-installed --data name,localrev"
set re {^([^,]+),([0-9]+)$}
@@ -390,10 +572,9 @@
}
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
+ # tlmgr restarts itself automatically
+ update_local_revnumbers
+ collect_filtered
} ; # update_tlmgr
proc update_all {} {
@@ -408,8 +589,7 @@
vwait ::done_waiting
#wm withdraw .lw
update_local_revnumbers
- set ::sel_opt "inst"
- display_packages_info
+ collect_filtered
} ; # update_all
##### building GUI #####
@@ -429,6 +609,17 @@
pack $wdg {*}$args -padx 3 -pady 3
}
+# deal with MacOS platform differences
+if {[tk windowingsystem] eq "aqua"} {
+ event add <<RightClick>> <Button-2> <Control-Button-1>
+} else {
+ event add <<RightClick>> <Button-3>
+}
+
+proc notyet {} {
+ tk_messageBox -message "Not yet implemented"
+}
+
proc make_widgets {} {
wm title . "$::progname $::procid"
@@ -436,6 +627,49 @@
# width of '0', as a rough estimate of average character width
set cw [font measure TkTextFont "0"]
+ # menu
+ menu .mn
+ . configure -menu .mn
+
+ # set ::default_bg white ;# only used for ::plain_unix
+ if [catch {ttk::style lookup TFrame -background} ::default_bg] {
+ set ::default_bg white
+ }
+ if $::plain_unix {
+ .mn configure -borderwidth 1
+ .mn configure -background $::default_bg
+ }
+
+ .mn add cascade -label File -menu .mn.file -underline 0
+ menu .mn.file
+ .mn.file add command -label "Load default repository" \
+ -command notyet
+ .mn.file add command -label "Load default net repository" \
+ -command notyet
+ .mn.file add command -label "Load another repository" \
+ -command notyet
+ .mn.file add command -command exit -label "Exit" -underline 1
+
+ .mn add cascade -label Options -menu .mn.opt -underline 0
+ menu .mn.opt
+
+ .mn add cascade -label Actions -menu .mn.act -underline 0
+ menu .mn.act
+
+ if 1 {
+ .mn add cascade -label Styles -menu .mn.sty -underline 0
+ menu .mn.sty
+ foreach st [ttk::style theme names] {
+ .mn.sty add command -command "ttk::style theme use $st" \
+ -label "Style $st"
+ }
+ }
+
+ .mn add cascade -label Help -menu .mn.help -underline 0
+ menu .mn.help
+ .mn.help add command -command {tk_messageBox -message "Helpless"} \
+ -label "About"
+
# encompassing themed frame to guarantee a uniform background
pack [ttk::frame .bg]
@@ -447,7 +681,7 @@
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
+ ttk::label .topf.luptodate -text "Unknown" -anchor w
pgrid .topf.luptodate -row 1 -column 1
pgrid [ttk::label .topf.llcmd -anchor w -text "Last tlmgr command: "] \
@@ -461,7 +695,7 @@
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_tlmgr
+ ttk::button .butf.self -text "Update tlmgr" -command update_tlmgr
.butf.self configure -state disabled
ppack .butf.self -side left
pack .butf -in .bg -side top -anchor w
@@ -486,11 +720,11 @@
# filter on status: inst, all, upd
ttk::label .pkfilter.lstat -font TkHeadingFont -text "Status"
ttk::radiobutton .pkfilter.inst -text Installed -value inst \
- -variable ::stat_opt -command show_packages_info
+ -variable ::stat_opt -command collect_filtered
ttk::radiobutton .pkfilter.alls -text All -value all \
- -variable ::stat_opt -command show_packages_info
+ -variable ::stat_opt -command collect_filtered
ttk::radiobutton .pkfilter.upd -text Updatable -value upd \
- -variable ::stat_opt -command show_packages_info
+ -variable ::stat_opt -command collect_filtered
grid .pkfilter.lstat -column 0 -row 0 -sticky w -padx {3 50}
pgrid .pkfilter.inst -column 0 -row 1 -sticky w
pgrid .pkfilter.alls -column 0 -row 2 -sticky w
@@ -499,36 +733,42 @@
# filter on detail level: all, coll, schm
ttk::label .pkfilter.ldtl -font TkHeadingFont -text "Detail > Global"
ttk::radiobutton .pkfilter.alld -text All -value all \
- -variable ::dtl_opt -command show_packages_info
+ -variable ::dtl_opt -command collect_filtered
ttk::radiobutton .pkfilter.coll -text "Collections and schemes" -value coll \
- -variable ::dtl_opt -command show_packages_info
+ -variable ::dtl_opt -command collect_filtered
ttk::radiobutton .pkfilter.schm -text "Only schemes" -value schm \
- -variable ::dtl_opt -command show_packages_info
+ -variable ::dtl_opt -command collect_filtered
pgrid .pkfilter.ldtl -column 1 -row 0 -sticky w
pgrid .pkfilter.alld -column 1 -row 1 -sticky w
pgrid .pkfilter.coll -column 1 -row 2 -sticky w
pgrid .pkfilter.schm -column 1 -row 3 -sticky w
+ # marks
+ grid [ttk::button .mrk_all -text "Mark all" -command {mark_all 1}] \
+ -in .pkfilter -column 2 -row 1 -sticky w -padx {50 3}
+ grid [ttk::button .mrk_none -text "Mark none" -command {mark_all 0}] \
+ -in .pkfilter -column 2 -row 2 -sticky w -padx {50 3}
+
pack .pkfilter -in .bg -side top -fill x
- # search
+ # search interface
ttk::frame .pksearch
ppack [ttk::label .pksearch.l \
-text "Search package names"] \
-side left
pack [ttk::entry .pksearch.e -width 30] -side left -padx {3 0} -pady 3
- # cancel search: \u2A2F is vector or cross product
+ # cancel search: \u2A2F is 'vector or cross product'
pack [button .pksearch.can -text "\u2A2F" -padx 3 -pady 0 -borderwidth 0 \
-command {.pksearch.e delete 0 end}] -side left -padx {0 6}
.pksearch.can configure -command \
- {.pksearch.e delete 0 end; show_packages_info}
+ {.pksearch.e delete 0 end; display_packages_info}
ppack [ttk::checkbutton .pksearch.d -variable ::search_desc \
-text "Also search short descriptions"] -side left
pack .pksearch -in .bg -side top -fill x -expand 1
- bind .pksearch.e <KeyRelease> {+display_packages_info}
- bind .pksearch.d <ButtonRelease> {+toggle_search_desc}
+ bind .pksearch.e <KeyRelease> display_packages_info
+ bind .pksearch.d <ButtonRelease> toggle_search_desc
- # packages list (tlmgrgui uses an old HList widget)
+ # packages list
ttk::frame .fpkg
ttk::treeview .pkglist -columns \
{mk name localrev remoterev shortdesc} \
@@ -553,19 +793,19 @@
grid columnconfigure .fpkg 0 -weight 1
pack .fpkg -in .bg -side top -expand 1
+ # "#1" refers to the first column (with mark symbols)
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> \
- {popup_focused [.pkglist identify item %x %y]}
- bind .pkglist <ButtonRelease-2> \
- {popup_focused [.pkglist identify item %x %y]}
- bind .pkglist <ButtonRelease-3> \
- {popup_focused [.pkglist identify item %x %y]}
- bind .pkglist <Control-ButtonRelease-1> \
- {popup_focused [.pkglist identify item %x %y]}
+ # only toggle when column is "#1"
+ bind .pkglist <ButtonRelease-1> \
+ {toggle_marked \
+ [.pkglist identify item %x %y] \
+ [.pkglist identify column %x %y]}
+ menu .pkg_popup ; # entries added on-the-fly
+ bind .pkglist <<RightClick>> \
+ {do_package_popup %x %y %X %Y}
+
# bottom of main window
ttk::frame .endbuttons
ttk::label .busy -textvariable ::busy -font TkHeadingFont -anchor w
@@ -631,6 +871,47 @@
wm withdraw .lw
} ; # make_widgets
+## package popup ##
+
+proc run_package_cmd {cmd {chg 0}} {
+ set mn [.pkglist focus]
+ run_cmd "$cmd $mn" log_widget_cb
+ vwait ::done_waiting
+ if $chg {
+ do_debug "Package_cmd $cmd; should call update_local_revnumbers"
+ update_local_revnumbers
+ collect_filtered
+ }
+} ; # run_package_cmd
+
+proc do_package_popup {x y X Y} {
+ # as focused item, the identity of the item will be globally available:
+ .pkglist focus [.pkglist identify item $x $y]
+ # recreate menu with only applicable items
+ set lr [dict get $::pkgs [.pkglist focus] "localrev"]
+ set rr [dict get $::pkgs [.pkglist focus] "remoterev"]
+ .pkg_popup delete 0 end
+ .pkg_popup add command -label "Info" -command \
+ {run_package_cmd "info"}
+ if {$::have_remote && ! $::need_update_tlmgr && $rr > 0 && $lr == 0} {
+ .pkg_popup add command -label "Install" -command \
+ {run_package_cmd "install" 1}
+ }
+ if {$::have_remote && ! $::need_update_tlmgr && $rr > $lr} {
+ .pkg_popup add command -label "Update" -command \
+ {run_package_cmd "update" 1}
+ }
+ if {$lr > 0} {
+ .pkg_popup add command -label "Remove" -command \
+ {run_package_cmd "remove" 1}
+ }
+ #tk_popup .pkg_popup $X $Y
+ # tk_popup will generate a RenderBadPicture error
+ # when tlshell terminates so we do something else:
+ .pkg_popup post $X $Y
+ focus .pkg_popup
+} ; # do_package_popup
+
proc enable_update_buttons {yesno} {
if {! $yesno || ! $::n_updates} {
.butf.all configure -state disabled
@@ -645,6 +926,8 @@
}
proc enable_widgets {yesno} {
+ enable_update_buttons $yesno
+
if $yesno {
set st normal
set ttk_st !disabled
@@ -655,8 +938,6 @@
set ::busy "BUSY"
}
- enable_update_buttons $yesno
-
# command entry
.ent.b configure -state $st
.ent.e configure -state $st
@@ -675,152 +956,6 @@
}
} ; # enable_widgets
-## single-package info ##
-
-proc popup_focused {itm} {
- run_cmd_waiting "info $itm"
- tk_messageBox -message [join $::out_log "\n"]
-}
-
-## data to be displayed ##
-
-# sorted display data for packages to be displayed
-set filtered [dict create]
-# matching package names
-
-## 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 "\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"
-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
-
-# display packages: always display both local and remote revision columns.
-# ::pkgs should already be up to date
-
-# (re)create ::filtered dictionary; disregard search string
-proc initialize_display_info {} {
- do_debug \
- "initialize_packages_info for $::stat_opt and $::dtl_opt"
- foreach nm [lsort [dict keys $::filtered]] {
- dict unset ::filtered $nm
- }
- foreach nm [lsort [dict keys $::pkgs]] {
- set pk [dict get $::pkgs $nm]
- set do_show 1
- set lr [dict get $pk localrev]
- set rr [dict get $pk remoterev]
- set ct [dict get $pk category]
- if {$::stat_opt eq "inst" && $lr == 0} {
- set do_show 0
- } elseif {$::stat_opt eq "upd" && ($lr == 0 || $rr == 0 || $rr <= $lr)} {
- set do_show 0
- }
- if {! $do_show} continue
- if {$::dtl_opt eq "schm" && $ct ne "Scheme"} {
- set do_show 0
- } elseif {$::dtl_opt eq "coll" && \
- $ct ne "Scheme" && $ct ne "Collection"} {
- set do_show 0
- }
- if {! $do_show} continue
-
- # 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]
- }
-} ; # initialize_display_info
-
-# display packages obeying filter and search string
-# even on a relatively slow system, regenerating the entire list
-# at every keystroke is acceptably responsive
-proc display_packages_info {} {
- set curr [.pksearch.e get]
- .pkglist delete [.pkglist children {}]
- dict for {nm pk} $::filtered {
- set do_show 0
- if {$curr eq ""} {
- set do_show 1
- } elseif {[search_nocase $curr $nm] >= 0} {
- set do_show 1
- } elseif {$::search_desc && \
- [search_nocase $curr [dict get $::pkgs $nm shortdesc]] >= 0} {
- set do_show 1
- }
- if $do_show {
- .pkglist insert {} end -id $nm -values $pk
- }
- }
-
- # also update displayed status info
- if {$::have_remote && $::need_update_tlmgr} {
- .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
-
-proc toggle_search_desc {} {
- # when this proc is called, ::search_desc is not yet toggled
- # so we temporarily toggle and untoggle it
- set ::search_desc [expr $::search_desc ? 0 : 1]
- display_packages_info
- set ::search_desc [expr $::search_desc ? 0 : 1]
-}
-
-# 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 {} {
- # first, reset search
- #.pksearch.e delete 0 end
- # make sure requested info is available
- if {! [llength [dict keys $::pkgs]]} {get_packages_info_local}
- if {$::stat_opt ne "inst" && ! $::have_remote} get_packages_info_remote
- # build ::filtered dictionary of info to be displayed
- initialize_display_info
- display_packages_info
-} ; # show_packages_info
-
##### (re)initialization procs #####
proc start_tlmgr {} {
@@ -834,12 +969,6 @@
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 {} {
@@ -846,8 +975,6 @@
catch {chan close $::tlshl}
catch {chan close $::err}
start_tlmgr
- get_packages_info_remote
- display_packages_info
}
proc restart_self {{param ""}} {
@@ -863,7 +990,7 @@
# the old tlshell disappears.
# oh well, windows is still windows....
exit
-}
+} ; # restart_self
proc initialize {} {
# prepend TL to process searchpath (not needed on windows)
@@ -892,9 +1019,6 @@
lappend attemptdirs $::env($tmp)
}
}
- if {$::tcl_platform(os) eq "Darwin"} {
- lappend attemptdirs "/private/tmp"
- }
if {$::tcl_platform(platform) eq "unix"} {
lappend attemptdirs "/tmp"
}
@@ -929,12 +1053,19 @@
set ::flid [open $fname w]
}
+ # add json subdirectory to auto_path, but at low priority
+ # since the tcl/tk installation may already have a better implementation.
+ # Use kpsewhich to find out own directory and bypass symlinks.
+ set tlsdir [file dirname [exec kpsewhich -format texmfscripts tlshell.tcl]]
+ lappend ::auto_path [file join $tlsdir "json"]
+
make_widgets
start_tlmgr
get_repo
- set ::sel_opt "inst"
- show_packages_info
+ get_packages_info_local
+ collect_filtered ; # invokes display_packages_info
+ enable_update_buttons 1
}; # initialize
initialize
More information about the tex-live-commits
mailing list