Fake checkboxes, revised bindings for package list

git-svn-id: svn://tug.org/texlive/trunk@45151 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 130 insertions, 115 deletions

diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 3dc2064ac47..97c4703fc84 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -134,59 +134,76 @@ proc show_err {} {
   }
 }
 
-proc selection_popup {sl} {
-  tk_messageBox -message [join $sl "\n"]
+proc focus_popup {it} {
+  set ::pipe_cb package_popup_cb
+  run_cmd "info $it"
 }
 
-# combined display of local and remote package database information
-# in treeview widget
-if 0 {
-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"
-    }
+set mrk [format %c 9635] ; # black square, in decimal
+set nomrk [format %c 9633] ; # white square, in decimal
+
+proc toggle_marked {it cl} {
+  if {$cl ne "#1"} {
+    return
   }
-  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
+  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
   }
-  update ; # uncomment if necessary
-} ; # display_packages
 }
 
+# combined display of local and remote package database information
+# in treeview widget
+
+#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 ""}} {}
@@ -231,9 +248,6 @@ proc log_widget_cb {mode {l ""}} {
 
 proc packages_cb {mode {l ""}} {
   if {$mode eq "line"} {
-    # .pkglist configure -state normal
-    # set re {^([ i]) ([^: ]+): (.*)$}
-    #set re {^[^,]+,([0-9]+),([0-9]+),([^,]*),(\\\".*\\\")?$}
     set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$}
     if {[regexp $re $l m pname lrev rrev catg pdescr]} {
       # do_debug "Match: $pname -- $lrev -- $rrev -- $catg -- $pdescr"
@@ -245,7 +259,7 @@ proc packages_cb {mode {l ""}} {
           [list "lrev" $lrev "rrev" $rrev "category" $catg shortdesc $pdescr]
       if {$lrev == 0} { set lrev {}}
       .pkglist insert {} end -id $pname -values \
-          [list $pname $lrev $rrev $pdescr]
+          [list $::nomrk $pname $lrev $rrev $pdescr]
     } else {
       do_debug "No match: $l"
     }
@@ -263,55 +277,54 @@ proc packages_cb {mode {l ""}} {
   }
 } ; # packages_cb
 
-if 0 {
-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 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"]
@@ -435,14 +448,15 @@ proc make_widgets {} {
   # packages list (tlmgrgui uses an old HList widget)
   frame .fpkg
   ttk::treeview .pkglist -columns \
-      {name localrev remoterev shortdesc} \
+      {mk name localrev remoterev shortdesc} \
       -show headings -height 8 -selectmode extended \
       -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set}
   foreach \
-      col {name localrev remoterev shortdesc} \
-      nm {Name "Local Rev." "Remote Rev." Description} {
+      col {mk name localrev remoterev shortdesc} \
+      nm {"" Name "Local Rev." "Remote Rev." Description} {
     .pkglist heading $col -text $nm -anchor w
   }
+  .pkglist column mk -width [expr $cw * 3]
   .pkglist column name -width [expr $cw * 25]
   .pkglist column localrev -width [expr $cw * 12]
   .pkglist column remoterev -width [expr $cw * 12]
@@ -455,10 +469,18 @@ 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 <ButtonRelease> {package_popup [.pkglist identify item %x %y]}
-  # focus or selection?
-  bind .pkglist <space> {package_popup [.pkglist focus]}
-  bind .pkglist <Return> {selection_popup [.pkglist selection]}
+  bind .pkglist <space> {toggle_marked [.pkglist focus] mk}
+  bind .pkglist <Return> {toggle_marked [.pkglist focus] mk}
+  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]}
+  bind .pkglist <ButtonRelease-2> \
+      {focus_popup [.pkglist identify item %x %y]}
+  bind .pkglist <ButtonRelease-3> \
+      {focus_popup [.pkglist identify item %x %y]}
+  bind .pkglist <Control-ButtonRelease-1> \
+      {focus_popup [.pkglist identify item %x %y]}
 
   # log displays
   frame .log
@@ -515,14 +537,7 @@ proc enable_widgets {yesno} {
   .ent.b configure -state $st
   .ent.e configure -state $st
   # package list
-  if $yesno {
-    .pkglist configure -takefocus 1
-    bind .pkglist <ButtonRelease> \
-        {package_popup [.pkglist identify item %x %y]}
-  } else {
-    .pkglist configure -takefocus 0
-    bind .pkglist <ButtonRelease> {}
-  }
+  .pkglist state $ttk_st
   # do not touch the log windows
   # final buttons
   .q configure -state $ttk_st