Changeset 567b369 in tol for tolbase

Timestamp:

Feb 9, 2012, 4:09:14 PM (15 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

4c5e200

Parents:

fa037e6

Message:

refs #1424, implementing the menu options to remove packages

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4097 be4846ae-f051-483a-831f-b64e7d08527f

Location:

tolbase/lib/toltk

Files:

• tolpkg.tcl (modified) (1 diff)
• tolpkg_gui.tcl (modified) (12 diffs)

tolbase/lib/toltk/tolpkg.tcl

@@ -222 +222 @@
 }
 
+proc ::TolPkg::RemovePackage { pkg } {
+  set tolexpr [ string map [ list %p ${pkg} ] {
+    Real TolPackage::Client::LocalClean( "%p" )
+  } ]
+  return [ toltcl::eval $tolexpr ]
+}
+
 proc ::TolPkg::RemoteInstall { pkg repo } {
   puts "::TolPkg::RemoteInstall $pkg $repo"

tolbase/lib/toltk/tolpkg_gui.tcl

@@ -550 +550 @@
 }
 
+proc ::TolPkgGUI::lsearchi { i l it } {
+  set _i 0
+  foreach _it $l {
+    if { $it eq [ lindex $_it $i ] } {
+      return $_i
+    }
+  }
+  return -1
+}
+
 proc ::TolPkgGUI::ReadPackSyncInfo { } {
   variable packSyncInfo
@@ -813 +823 @@
   $w add command -label [ mc "Sync with servers" ] \
       -command "::TolPkgGUI::SyncServers"
-  $w add separator
   # preprocess selection of packages
+  # list of new packages available
   set listNEW {}
+  # list of package to remove including all installed versions
+  set listDEL {}
+  # list of individual package selected to remove
+  set listDEL0 {}
+  # list of packages selected needing update
   set listUPD {}
+  # list of packages selected needing upgrade
   set listUPG {}
+  # list of packages selected that can be exported  
   set listEXP {}
   
@@ -823 +840 @@
   foreach nid $selectionInfo(pkg) {
     set pkg [ $T item text $nid 0 ]
+    if { $nodesInfo($nid,status) ne "new" } {
+      lappend listDEL [ list $pkg $nid ]
+    }
     array unset pkgInfo
     if { [ info exists packSyncInfo($pkg) ] } {
@@ -857 +877 @@
       }
     }
+    foreach chId [ $T item children $nid ] {
+      lappend listDEL0 [ list [ $T item text $chId 0 ] $chId ]
+    }
     lappend listEXP [ list $pkgInfo(lastremote) $nodesInfo($nid,status) $nid ]
   }
@@ -864 +887 @@
     switch -exact $nodesInfo($nid,status) {
       "new" {
-        if { [ lsearch $listNEW $pkg ] == -1 } {
+        puts "OJO: he encontrado un estado new en un pkgver $pkg"
+        if { [ lsearchi 0 $listNEW $pkg ] == -1 } {
           lappend listNEW [ list $pkg $nid ]
         }
       }
       "update" {
-        lappend listUPD [ list $pkg $nid ]
+        if { [ lsearchi 0 $listUPD $pkg ] == -1 } {
+          lappend listUPD [ list $pkg $nid ]
+        }
       }
       "ok" {
@@ -877 +903 @@
       }
     }
-    if { [ lsearch $listEXP $pkg ] == -1 } {
+    if { [ lsearchi 0 $listDEL0 $pkg ] == -1 } {
+      lappend listDEL0 [ list $pkg $nid ]
+    }
+    if { [ lsearchi 0 $listEXP $pkg ] == -1 } {
       lappend listEXP [ list $pkg $nodesInfo($nid,status) $nid ]
     }
   }
   # install list
+  $w add separator
   if { [ llength $listNEW ] == 1 } {
     $w add command -label [ mc "Install %s" [ lindex [ lindex $listNEW 0 ] 0 ] ] \
@@ -904 +934 @@
       -state [ EntryState nodesInfo(update) ]
   # upgrade list
+  $w add separator
   if { [ llength $listUPG ] == 1 } {
     $w add command \
@@ -927 +958 @@
   $w add command -label [ mc "Export all" ]... \
       -command [ list ::TolPkgGUI::ExportPackageVersion ]
+  # Remove options
+  $w add separator
+  if { [ llength $listDEL ] == 1 } {
+    set _tmppkg [ lindex [ lindex $listDEL 0 ] 0 ]
+    $w add command \
+        -label [ mc "Remove all %s" $_tmppkg ]... \
+        -command [ list ::TolPkgGUI::RemovePackageVersion $listDEL0 $_tmppkg ]
+  } elseif { [ llength $listDEL0 ] == 1 } {
+    set _tmppkg [ lindex [ lindex $listDEL0 0 ] 0 ]
+    $w add command \
+        -label [ mc "Remove %s" $_tmppkg ]... \
+        -command [ list ::TolPkgGUI::RemovePackageVersion $listDEL0 ]
+  } elseif { [ llength $listDEL0 ] > 1 } {
+    $w add command -label [ mc "Remove selected" ]... \
+        -command [ list ::TolPkgGUI::RemovePackageVersion $listDEL0 ]
+  }  
+  $w add command -label [ mc "Remove all" ]... \
+      -command [ list ::TolPkgGUI::RemovePackageVersion ]
+  
   # SyncInfo import/export
   $w add separator
@@ -1386 +1436 @@
 }
 
+proc ::TolPkgGUI::RemovePackageVersion { { pkgs {} } { matchPkg {} } } {
+  variable installData
+  variable tree
+
+  set removeList {}
+  if { [ llength $pkgs ] } {
+    foreach p $pkgs {
+      set _p [ lindex $p 0 ]
+      if { $matchPkg eq "" || [ regexp "^${matchPkg}\\.(\\d+)\\.(\\d+)\$" \
+                                    $_p ] } {
+        lappend removeList $_p
+      }
+    }
+  } else {
+    Unimplemented "Remove all not implemented yet"
+  }
+  if { ![ llength $removeList ] } {
+    return
+  }
+  array unset installData
+  DlgProcess $removeList -title [ mc "Remove packages" ] \
+      -label [ mc "You are about to remove"]: \
+      -beforestart ::TolPkgGUI::Removing \
+      -cmditem "RemoveThisPackage" -refreshtree 1
+}
+
 proc ::TolPkgGUI::ImportSyncInfo { } {
   Unimplemented "Import Sync Info"
@@ -1432 +1508 @@
   foreach _p $pkgs {
     foreach { p s } $_p break
-    if { $s eq "upgrade" || $s eq "new" } {
+    if {  $s eq "upgupd" || $s eq "upgrade" || $s eq "new" } {
       lappend remote $p
     } else {
@@ -1467 +1543 @@
 proc ::TolPkgGUI::Upgrading { } {
   DlgProcessSetLabel [ mc "Upgrading" ]...
+}
+
+proc ::TolPkgGUI::Removing { } {
+  DlgProcessSetLabel [ mc "Removing" ]...
 }
 
@@ -1543 +1623 @@
   set result [ TolPkg::RemoteInstall $p $repo ]
   puts "TolPkg::RemoteInstall $p: $result"
+  return $result
+}
+
+proc ::TolPkgGUI::RemoveThisPackage { p } {
+  set result [ TolPkg::RemovePackage $p ]
+  puts "TolPkg::RemovePackage $p: $result"
+  return $result
 }