From db68c19d73d61abce5221a137db26c40cad226f1 Mon Sep 17 00:00:00 2001 From: Siep Kroonenberg Date: Wed, 1 Nov 2017 21:09:04 +0000 Subject: Package popup menus and rudimentary global menu git-svn-id: svn://tug.org/texlive/trunk@45667 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/scripts/tlshell/tlshell.tcl | 555 ++++++++++++++++---------- 1 file changed, 343 insertions(+), 212 deletions(-) (limited to 'Master/texmf-dist/scripts/tlshell') diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index f4383a2b981..5866e4f5a69 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -20,6 +20,17 @@ package require Tk # 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 need_update_tlmgr 0 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 @@ proc read_err {} { # 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 @@ proc read_line {} { 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,7 +197,10 @@ proc show_err_log {} { # 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 ""}} { @@ -205,9 +223,11 @@ proc log_widget_cb {mode {l ""}} { } 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 @@ proc run_cmd {cmd {cb ""}} { 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,7 +286,44 @@ proc get_repo {} { } } ; # 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" @@ -296,15 +352,145 @@ proc update_globals {} { } 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 @@ proc get_packages_info_local {} { 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,25 +536,21 @@ proc get_packages_info_remote {} { 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 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 @@ proc update_tlmgr {} { } 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 @@ proc update_all {} { 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 @@ proc ppack {wdg args} { ; # pack command with padding pack $wdg {*}$args -padx 3 -pady 3 } +# deal with MacOS platform differences +if {[tk windowingsystem] eq "aqua"} { + event add <> +} else { + event add <> +} + +proc notyet {} { + tk_messageBox -message "Not yet implemented" +} + proc make_widgets {} { wm title . "$::progname $::procid" @@ -436,6 +627,49 @@ proc make_widgets {} { # 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 @@ proc make_widgets {} { 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 @@ proc make_widgets {} { 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 @@ proc make_widgets {} { # 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 @@ proc make_widgets {} { # 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 {+display_packages_info} - bind .pksearch.d {+toggle_search_desc} + bind .pksearch.e display_packages_info + bind .pksearch.d 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,18 +793,18 @@ proc make_widgets {} { 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 {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 \ - {popup_focused [.pkglist identify item %x %y]} - bind .pkglist \ - {popup_focused [.pkglist identify item %x %y]} - bind .pkglist \ - {popup_focused [.pkglist identify item %x %y]} - bind .pkglist \ - {popup_focused [.pkglist identify item %x %y]} + # only toggle when column is "#1" + bind .pkglist \ + {toggle_marked \ + [.pkglist identify item %x %y] \ + [.pkglist identify column %x %y]} + + menu .pkg_popup ; # entries added on-the-fly + bind .pkglist <> \ + {do_package_popup %x %y %X %Y} # bottom of main window ttk::frame .endbuttons @@ -631,6 +871,47 @@ proc make_widgets {} { 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_update_buttons {yesno} { } proc enable_widgets {yesno} { + enable_update_buttons $yesno + if $yesno { set st normal set ttk_st !disabled @@ -655,8 +938,6 @@ proc enable_widgets {yesno} { set ::busy "BUSY" } - enable_update_buttons $yesno - # command entry .ent.b configure -state $st .ent.e configure -state $st @@ -675,152 +956,6 @@ proc enable_widgets {yesno} { } } ; # 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,20 +969,12 @@ proc start_tlmgr {} { 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 ""}} { @@ -863,7 +990,7 @@ proc restart_self {{param ""}} { # 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 @@ proc initialize {} { 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 @@ proc initialize {} { 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 -- cgit v1.2.3