Changeset 633537f in tol for tolbase/lib/toltk
- Timestamp:
- Dec 31, 2011, 12:14:48 AM (15 years ago)
- Branches:
- 1941-docker-image-to-test, devel, master
- Children:
- caff45d
- Parents:
- 09b79f5
- Location:
- tolbase/lib/toltk
- Files:
-
- 2 edited
-
tolpkg.tcl (modified) (1 diff)
-
tolpkg_gui.tcl (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
tolbase/lib/toltk/tolpkg.tcl
r09b79f5 r633537f 177 177 } 178 178 179 proc ::TolPkg::AddRepository { url } { 180 set tolexpr [ string map [ list %u $url ] { 181 Real TolPackage::Client::AddRepository( "%u" ); 182 } ] 183 toltcl::eval $tolexpr 184 } 185 186 proc ::TolPkg::ZipInstall { pkg.zip } { 187 puts "::TolPkg::ZipInstall ${pkg.zip}" 188 set tolexpr [ string map [ list %p ${pkg.zip} ] { 189 Real TolPackage::Client::LocalInstallPackage( "%p" ) 190 } ] 191 return [ toltcl::eval $tolexpr ] 192 } 193 194 proc ::TolPkg::RemoteInstall { pkg repo } { 195 puts "::TolPkg::RemoteInstall $pkg $repo" 196 set tolexpr [ string map [ list %p $pkg %r $repo ] { 197 Real TolPackage::Client::RemoteInstall( "%r", "%p", 1 ) 198 } ] 199 return [ toltcl::eval $tolexpr ] 200 } 201 202 proc ::TolPkg::ExportPackage { pkg dest } { 203 puts "::TolPkg::ExportPackage $pkg to $dest" 204 set tolexpr [ string map [ list %p $pkg %d $dest ] { 205 Real TolPackage::Client::LocalExportPackage( "%p", "%d/" ) 206 } ] 207 return [ toltcl::eval $tolexpr ] 208 } 209 210 proc ::TolPkg::CheckPackagesToInstall { pkgs } { 211 set members {} 212 foreach p $pkgs { 213 lappend members \"${p}\" 214 } 215 set tolexpr [ string map [ list %s "\[\[ [ join $members , ] \]\]" ] { 216 Set TolPackage::Client::GetDeepDependencies.all.last( %s ); 217 } ] 218 return [ lindex [ toltcl::eval $tolexpr ] 0 ] 219 } 220 221 proc ::TolPkg::GetUpgradeConfig { } { 222 set tolexpr { 223 Set { 224 [[ 225 Real checkTOL = TolConfigManager::Config::Upgrading::TolVersion::CheckAllowed; 226 Real localPKG = TolConfigManager::Config::Upgrading::TolPackage::LocalOnly 227 ]] 228 } 229 } 230 return [ lindex [ toltcl::eval $tolexpr -named 1 ] 1 ] 231 } 232 179 233 proc ::TolPkg::GetKnownRepositories { } { 180 234 return [ lindex [ toltcl::eval \ -
tolbase/lib/toltk/tolpkg_gui.tcl
r09b79f5 r633537f 15 15 array set urlmap { 16 16 http://packages.tol-project.org/OfficialTolArchiveNetwork/repository.php OTAN 17 OTAN http://packages.tol-project.org/OfficialTolArchiveNetwork/repository.php 17 18 http://packages.localbayes.es/BayesPrivateTolPackages/repository.php BPTP 18 } 19 19 BPTP http://packages.localbayes.es/BayesPrivateTolPackages/repository.php 20 } 21 22 variable win 23 20 24 variable packSyncInfo 21 25 variable versSyncInfo … … 564 568 } 565 569 } 570 571 if { [ lsearch [ image names ] folder_yellow_16 ] == -1 } { 572 image create photo folder_yellow_16 -data { 573 R0lGODlhEAAQAPYAAK+KGLGMGLOOGbKNGrKMG7OMG7OOG7SOGbSPGbWPH7SQGaOFI8GLNMmJN8Se 574 MMSXOcSfO9eQOuOePN6xLcOhN8WgNMahNcehNcmjNMijN8mmNcukN8ulN8umNsumN8KgOMeiOMei 575 OcemPMekPselPsemPtGnN9uqNeG9K+K4LeO/LOS8LeW/LeytO/G5OeTALPTHN/XMNvTBOffQNcun 576 QtGtQtCuSd6+Q922Sum8S/TCTvjETvjITvjOTe/USO7USfrTTfzaS/veTPzgTPzkTfzmUfvpXd3A 577 ZurTg/rrhvLgl/nrqAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 578 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 579 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5 580 BAEAAEwALAAAAAAQABAAAAeSgEyCg4SFhoeGBwgICgGIggYTKSssAgqXlwiEAC4yMDEzKi8vKioo 581 A4MALScYGxwesLAdFRcgTAASJj9GSUu+v0tKFkwEERlCREW8wEtIIUwFDTVAQUPJy75HggUMODw9 582 1NbKvTbbDzk7O9/h1w7bEDrp6evVPhqCCTTy++s3gwsfSJQoQWIEiYIjRFB4xLAhoUAAOw== 583 } 584 } 566 585 } 567 586 … … 608 627 } 609 628 629 proc ::TolPkgGUI::GetRepoId { url } { 630 variable urlmap 631 632 set url [ expr { [ string range $url end-13 end ] eq "repository.php" ? 633 $url : "${url}repository.php" } ] 634 set repo [ expr { [ info exists urlmap($url) ] ? $urlmap($url) : "unknown" } ] 635 636 return $repo 637 } 638 610 639 proc ::TolPkgGUI::GetPkgNode { T url p } { 611 640 variable urlmap … … 619 648 set url [ expr { [ string range $url end-13 end ] eq "repository.php" ? 620 649 $url : "${url}repository.php" } ] 621 set repo $urlmap($url)650 set repo [ expr { [ info exists urlmap($url) ] ? $urlmap($url) : "unknown" } ] 622 651 if { [ info exists packSyncInfo($p) ] } { 623 652 array set packSync $packSyncInfo($p) … … 650 679 [ list $repo ] ] -at end -relative root \ 651 680 -button auto ] 652 set nodesInfo($treeParents($p),type) pkg681 set nodesInfo($treeParents($p),type) pkg 653 682 set nodesInfo($treeParents($p),status) $nodeStatus 654 683 } … … 727 756 set nodeStatus unknown 728 757 } 729 set nid [ $T insert [ list [ list $img $pv ] [ list $statusLabel ] ] \ 758 set repo [ GetRepoId $pkgRepo ] 759 set nid [ $T insert [ list [ list $img $pv ] [ list $statusLabel ] [ list $repo ] ] \ 730 760 -at end -relative $treeParents($pkgRoot) -button auto ] 731 761 set nodesInfo($nid,type) pkgver … … 816 846 switch -exact $nodesInfo($nid,status) { 817 847 "new" { 818 lappend listNEW $pkgInfo(lastremote)848 lappend listNEW [ list $pkgInfo(lastremote) $nid ] 819 849 } 820 850 "upgrade" { 821 lappend listUPG $pkg851 lappend listUPG [ list $pkg $nid ] 822 852 } 823 853 "ok" { … … 829 859 } 830 860 } 831 lappend listEXP [ list $pkgInfo(lastremote) $nodesInfo($nid,status) ]861 lappend listEXP [ list $pkgInfo(lastremote) $nodesInfo($nid,status) $nid ] 832 862 } 833 863 # next process the list of pkgver … … 837 867 "new" { 838 868 if { [ lsearch $listNEW $pkg ] == -1 } { 839 lappend listNEW $pkg869 lappend listNEW [ list $pkg $nid ] 840 870 } 841 871 } 842 872 "update" { 843 lappend listUPD $pkg873 lappend listUPD [ list $pkg $nid ] 844 874 } 845 875 "ok" { … … 850 880 } 851 881 if { [ lsearch $listEXP $pkg ] == -1 } { 852 lappend listEXP [ list $pkg $nodesInfo($nid,status) ]882 lappend listEXP [ list $pkg $nodesInfo($nid,status) $nid ] 853 883 } 854 884 } 855 885 # install list 856 886 if { [ llength $listNEW ] == 1 } { 857 $w add command -label [ mc "Install %s" [ lindex $listNEW0 ] ] \858 -command [ list ::TolPkgGUI::InstallPackage [ lindex $listNEW 0 ]]887 $w add command -label [ mc "Install %s" [ lindex [ lindex $listNEW 0 ] 0 ] ] \ 888 -command [ list ::TolPkgGUI::InstallPackages $listNEW ] 859 889 } elseif { [ llength $listNEW ] > 1 } { 860 890 $w add command -label [ mc "Install selected" ] \ 861 -command [ list ::TolPkgGUI::InstallPackage $listNEW ]891 -command [ list ::TolPkgGUI::InstallPackages $listNEW ] 862 892 } 863 893 $w add command -label "[ mc {Install ZIP} ]..." \ … … 865 895 # update list 866 896 if { [ llength $listUPD ] == 1 } { 867 $w add command -label [ mc "Update %s" [ lindex $listUPD 0 ] ] \ 868 -command [ list ::TolPkgGUI::UpdatePackageVersion [ lindex $listUPD 0 ] ] 897 $w add command \ 898 -label [ mc "Update %s" [ lindex [ lindex $listUPD 0 ] 0 ] ] \ 899 -command [ list ::TolPkgGUI::UpdatePackageVersion $listUPD ] 869 900 } elseif { [ llength $listUPD ] > 1 } { 870 901 $w add command -label [ mc "Update selected" ] \ … … 875 906 # upgrade list 876 907 if { [ llength $listUPG ] == 1 } { 877 $w add command -label [ mc "Upgrade %s" [ lindex $listUPG 0 ] ] \ 878 -command "::TolPkgGUI::UpgradePackage [ lindex $listUPG 0 ]" 908 $w add command \ 909 -label [ mc "Upgrade %s" [ lindex [ lindex $listUPG 0 ] 0 ] ] \ 910 -command [ list ::TolPkgGUI::UpgradePackages $listUPG ] 879 911 } elseif { [ llength $listUPG ] > 1 } { 880 912 $w add command -label [ mc "Upgrade selected" ] \ 881 -command [ list ::TolPkgGUI::UpgradePackage $listUPG ]913 -command [ list ::TolPkgGUI::UpgradePackages $listUPG ] 882 914 } 883 915 $w add command -label [ mc "Upgrade all" ] \ 884 -command "::TolPkgGUI::UpgradePackage "916 -command "::TolPkgGUI::UpgradePackages" 885 917 # export options 886 918 $w add separator 887 919 if { [ llength $listEXP ] == 1 } { 888 920 $w add command -label [ mc "Export %s" [ lindex [ lindex $listEXP 0 ] 0 ] ]... \ 889 -command [ list ::TolPkgGUI::ExportPackageVersion [ lindex $listEXP 0 ]]921 -command [ list ::TolPkgGUI::ExportPackageVersion $listEXP ] 890 922 } elseif { [ llength $listEXP ] > 1 } { 891 923 $w add command -label [ mc "Export selected" ]... \ … … 904 936 905 937 proc ::TolPkgGUI::AddNewRepository { } { 906 } 907 908 proc ::TolPkgGUI::CheckRepository { repo length } { 938 variable win 939 variable urlmap 940 941 set w $win.dlgAdd 942 if { ![ winfo exist $w ] } { 943 Dialog $w -title [ mc "Add repository"] \ 944 -parent $win -modal local 945 set f [ $w getframe ] 946 label $f.lb -text [ mc "Repository" ]: 947 ComboBox $f.cb -values BPTP 948 grid $f.lb -row 0 -column 0 -sticky ew 949 grid $f.cb -row 0 -column 1 -sticky ew 950 grid columnconfigure $f 1 -weight 1 951 $w add -text Ok 952 $w add -text Cancel 953 } 954 set ans [ $w draw ] 955 if { $ans == 0 } { 956 set repo [ string trim [ [$w getframe].cb get ] ] 957 if { [ string range $repo 0 3 ] eq "http" } { 958 set url $repo 959 } else { 960 if { [ info exists urlmap($repo) ] } { 961 set url $urlmap($repo) 962 } else { 963 964 } 965 } 966 puts "::TolPkg::AddRepository $url" 967 ::TolPkg::AddRepository $url 968 } 909 969 } 910 970 … … 917 977 } 918 978 919 proc ::TolPkgGUI::InstallPackage { p } { 979 proc ::TolPkgGUI::StartProgressBar { } { 980 variable win 981 variable Progress 982 983 set Progress(status) "working" 984 set Progress(state) 0 985 $win configure -cursor watch 986 foreach wc [ winfo children $win.dlgInstall ] { 987 catch { $wc configure -cursor watch } 988 } 989 } 990 991 proc ::TolPkgGUI::DoneProgress { } { 992 variable win 993 variable Progress 994 995 set Progress(status) "stopped" 996 Dialog::enddialog $win.dlgInstall 1 997 $win configure -cursor "" 998 foreach wc [ winfo children $win.dlgInstall ] { 999 catch { $wc configure -cursor "" } 1000 } 1001 } 1002 1003 proc ::TolPkgGUI::AdvanceProgress { x } { 1004 variable Progress 1005 1006 if { $Progress(status) eq "working" } { 1007 set Progress(state) $x 1008 update 1009 } 1010 } 1011 1012 proc ::TolPkgGUI::InstallBtn1 { remote } { 1013 variable win 1014 variable Progress 1015 1016 set w $win.dlgInstall 1017 $w itemconfigure 0 -state disabled 1018 $w itemconfigure 1 -command ::TolPkgGUI::DoneProgress 1019 set f [ $w getframe ] 1020 $f.lb1 configure -text [ mc "Installing" ]... 1021 InstallTask $remote 1022 } 1023 1024 proc ::TolPkgGUI::DlgProcessBtn1 { } { 1025 variable win 1026 variable DlgProcessData 1027 1028 set w [ DlgProcessGetWin ] 1029 # disable button Ok 1030 $w itemconfigure 0 -state disabled 1031 # set cancel to finish progress 1032 $w itemconfigure 1 -command ::TolPkgGUI::DlgProcessStop 1033 eval $DlgProcessData(-beforestart) 1034 DlgProcessTask 1035 } 1036 1037 proc ::TolPkgGUI::DlgProcess { pkgs args } { 1038 variable win 1039 variable DlgProcessData 1040 1041 array unset DlgProcessData 1042 array set DlgProcessData { 1043 -title "Process packages" 1044 -beforestart "" 1045 -cmditem "" 1046 -cmdlabelitem "" 1047 -customgui "" 1048 } 1049 set DlgProcessData(-label) [ mc "You are about to process"]: 1050 array set DlgProcessData $args 1051 set DlgProcessData(items) $pkgs 1052 set DlgProcessData(status) "stopped" 1053 set DlgProcessData(state) "" 1054 set w [ DlgProcessGetWin ] 1055 if { ![ winfo exists $w ] } { 1056 Dialog $w -title $DlgProcessData(-title) \ 1057 -parent $win -modal local -cancel 1 -separator 1 1058 set f [ $w getframe ] 1059 label $f.lb1 1060 listbox $f.list -selectmode single -background white \ 1061 -relief flat -borderwidth 1 -highlightthickness 0 \ 1062 -selectbackground #c3c3ff 1063 ProgressBar $f.pbar 1064 $w add -text Ok 1065 $w add -text Cancel 1066 grid $f.lb1 -row 0 -column 0 -sticky w 1067 grid $f.list -row 1 -column 0 -sticky snew 1068 grid $f.pbar -row 2 -column 0 -sticky e 1069 grid columnconfigure $f 0 -weight 1 1070 grid rowconfigure $f 1 -weight 1 1071 if { $DlgProcessData(-customgui) ne "" } { 1072 eval $DlgProcessData(-customgui) $f 3 1073 } 1074 } else { 1075 set f [ DlgProcessGetFrame ] 1076 } 1077 $f.pbar configure -maximum 1 \ 1078 -variable ::TolPkgGUI::DlgProcessData(state,0) 1079 $f.pbar configure -variable ::TolPkgGUI::DlgProcessData(state) 1080 1081 $f.lb1 configure -text $DlgProcessData(-label) 1082 $w itemconfigure 0 -state normal \ 1083 -command [ list ::TolPkgGUI::DlgProcessBtn1 ] 1084 $w itemconfigure 1 -command "Dialog::enddialog $w 1" 1085 set lb [ DlgProcessGetList ] 1086 $lb delete 0 end 1087 foreach it $DlgProcessData(items) { 1088 if { $DlgProcessData(-cmdlabelitem) ne "" } { 1089 set labelIt [ $DlgProcessData(-cmdlabelitems) $it ] 1090 } else { 1091 set labelIt $it 1092 } 1093 $f.list insert end $it 1094 } 1095 set DlgProcessData(state) "" 1096 $w draw 1097 } 1098 1099 proc ::TolPkgGUI::DlgProcessGetCurrentIndex { } { 1100 variable DlgProcessData 1101 1102 return $DlgProcessData(current) 1103 } 1104 1105 proc ::TolPkgGUI::DlgProcessStart { } { 1106 variable win 1107 variable DlgProcessData 1108 1109 set lb [ DlgProcessGetList ] 1110 set total [ llength $DlgProcessData(items) ] 1111 set DlgProcessData(current) 0 1112 $lb selection clear 0 end 1113 $lb selection set 0 1114 $lb see 0 1115 set DlgProcessData(status) "working" 1116 set DlgProcessData(state) 0 1117 $win configure -cursor watch 1118 set w [ DlgProcessGetWin ] 1119 foreach wc [ winfo children $w ] { 1120 catch { $wc configure -cursor watch } 1121 } 1122 } 1123 1124 proc ::TolPkgGUI::DlgProcessAdvance { } { 1125 variable DlgProcessData 1126 1127 set i [ incr DlgProcessData(current) ] 1128 set lb [ DlgProcessGetList ] 1129 set total [ llength $DlgProcessData(items) ] 1130 $lb selection set $i 1131 $lb selection anchor $i 1132 $lb see $i 1133 if { $DlgProcessData(status) eq "working" } { 1134 set DlgProcessData(state) [ expr { double($i) / $total } ] 1135 update 1136 } 1137 } 1138 1139 proc ::TolPkgGUI::DlgProcessItem { p } { 1140 variable DlgProcessData 1141 1142 if { $DlgProcessData(-cmditem) ne "" } { 1143 $DlgProcessData(-cmditem) $p 1144 } 1145 } 1146 1147 proc ::TolPkgGUI::DlgProcessStop { } { 1148 variable win 1149 variable DlgProcessData 1150 1151 set w [ DlgProcessGetWin ] 1152 $win configure -cursor "" 1153 foreach wc [ winfo children $w ] { 1154 catch { $wc configure -cursor "" } 1155 } 1156 set DlgProcessData(status) "stopped" 1157 Dialog::enddialog $w 1 1158 } 1159 1160 proc ::TolPkgGUI::DlgProcessGetWin { } { 1161 variable win 1162 1163 return $win.dlgProcess 1164 } 1165 1166 proc ::TolPkgGUI::DlgProcessGetFrame { } { 1167 variable win 1168 1169 set w [ DlgProcessGetWin ] 1170 return [ $w getframe ] 1171 } 1172 1173 proc ::TolPkgGUI::DlgProcessGetList { } { 1174 variable win 1175 1176 set w [ DlgProcessGetFrame ] 1177 return $w.list 1178 } 1179 1180 proc ::TolPkgGUI::DlgProcessSetLabel { text } { 1181 variable win 1182 1183 set f [ DlgProcessGetFrame ] 1184 $f.lb1 configure -text $text 1185 } 1186 1187 proc ::TolPkgGUI::InstallPackages { pkgs } { 1188 variable win 1189 variable installData 1190 1191 puts "InstallPackages: $pkgs" 1192 array unset installData 1193 foreach p $pkgs { 1194 array set installData $p 1195 lappend _pkgs [ lindex $p 0 ] 1196 } 1197 set InstallList [ TolPkg::CheckPackagesToInstall $_pkgs ] 1198 if { ![ llength $InstallList ] } { 1199 set ans [ MessageDlg $win.ask -title [ mc "Install packages" ] \ 1200 -icon error \ 1201 -parent $win \ 1202 -type ok -aspect 75 \ 1203 -message [ mc "Could not connect with remote repository" ] ] 1204 return 1205 } 1206 puts "InstallPackages: $InstallList" 1207 DlgProcess $InstallList -title [ mc "Export packages" ] \ 1208 -label [ mc "You are about to export"]: \ 1209 -beforestart ::TolPkgGUI::Installing \ 1210 -cmditem "InstallThisPackage" 1211 1212 } 1213 1214 proc ::TolPkgGUI::DlgProcessGetVariableName { name } { 1215 return ::TolPkgGUI::DlgProcessData($name) 1216 } 1217 1218 proc ::TolPkgGUI::DlgProcessGetVariable { name } { 1219 variable DlgProcessData 1220 1221 return $DlgProcessData($name) 1222 } 1223 1224 proc ::TolPkgGUI::DlgProcessTask { } { 1225 variable win 1226 variable Progress 1227 variable DlgProcessData 1228 1229 DlgProcessStart 1230 foreach p $DlgProcessData(items) { 1231 if { $DlgProcessData(status) ne "working" } break 1232 DlgProcessItem $p 1233 DlgProcessAdvance 1234 } 1235 DlgProcessStop 1236 } 1237 1238 proc ::TolPkgGUI::InstallTask { remote } { 1239 variable win 1240 variable Progress 1241 variable InstallList 1242 1243 set w $win.dlgInstall 1244 set f [ $w getframe ] 1245 set total [ llength $InstallList ] 1246 set i 0 1247 $f.list selection clear 0 end 1248 $f.list selection set 0 1249 $f.list see 0 1250 StartProgressBar 1251 foreach p $InstallList { 1252 if { $Progress(status) ne "working" } break 1253 if { $remote } { 1254 TolPkg::RemoteInstall $p 1255 } else { 1256 TolPkg::ZipInstall $p 1257 } 1258 incr i 1259 $f.list selection set $i 1260 $f.list selection anchor $i 1261 $f.list see $i 1262 AdvanceProgress [ expr { double($i) / $total } ] 1263 } 1264 DoneProgress 1265 920 1266 } 921 1267 922 1268 proc ::TolPkgGUI::InstallZip { } { 923 } 924 925 proc ::TolPkgGUI::UpgradePackage { {p ""} } { 926 } 927 928 proc ::TolPkgGUI::UpdatePackageVersion { {p ""} } { 1269 variable win 1270 variable installZipData 1271 1272 set installZipData [ tk_getOpenFile -defaultextension .zip -multiple 1 \ 1273 -parent $win -title [ mc "Select zip" ] \ 1274 -filetypes {{zip {.zip}}} ] 1275 if { $installZipData ne "" } { 1276 foreach f $installZipData { 1277 lappend zipList [ file tail $f ] 1278 } 1279 DlgProcess $zipList -title [ mc "Install Zip's" ] \ 1280 -label [ mc "You are about to install zip"]: \ 1281 -beforestart ::TolPkgGUI::InstallingZip \ 1282 -cmditem InstallThisZip 1283 } 1284 } 1285 1286 proc ::TolPkgGUI::CheckConnectionConfig { } { 1287 variable win 1288 1289 array set connConfig [ ::TolPkg::GetUpgradeConfig ] 1290 if { $connConfig(localPKG) } { 1291 MessageDlg $win.ask -title [ mc "Warning" ] \ 1292 -icon warning \ 1293 -type ok \ 1294 -message [ mc "Can not continue. You have configured to use only local packages. Check the value of\nTolConfigManager::Config::Upgrading::TolPackage::LocalOnly." ] 1295 return 0 1296 } 1297 return 1 1298 } 1299 1300 proc ::TolPkgGUI::UpgradePackages { { pkgs {} } } { 1301 variable installData 1302 1303 puts "UpgradePackages: $pkgs" 1304 if { ![ CheckConnectionConfig ] } { 1305 return 1306 } 1307 array unset installData 1308 if { [ llength $pkgs ] } { 1309 foreach p $pkgs { 1310 array set installData $p 1311 lappend upgradeList [ lindex $p 0 ] 1312 } 1313 } else { 1314 # upgrade all, look for the list 1315 } 1316 DlgProcess $upgradeList -title [ mc "Upgrade packages" ] \ 1317 -label [ mc "You are about to upgrade"]: \ 1318 -beforestart ::TolPkgGUI::Upgrading \ 1319 -cmditem "InstallThisPackage" 1320 } 1321 1322 proc ::TolPkgGUI::UpdatePackageVersion { { pkgs {} } } { 1323 variable installData 1324 1325 puts "UpdatePackageVersion: $pkgs" 1326 if { ![ CheckConnectionConfig ] } { 1327 return 1328 } 1329 1330 array unset installData 1331 if { [ llength $pkgs ] } { 1332 foreach p $pkgs { 1333 array set installData $p 1334 lappend updateList [ lindex $p 0 ] 1335 } 1336 } else { 1337 # upgrade all, look for the list 1338 } 1339 DlgProcess $updateList -title [ mc "Update packages" ] \ 1340 -label [ mc "You are about to update"]: \ 1341 -beforestart ::TolPkgGUI::Updating \ 1342 -cmditem "InstallThisPackage" 929 1343 } 930 1344 … … 945 1359 # repository. 946 1360 # 947 proc ::TolPkgGUI::ExportPackageVersion { {p ""} } { 948 1361 1362 # Funciones que hacen falta: 1363 # 1364 # 1- Crear un zip de un paquete local 1365 # 2- Descargar un zip de un paquete remoto 1366 # 1367 proc ::TolPkgGUI::ExportPackageVersion { {pkgs ""} } { 1368 variable win 1369 1370 if { ![ CheckConnectionConfig ] } { 1371 return 1372 } 1373 set remote {} 1374 set local {} 1375 foreach _p $pkgs { 1376 foreach { p s } $_p break 1377 if { $s eq "upgrade" || $s eq "new" } { 1378 lappend remote $p 1379 } else { 1380 lappend local $p 1381 } 1382 } 1383 if { [ llength $remote ] } { 1384 set ans [ MessageDlg $win.ask -title [ mc "Export packages" ] \ 1385 -icon warning \ 1386 -type okcancel -aspect 75 \ 1387 -message [ mc "The following package can not be exported because they are not installed:\n%s\n\nContinue?" $remote ] ] 1388 if { $ans == 1 } { 1389 return 1390 } 1391 } 1392 puts "ExportPackageVersion: $local" 1393 if { [ llength $local ] } { 1394 DlgProcess $local -title [ mc "Export packages" ] \ 1395 -label [ mc "You are about to export"]: \ 1396 -beforestart ::TolPkgGUI::Exporting \ 1397 -customgui "CreateSelectDir" \ 1398 -cmditem "ExportThisPackage" 1399 } 1400 } 1401 1402 proc ::TolPkgGUI::Exporting { } { 1403 DlgProcessSetLabel [ mc "Exporting" ]... 1404 } 1405 1406 proc ::TolPkgGUI::Installing { } { 1407 DlgProcessSetLabel [ mc "Installing" ]... 1408 } 1409 1410 proc ::TolPkgGUI::Upgrading { } { 1411 DlgProcessSetLabel [ mc "Upgrading" ]... 1412 } 1413 1414 proc ::TolPkgGUI::Updating { } { 1415 DlgProcessSetLabel [ mc "Updating" ]... 1416 } 1417 1418 proc ::TolPkgGUI::InstallingZip { } { 1419 DlgProcessSetLabel [ mc "Installing Zip" ]... 1420 } 1421 1422 proc ::TolPkgGUI::CreateSelectDir { f row } { 1423 set varname [ DlgProcessGetVariableName "directory" ] 1424 upvar \#0 $varname var 1425 1426 1427 if { ![ info exists $varname ] } { 1428 trace add variable $varname write ::TolPkgGUI::OnChangeDirectory 1429 } 1430 frame $f.fdir 1431 label $f.fdir.lb -text [ mc "Output directory" ]: 1432 entry $f.fdir.ent -textvariable $varname 1433 button $f.fdir.btn -image folder_yellow_16 \ 1434 -command "::TolPkgGUI::ChooseDir $varname" 1435 grid $f.fdir.lb -row 0 -column 0 -sticky w 1436 grid $f.fdir.ent -row 0 -column 1 -sticky ew 1437 grid $f.fdir.btn -row 0 -column 2 -sticky ew 1438 grid columnconfigure $f.fdir 1 -weight 1 1439 grid $f.fdir -row $row -column 0 -sticky ew 1440 if { $var eq "" } { 1441 set var [ pwd ] 1442 } else { 1443 set var $var 1444 } 1445 } 1446 1447 proc ::TolPkgGUI::OnChangeDirectory { args } { 1448 set w [ DlgProcessGetWin ] 1449 set dir [ DlgProcessGetVariable directory ] 1450 if { [ file exists $dir ] && [ file writable $dir ] } { 1451 $w itemconfigure 0 -state normal 1452 } else { 1453 $w itemconfigure 0 -state disabled 1454 } 1455 } 1456 1457 proc ::TolPkgGUI::ChooseDir { varname } { 1458 variable win 1459 1460 puts "upvar \#0 $varname var" 1461 upvar \#0 $varname var 1462 1463 set res [ tk_chooseDirectory -parent $win -initialdir $var \ 1464 -mustexist 1 -title [ mc "Select output directory" ] ] 1465 if { $res ne "" } { 1466 set var $res 1467 } 1468 } 1469 1470 proc ::TolPkgGUI::ExportThisPackage { p } { 1471 set status [ TolPkg::ExportPackage $p [ DlgProcessGetVariable "directory" ] ] 1472 puts "::TolPkgGUI::ExportThisPackage $p ==> $status" 1473 } 1474 1475 proc ::TolPkgGUI::InstallThisPackage { p } { 1476 variable win 1477 variable urlmap 1478 variable installData 1479 1480 if { [ info exists installData($p) ] } { 1481 set nid $installData($p) 1482 set REPO [ $win.tree item text $nid REPO ] 1483 set repo $urlmap($REPO) 1484 } else { 1485 # packages requested as a dependencie 1486 set repo "" 1487 } 1488 set result [ TolPkg::RemoteInstall $p $repo ] 1489 puts "TolPkg::RemoteInstall $p: $result" 1490 } 1491 1492 proc ::TolPkgGUI::InstallThisZip { p } { 1493 variable win 1494 variable urlmap 1495 variable installZipData 1496 1497 puts "::TolPkgGUI::InstallThisZip $p" 1498 set idx [ DlgProcessGetCurrentIndex ] 1499 set thisZip [ lindex $installZipData $idx ] 1500 set result [ TolPkg::ZipInstall $thisZip ] 1501 puts "::TolPkgGUI::InstallThisZip $p: $result" 949 1502 } 950 1503 951 1504 proc ::TolPkgGUI::Show { } { 952 set w .tolpkg 953 954 if { [ winfo exists $w ] } { 955 raise $w 1505 variable win 1506 1507 set win .tolpkg 1508 1509 if { [ winfo exists $win ] } { 1510 raise $win 956 1511 } else { 957 toplevel $w 958 wm state $w withdrawn959 CreateTree $w .tree960 FillTreeInfo $w .tree961 wm state $w normal1512 toplevel $win 1513 wm state $win withdrawn 1514 CreateTree $win.tree 1515 FillTreeInfo $win.tree 1516 wm state $win normal 962 1517 } 963 1518 }
Note: See TracChangeset
for help on using the changeset viewer.
