From cad7d10b73b40016304e7987353143aac9a4d671 Mon Sep 17 00:00:00 2001 From: mnt Date: Fri, 11 Dec 2009 12:47:14 +0000 Subject: [PATCH] Removing earlier removed file --- src/WOKTclLib/MatraDatavision.xpm | 53 -- src/WOKTclLib/MdtvLogo33x120b.gif | Bin 1829 -> 0 bytes src/WOKTclLib/WOKVC.ClearCase | 102 --- src/WOKTclLib/bag.tcl | 669 -------------- src/WOKTclLib/p-ul.tcl | 1362 ----------------------------- src/WOKTclLib/padmin.tcl | 149 ---- src/WOKTclLib/pinstall.tcl | 41 - src/WOKTclLib/pintegre.tcl | 698 --------------- src/WOKTclLib/pnews.tcl | 61 -- src/WOKTclLib/pprepare.tcl | 336 ------- src/WOKTclLib/pstore.tcl | 476 ---------- src/WOKTclLib/ptypefile.tcl | 217 ----- src/WOKTclLib/template.dsp | 94 -- src/WOKTclLib/template.dspx | 94 -- src/WOKTclLib/template.vcproj | 156 ---- src/WOKTclLib/template.vcprojx | 150 ---- src/WOKTclLib/wokOUC.tcl | 481 ---------- src/WOKTclLib/woksh.el-wnt | 357 -------- 18 files changed, 5496 deletions(-) delete mode 100755 src/WOKTclLib/MatraDatavision.xpm delete mode 100755 src/WOKTclLib/MdtvLogo33x120b.gif delete mode 100755 src/WOKTclLib/WOKVC.ClearCase delete mode 100755 src/WOKTclLib/bag.tcl delete mode 100755 src/WOKTclLib/p-ul.tcl delete mode 100755 src/WOKTclLib/padmin.tcl delete mode 100755 src/WOKTclLib/pinstall.tcl delete mode 100755 src/WOKTclLib/pintegre.tcl delete mode 100755 src/WOKTclLib/pnews.tcl delete mode 100755 src/WOKTclLib/pprepare.tcl delete mode 100755 src/WOKTclLib/pstore.tcl delete mode 100755 src/WOKTclLib/ptypefile.tcl delete mode 100755 src/WOKTclLib/template.dsp delete mode 100755 src/WOKTclLib/template.dspx delete mode 100755 src/WOKTclLib/template.vcproj delete mode 100755 src/WOKTclLib/template.vcprojx delete mode 100755 src/WOKTclLib/wokOUC.tcl delete mode 100755 src/WOKTclLib/woksh.el-wnt diff --git a/src/WOKTclLib/MatraDatavision.xpm b/src/WOKTclLib/MatraDatavision.xpm deleted file mode 100755 index 4834785..0000000 --- a/src/WOKTclLib/MatraDatavision.xpm +++ /dev/null @@ -1,53 +0,0 @@ -/* XPM */ -static char *MatraDatavision[] = { -/* width height num_colors chars_per_pixel */ -" 110 40 6 1", -/* colors */ -". c #ffffff", -"# c #000000", -"a c #999999", -"b c #c7c7c7", -"c c #0000ff", -"d c #20b2aa", -/* pixels */ -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc.c.c..dcccccccccccc", -"cccc.ccccccccccc.ccccccccc.ccccccc.............ccc.......dccccccccccccc.cccccccccccccccccd.c.c..c..dcccccccccc", -"cccc..ccccccccc..ccccccccd.dcccccc.............ccc........dcccccccccccd.dcccccccccccccccd.c.c..c..c.dccccccccc", -"cccc...ccccccc...cccccccc...cccccc.............ccc...cc....ccccccccccc...ccccccccccccccd.c.c..c..c..ddcccccccc", -"cccc....ccccc....cccccccd...dcccccccccc...cccccccc...ccd...ccccccccccd...dccccccccccccd.cccd.c..c..c..cccccccc", -"cccc.....ccc.....ccccccc.....cccccccccc...cccccccc...cccd..cccccccccc.....cccccccccccd.c.ccccd.c..c...dccccccc", -"cccc......c......ccccccc.....cccccccccc...cccccccc...ccd...cccccccccc.....ccccccccccc.c.c.cccccd.c....cccccccc", -"cccc.............ccccccd.....dccccccccc...cccccccc...cc...dcccccccccd.....dcccccccccdc.c...dccccccd..c.ccccccc", -"cccc...c.....c...cccccc...d...ccccccccc...cccccccc........cccccccccc...d...cccccccccc.c..c..dcccccccc..ccccccc", -"cccc...cc...cc...cccccd...c...dcccccccc...cccccccc......dccccccccccd...d...dccccccccdc..c..dccccccccd..ccccccc", -"cccc...ccc.ccc...ccccc...dcd...cccccccc...cccccccc......ccccccccccc...dcd...ccccccccc..c..ccccccc.c....ccccccc", -"cccc...ccccccc...ccccc...ccc...cccccccc...cccccccc...d...cccccccccc...ccc...ccccccccc.c..cccccd..c.....ccccccc", -"cccc...ccccccc...ccccd.........dccccccc...cccccccc...cd..dccccccccd.........dccccccccc..cccd....c.....dccccccc", -"cccc...ccccccc...cccc...........ccccccc...cccccccc...cc...dccccccc...........ccccccccc.c..c....c......cccccccc", -"cccc...ccccccc...cccd...ccccc...dcccccc...cccccccc...ccd...ccccccd...dcccd...dccccccccc..c....c......dcccccccc", -"cccc...ccccccc...ccc...dcccccd...cccccc...cccccccc...cccd...ccccc...dcccccd...ccccccccccd....c......dccccccccc", -"cccc...ccccccc...ccc...ccccccc...cccccc...cccccccc...cccc....cccc...ccccccc...ccccccccccc...c......dcccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccd.....dcccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", -"..............................................................................................................", -"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb####bbbbbbb#bbbb#####bbbb#bbbb#bbbbb#bb#bbb###bbb#bbb####bbb##bbb#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb#bbb#bbbbba#abbbbb#bbbbba#abbb#bbbbb#bb#bb#bbb#bb#bb#bbbb#bb#aabb#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb#bbbb#bbbb#b#bbbbb#bbbbb#b#bbbaabbbaabb#bb#bbbbbb#bb#bbbb#bb#b#bb#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb#bbbb#bbbaabaabbbb#bbbbaabaabbb#bbb#bbb#bbb###bbb#bb#bbbb#bb#baab#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb#bbbb#bbb#bbb#bbbb#bbbb#bbb#bbb#bbb#bbb#bbbbbb#bb#bb#bbbb#bb#bb#b#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb#bbbb#bba#####abbb#bbba#####abbaabaabbb#bbbbbb#bb#bb#bbbb#bb#bb#b#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb#bbb#bbb#bbbbb#bbb#bbb#bbbbb#bbb#b#bbbb#bb#bbb#bb#bb#bbbb#bb#bbaa#bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbb####bbbb#bbbbb#bbb#bbb#bbbbb#bbbb#bbbbb#bbb###bbb#bbb####bbb#bbb##bbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", -"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" -}; diff --git a/src/WOKTclLib/MdtvLogo33x120b.gif b/src/WOKTclLib/MdtvLogo33x120b.gif deleted file mode 100755 index 63b7fe469651304a89b99ed55442bd893bc4051e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1829 zcmc&z`8U;R7=K60ZIn!jq!`L_NGEwY?mbOSS#Fk;?AMy@dmA?jSAHL_j@AEvL=d;{uNgT@GuU=(_x2)CufV9a7nFs9sMxHAl98B7>VIUZ1ESj@7Ru$XeRpqn9> zC72LQIhHWYP|Q+HD5e}~5CN=#Ch!6xuo+eXHh{r2v_l;p;IIrs7>05RVKLlUmLV)d zIl;gK$}C|BVJN2`XhAni8A2J#*#T~WJ>Ulz0E$5(XaW(y8fXG9AOf2K8n6KjrlB3` z@BoLfEaj{Og|Hazgs_xz76bziC=<$3&S;1QascDOX|NW&1oOZxum}7A13)oI1k!*7 ztbr!*0wS;(paC1eU>e$?4i9iBml;?I3SlwaDHkE+4}n9%5GiB`p+QOz3*-RCgVSIw zcnNj@OBe<}zyMGT5`i>e0c)TMynqO7257(rFqnpRsKWys?w9yKd~`l7=e8OzeV6_d zXca|&ui9dJt^Cf}RVqe4UDqn^rVeejFSBi`yq}?tL;vb(s_ML;ZI!;ot~uDoUFP0o z+TAR3$Z84fZD*AFj3hgw-UPE(4py?e&nl`4wjaqhy{g+#)@C;0?Cw-$nW0z^=#u7A zB|T*yUEtE-SaB$2^17>Gv)iLW#f*i^!Ya*&PDDjbd05gnQ?IL6bHd*};p@X$ji!8Q zx@`G?TZuuS*8MDx=G=jgawAr!h) z>jWR=L5%}$hkugG1H;;H|1)uQ$B&B(=WlCzNV7UW+`H!xp)V3YQrfsqyy&>HD_F+& zkVYnpcuHpu6~ri=jI2I&$>yrwM?bhGk_`cAQ?Dq_IJl*R%KY8lh!k~7_#?Yc- zk72zUAD7OGmzsw0`Ick$cO8X_{&7=`U)ie)^DS|C{n3+&!vdY%E{@{hu!g;{V@895nqhP4_eMI6iJv@1!d82|96x+O zlwTOtALc#iYQIP3*5+xa+VA<&y>&->+^&=-Mn(~`4YvXYZ7IXFBiW?ceiwu|+H4_Pe3}$YUC_ z{aI3eoptW$N?nmSF!7>jeSGv(aO!Ydy0}hPSahcD-5YOf@mrg8v9G1iNWhwjl{m`j z8QowQ-ZmbgZrE=w90|ykFM1CT&Bk1Rirw`~%{zMJM|;+emPADGb0PzWWJIx`P$Gye zKB4s@ABTr41oqTt4)eW|NlN%w{f%0)P22e^+$}ot9G;ZtUk;lb91|$ptDG1Sr1IV- zSuV8yVs^-;>QQ2bQn+86OE{ae?BAr5)s@~c;b&JX)V4Mbcw0>U-j|Unz13^+{+YdO zS!vm;kqYbDKV$M7{hRNaJ?}Fx`8F;h3BpZ -# -#;< -proc wokIntegre:BASE:stof { file vrs } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:IsElm { file } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:InitFile { infile vrs cmt Sfile {fileid stdout} } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:ReInitFile { Sfile vrs cmt infile {fileid stdout} } { - return {} -} -#; -# -#;< -proc wokIntegre:BASE:UpdateFile { Sfile vrs cmt infile {fileid stdout} } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:DeleteFile { infile {fileid stdout} } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:GetFile { Sfile invrs {fileid stdout} } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:List { Bname vrs } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:EOF { {fileid stdout} } { - return {} -} -#;> -# -#;< -proc wokIntegre:BASE:Execute { VERBOSE command {fileid stdout} } { - return {} -} -;#;> -;# -;#;< -proc wokIntegre:BASE:diff { sfile v1 v2 } { - return {} -} -;#;> -;# -;#;< -proc wokIntegre:BASE:cat { sfile {v last} } { - return {} -} -;#;> -;# -;#;< -proc wokIntegre:BASE:vrs { sfile } { - return {} -} -;#;> -;# -;#;< -proc wokIntegre:BASE:check { sfile } { - return {} -} -;#;> -;# -;#;< -proc wokIntegre:BASE:tree { infile fils} { - return {} -} -#;> -# -#;< -proc wokIntegre:Version:Check { shop ver } { - return {} -} diff --git a/src/WOKTclLib/bag.tcl b/src/WOKTclLib/bag.tcl deleted file mode 100755 index 19152a8..0000000 --- a/src/WOKTclLib/bag.tcl +++ /dev/null @@ -1,669 +0,0 @@ -;# -;# (((((((((((( M A G I C )))))))))))) -;# -;# Poor parsing of a magic file. Returns the list of all extensions found after -name directive. -;# mgfile returned by wokBAG:magic:Name -;# -proc wokBAG:magic:Parse { mgfile } { - if [ catch { set fileid [open $mgfile r] } ] { - return {} - } - set lx {} - foreach x [split [read $fileid] ] { - if { ([string compare $x "-name"] == 0 ) || ( [string compare $x "(-name"] == 0 ) } { - set name 1 - } else { - if [info exists name] { - regsub -all {[");]} $x "" res - set lx [concat $lx $res] - unset name - } - } - } - close $fileid - return $lx -} -;# -;# returns the list of Known EXtension -;# -proc wokBAG:magic:kex { } { - set l {} - foreach mgfile [wokBAG:magic:Name] { - if [file exists $mgfile] { - set l [concat $l [wokBAG:magic:Parse $mgfile]] - } else { - puts stderr "Magic: File $mgfile not found" - } - } - return $l -} -;# -;# Given a list of extension, returns the sublist of unknown extensions -;# If this sublist is {} then all extensions are known. -;# Plus merdique, tu meurs a virer des que possible. -;# -proc wokBAG:magic:CheckExt { lxt } { - set kex [wokBAG:magic:kex] - set l {} - - foreach e $lxt { - set fnd 0 - foreach x $kex { - if { [string match $x $e] } { - set fnd 1 - break - } - } - if { $fnd == 0 } { - set l [concat $l $e] - } - } - - return $l -} -;# -;# (((((((((((( A D M I N )))))))))))) -;# -proc wokBAG:admin:Create {} { - global tcl_platform - set NAM [wokBAG:admin:Name] - set TAG [file join [wokBAG:bag:GetRootTagName] $NAM] - set VBS [file join [wokBAG:bag:GetAdmName] ${NAM}.vbs] - set VWR [wokBAG:view:GetRootName] - if { "$tcl_platform(platform)" == "unix" } { - if ![file exists $TAG] { - if [catch {mkdir -path $TAG} tag_stat] { - puts stderr ${tag_stat} - return {} - } - } - if ![file exists [wokBAG:bag:GetAdmName]] { - if [catch {mkdir -path [wokBAG:bag:GetAdmName]} vbs_stat ] { - puts stderr ${vbs_stat} - return {} - } - } - } - lappend l "cleartool mkvob -nc -tag $TAG $VBS" - lappend l "cleartool mount $TAG" - lappend l "cleartool co -nc $VWR/[wokBAG:view:GetViewImport]${TAG}" - lappend l "cleartool mkelem -eltype directory -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/JOURNAL" - lappend l "cleartool mkelem -eltype directory -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/CONFIGS" - lappend l "cleartool ci -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/JOURNAL" - lappend l "cleartool ci -nc $VWR/[wokBAG:view:GetViewImport]${TAG}/CONFIGS" - lappend l "cleartool ci -nc $VWR/[wokBAG:view:GetViewImport]${TAG}" - return $l -} -;# -;# (((((((((((( H L I N K )))))))))))) -;# -;# returns the sequence used to initialize the link for pnam -;# -proc wokBAG:hlink:Init { pnam } { - set NAM [wokBAG:admin:Name] - set TAG [file join [wokBAG:bag:GetRootTagName] $NAM] - lappend l "cleartool mkhltype -nc -shared [wokBAG:hlink:Umaked $pnam]@$TAG" -} -;# returns the string that identify the link used to reflect build dependencies of pnam -;# This module uses journal definition. -;# -proc wokBAG:hlink:Umaked { pnam } { - return ${pnam}_umakedwith -} -;# -;# Link -;# from, lto : Versionned composant name -;# Example : from = s_1 r_2 -;# set from /view/IMPORT/dl_07/REFERENCE/BAG/ADMIN/JOURNAL/s.jnl@@/s_1 -;# set to /view/IMPORT/dl_07/REFERENCE/BAG/ADMIN/JOURNAL/r.jnl@@/r_2 -;# set command "cleartool mkhlink -nc umaked $from $to" -;# set command "cleartool mkhlink -nc umake_s $from $to" - -proc wokBAG:hlink:Attach { pfrom lpto } { - if [regexp {([^_]*)_([0-9]*)} $pfrom all nfrom vfrom] { - set from [wokBAG:journal:name $nfrom]@@/${pfrom} - set hnam [wokBAG:hlink:Umaked $nfrom] - foreach pto $lpto { - if [regexp {([^_]*)_([0-9]*)} $pto all npto vpto] { - set to [wokBAG:journal:name $npto]@@/${pto} - lappend l "cleartool mkhlink -nc $hnam $from $to" - } else { - puts stderr "hlink:Attach(to) : Error in component name $pto" - return {} - } - } - return $l - } else { - puts stderr "hlink:Attach(from) : Error in component name $pfrom" - return {} - } -} -;# -;# (((((((((((( L A B E L S )))))))))))) -;# -;# returns the tag name of the VOB where labels are managed. -;# This VOB should be public. -;# -proc wokBAG:label:GetAdminVOB { } { - return [file join [wokBAG:bag:GetRootTagName] [wokBAG:admin:Name]] -} -;# -;# Returns all labels that match regexp -;# -proc wokBAG:label:ls { {rgx *} } { - set command "cleartool lstype -short -kind lbtype -invob [wokBAG:label:GetAdminVOB]" - if ![catch { eval exec $command } status ] { - set lret {} - foreach e [wokUtils:LIST:GM [split $status \n] $rgx] { - lappend lret [lindex [split $e] 0] - } - return $lret - } else { - puts stderr "$status" - return -1 - } -} - -;# -;# Returns all kwown labels -;# writes map(pnam) = list of kwown labels for pnam -;# opt should be short or long -;# -proc wokBAG:label:dump { map opt } { - upvar $map TLOC - catch { unset TLOC } - set command "cleartool lstype -$opt -kind lbtype -invob [wokBAG:label:GetAdminVOB]" - if ![catch { eval exec $command } status ] { - if { "$opt" == "short" } { - foreach e [split $status \n] { - if [regexp {([^_]*)_([0-9]*)} $e all n v] { - lappend TLOC($n) $v - } - } - foreach nam [array names TLOC] { - set TLOC($nam) [lsort -integer $TLOC($nam)] - } - } elseif { "$opt" == "long" } { - foreach e [split $status \n] { - if [regexp {^label type "(.*)"} $e match label] { - set curlabel $label - } elseif { [regexp {^ ([^ ]*) by (.*)} $e match date byandwhere] } { - if { "$curlabel" != "LATEST" && "$curlabel" != "CHECKEDOUT" } { - set TLOC($date) "$curlabel $byandwhere" - } - } - } - } - - } else { - puts stderr "$status" - return -1 - } -} -;# -;# Init a label in Admin VOB. -;# -proc wokBAG:label:Init { name } { - lappend l "cleartool mklbtype -global -nc ${name}@[wokBAG:label:GetAdminVOB]" - return $l -} -;# -;# Pose un label. name doit exister. (wokBAG:label:Add) -;# -proc wokBAG:label:Stick { name dir } { - lappend l "cleartool mklabel -nc -rec $name $dir" - lappend l "cleartool lock lbtype:${name}@$dir" - return $l -} -;# -;# Delete a label. -;# -proc wokBAG:label:Del { name } { - lappend l "cleartool rmtype -nc lbtype:${name}@[wokBAG:label:GetAdminVOB]" - return $l -} - -;# -;# (((((((((((( L E V E L S )))))))))))) -;# -;# -;# Initialise les fichiers LEVEL.CFG (BASE.K4E, etc.. ) dans le repertoire ADMIN/CONFIG -;# i. e. cree les fichiers LEVEL.CFGi pour i dans LCFG (K4E K4F etc..) -;# -proc wokBAG:level:Init { level cfg from } { - lappend l "cleartool co -nc [wokBAG:level:dirname]" - lappend l "cleartool mkelem -eltype text_file -nc [wokBAG:level:file $level $cfg]" - lappend l "cleartool ci -ide -rm -nc -from $from [wokBAG:level:file $level $cfg]" - lappend l "cleartool ci -nc [wokBAG:level:dirname]" - return $l -} -;# -;# Update le level avec le contenu de from -;# : fichier associe au level -;# : nouveau contenu -;# < -proc wokBAG:level:update { flevel from } { - lappend l "cleartool co -nc $flevel" - lappend l "cleartool ci -nc -rm -ide -from $from $flevel" - return $l -} - -;# -;# Retourne le full path du fichier decrivant level dans la config cfg -;# si ce -;# 2. le nomune liste destinee a remplacer l'ancien contenu du fichier -;# lbf est de la forme pnam_x -;# -proc wokBAG:level:file { level cfg } { - return [file join [wokBAG:level:dirname] ${level}.${cfg}] -} -;# -;# Retourne le nom du directory ou sont stockes les levels/configs -;# penser a mettre le file le join sur NT c'est plus sur. -;# -proc wokBAG:level:dirname { } { - set vws [wokBAG:view:GetRootName] - return $vws/[wokBAG:view:GetViewImport]/[wokBAG:bag:GetRootTagName]/[wokBAG:admin:Name]/CONFIGS -} -;# -;# Retourne 2 elements -;# 1. le full path du fichier contenant lbf pour la config cfg (celui a modifier) -;# 2. une liste destinee a remplacer l'ancien contenu du fichier -;# lbf est de la forme pnam_x -;# -proc wokBAG:level:find { pnam_x cfg } { - set pnam [wokBAG:cpnt:parse basename ${pnam_x}] - foreach file [wokBAG:level:ls $cfg] { - set lin [wokUtils:FILES:FileToList $file] - if [array exists map] { unset map } - set lxp [wokBAG:cpnt:explode $lin map] - if [info exists map($pnam)] { - set map($pnam) [wokBAG:cpnt:parse version ${pnam_x}] - set newl [wokBAG:cpnt:implode map] - return [list $file $newl] - } - } - return {} -} -;# Retourne le full path des fichiers de description correspondants a la config -;# i. e. tous les fichiers de noms XXX.cfg -;# -proc wokBAG:level:ls { cfg } { - return [glob -nocomplain [wokBAG:level:dirname]/*.${cfg}] -} -;# -;# (((((((((((( J O U R N A L )))))))))))) -;# -;# Initialise la premiere version de journal associee a pnam. -;# -proc wokBAG:journal:Init { pnam jnl } { - set jnam [wokBAG:journal:name $pnam] - lappend l "cleartool co -nc [file dirname $jnam]" - lappend l "cleartool mkelem -nc $jnam" - lappend l "cleartool ci -ide -rm -nc -from $jnl $jnam" - lappend l "cleartool ci -nc [file dirname $jnam]" - return $l -} -;# -;# Update le journal associe a pnam. -;# -proc wokBAG:journal:Update { pnam jnl } { - set jnam [wokBAG:journal:name $pnam] - lappend l "cleartool co -nc $jnam" - lappend l "cleartool ci -ide -rm -nc -from $jnl $jnam" - return $l -} - -;# -;# Retourne le nom du journal associe a pnam. -;# -proc wokBAG:journal:name { pnam } { - set vws [wokBAG:view:GetRootName] - return $vws/[wokBAG:view:GetViewImport]/[wokBAG:bag:GetRootTagName]/[wokBAG:admin:Name]/JOURNAL/${pnam}.jnl -} -;# -;# retourne le full path du journal associe a pnam_x -;# -proc wokBAG:journal:read { pnam_x } { - set nam [wokBAG:cpnt:parse basename ${pnam_x}] - return [wokBAG:journal:name $nam]@@/main/[wokBAG:cpnt:parse version ${pnam_x}] -} -;# -;# (((((((((((( V I E W S )))))))))))) -;# -proc wokBAG:view:Init { vnam {location {}} } { - if { $location != {} } { - set vws [file join [$location ${vnam}.vws]] - } else { - set vws [file join [wokBAG:bag:GetAdmName] ${vnam}.vws] - } - lappend l "cleartool mkview -tag $vnam $vws" - return $l -} -;# -;# Configure la vue avec le fichier configspec -;# -proc wokBAG:view:setcs { file { tag {} } } { - if { $tag == {} } { - lappend l "cleartool setcs $file" - } else { - lappend l "cleartool setcs -tag $tag $file" - } - return $l -} -;# -;# -;# -proc wokBAG:view:startview { view } { - lappend l "cleartool startview $view" -} -;# -;# -;# -proc wokBAG:view:endview { view } { - lappend l "cleartool endview $view" -} -;# -;# (((((((((((( C O M P O N E N T S )))))))))))) -;# -;# -;# Retourne le vob-tag associe a pnam -;# -proc wokBAG:cpnt:GetTagName { pnam } { - return [file join [wokBAG:bag:GetRootTagName] ${pnam}] -} -;# -;# Retourne le directory avec lequel faut comparer dans la VOB -;# -proc wokBAG:cpnt:GetImportName { pnam } { - return [wokBAG:view:GetRootName]/[wokBAG:view:GetViewImport][wokBAG:cpnt:GetTagName $pnam] -} -;# -;# Retourne le directory dans lequel il faut prendre les fichiers de pnam relativement la vue d'export. -;# -proc wokBAG:cpnt:GetExportName { pnam } { - return [wokBAG:view:GetRootName]/[wokBAG:view:GetViewExport][wokBAG:cpnt:GetTagName $pnam] -} -;# -;# Init d'un composant. -;# pnam : Nom du composant ( racine du directory dans la VOB) -;# from : Nom d'une racine -;# cvt_data: Nom du directory ou ecrire le fichier cvt_data de clearexport -;# cmt : Un commentaire -;# LAM : faudrait voir a faire les mkdir sinon ca marchera pas. -;# le cd est fait dans pintegre c'est moche mais en attendant mieux. -;# -proc wokBAG:cpnt:Init { pnam from cvt_data {cmt Init} {location {}} } { - global tcl_platform - set tag [wokBAG:cpnt:GetTagName $pnam] - if { $location != {} } { - set vbs [file join [$location ${pnam}.vbs]] - } else { - set vbs [file join [wokBAG:bag:GetAdmName] ${pnam}.vbs] - } - if { "$tcl_platform(platform)" == "unix" } { - if ![file exists $tag] { - catch { mkdir -path $tag } - } - if ![file exists $vbs] { - catch { mkdir -path [file dirname $vbs] } - } - } - ;#lappend l "cleartool mkvob -tag $tag -nc -public -password $passwd $vbs" - lappend l "cleartool mkvob -nc -tag $tag $vbs" - lappend l "cleartool mount $tag" - lappend l "cleartool mkhlink AdminVOB vob:${tag} vob:[wokBAG:label:GetAdminVOB]" - ;#lappend l "cd $from" - lappend l "clearexport_ffile -r -o $cvt_data ." - lappend l "cleartool startview [wokBAG:view:GetViewImport]" - lappend l "clearimport -dir [wokBAG:cpnt:GetImportName $pnam] -comment \"$cmt\" $cvt_data" - return $l -} -;# -;# -;# -proc wokBAG:cpnt:sortnam { pnam1 pnam2 } { - if { [lindex [split $pnam1 _] end] > [lindex [split $pnam2 _] end] } { - return -1 - } else { - return 1 - } -} -;# -;# -;# -proc wokBAG:cpnt:Del { pnam } { - lappend l "cleartool umount [wokBAG:bag:GetRootTagName]/${pnam}" - lappend l "cleartool rmvob -force [file join [wokBAG:bag:GetAdmName] ${pnam}.vbs]" - return $l -} -;# -;# Returns the list of "patches" registered for pnam (Patch 0 is the version base.) -;# pnam is a component name without version ( no _) -;# -proc wokBAG:cpnt:Patches { pnam {upto 99999} } { - set l {} - foreach x [wokBAG:label:ls ${pnam}_*] { - if { [lindex [split $x _] end] <= $upto } { - lappend l [file tail $x] - } - } - return [lsort -command wokBAG:cpnt:sortnam $l] -} -;# -;# Returns the name of the label to place on pnam (_1 is the base version.) -;# pnam is a component name without version ( no _) -;# -proc wokBAG:cpnt:GetLabel { pnam } { - set llp [wokBAG:cpnt:Patches $pnam] - if { $llp != {} } { - set n [lindex [split [lindex [wokBAG:cpnt:Patches $pnam] 0] _] 1] - return ${pnam}_[incr n] - } else { - return ${pnam}_1 - } -} -;# -;# fait a_1 b_2 c_3 => map(a)=1,map(b)=2, map(c)=3 Comme parse ci dessous -;# -proc wokBAG:cpnt:explode { lpnam_x map } { - upvar $map TLOC - foreach pnam_x ${lpnam_x} { - set TLOC([lindex [split ${pnam_x} _] 0]) [lindex [split ${pnam_x} _] 1] - } - return -} -;# -;# fait map(a)=1,map(b)=2, map(c)=3 => a_1 b_2 c_3 (inverse de ci dessus) -;# -proc wokBAG:cpnt:implode { map } { - upvar $map TLOC - set l {} - foreach n [array names TLOC] { - lappend l ${n}_$TLOC($n) - } - return $l -} -;# -;# Parse un nom d'UL a la JCR. -;# KERNEL-B4-2_8 => root=KERNEL,basename=KERNEL-B4-2,extension=B4-2,version=8 -;# KERNEL-B4-2 => root=KERNEL,basename=KERNEL-B4-2,extension=B4-2,version={} -;# KERNEL => root=KERNEL,basename={} ,extension={} ,version={} -proc wokBAG:cpnt:parse { option pnam_x } { - if { [regexp {([^-]*)-([^_]*)_([0-9]+)} ${pnam_x} a r e v] != 0 } { - switch -- $option { - root { return $r } - extension { return $e } - version { return $v } - basename { return ${r}-${e} } - } - } elseif { [regexp {([^-]*)-([^_]*)} ${pnam_x} a r e] != 0 } { - switch -- $option { - root { return $r } - extension { return $e } - version { return {} } - basename { return ${r}-${e} } - } - } else { - return {} - } -} -;# -;# Update directory dir ( which already exists in VOB ) with files in lfile. -;# Each element of lfile (non empty ) has the following format: -;# basn name1 [name2] -;# sta is # - or + if the file must be (resp ) modified, removed or added. -;# if the file must be modified: -;# name1/basn is the full path of the VOB element to be checkouted -;# name2/basn is the full path of the file used for update -;# if the file must be removed: -;# name1/basn is the full path of the VOB element to be removed. -;# name2 is blank -;# if the file must be added: -;# name1/basn is the full path of the file used for the creation. -;# -;# -proc wokBAG:cpnt:UpdateDirectory { dir lfile } { - set l {} - foreach e $lfile { - if [regexp { #[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem from] { - lappend l "cleartool co -nc [file join $elem $basn]" - lappend l "cleartool ci -nc -rm -from [file join $from $basn] [file join $elem $basn]" - } elseif [regexp { \-[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem] { - set mustco 1 - lappend l "cleartool rmname -nc [file join $elem $basn]" - } elseif [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] { - set mustco 1 - lappend l "cleartool mkelem -nc [file join $dir $basn]" - lappend l "cleartool ci -nc -rm -from [file join $from $basn] [file join $dir $basn]" - } else { - puts stderr "wokBAG:cpnt:UpdateDirectory: Line $e does not match anything !!" - return {} - } - } - - if [info exists mustco] { - lappend l "cleartool ci -nc $dir" - return [linsert $l 0 "cleartool co -nc $dir"] - } else { - return $l - } -} -;# -;# Creates a directory and populates it with new files. -;# -proc wokBAG:cpnt:CreateDirectory { dir lfile } { - lappend l "cleartool co -nc [file dirname $dir]" - lappend l "cleartool mkelem -nc -eltype directory $dir" - foreach e $lfile { - if [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] { - lappend l "cleartool mkelem -nc [file join $dir $basn]" - lappend l "cleartool ci -nc -rm -from [file join $from $basn] [file join $dir $basn]" - } else { - puts stderr "wokBAG:cpnt:CreateDirectory: Line $e does not match anything !!" - return {} - } - } - lappend l "cleartool ci -nc $dir" - lappend l "cleartool ci -nc [file dirname $dir]" -} -;# -;# Removes all files in dir and removes directory itself. -;# -proc wokBAG:cpnt:DeleteDirectory { dir lfile } { - lappend l "cleartool co -nc [file dirname $dir]" - lappend l "cleartool rmname -nc $dir" - lappend l "cleartool ci -nc [file dirname $dir]" -} -;# (((((((((((( C O N F I G )))))))))))) -;# -;# : The name of the config K4E, .. -;# -;# If Option is "strong" => then complete only if component already exists in Bag. -;# If Option is "weak" => then ignore components not found in the Bag. -;# -proc wokBAG:cfg:Complete { name cmplst {option "strong"} } { - set l {} - wokBAG:cpnt:explode [wokBAG:cfg:read $name] LABELS - foreach pnam $cmplst { - if [regexp {([^_]*)_([0-9]*)} $pnam all n v] { - if [info exists LABELS($n)] { - if { $v <= $LABELS($n) } { - set l [concat $l $pnam] - } else { - puts stderr "Error: Patch level $v for $n does not exists. Higher level is $LABELS($n)" - return {} - } - } else { - puts stderr "Error: $n is not a component." - if { "$option" == "strong" } { - return {} - } - } - } else { - if [info exists LABELS($pnam)] { - set l [concat $l ${pnam}_$LABELS($pnam)] - } else { - puts stderr "Error: $pnam is not a component." - if { "$option" == "strong" } { - return {} - } - } - } - } - return $l -} -;# -;# Returns all pnam_x belonging to assembly/config name -;# first is the name of configuration ( K4E, K4F ,.. ) -;# vrs is the version number of the configuratrion -;# if vrs {} then use LATEST. -;# -proc wokBAG:cfg:read { name {vrs {}} } { - set l {} - foreach x [wokBAG:level:ls $name] { - set l [concat $l [wokUtils:FILES:FileToList $x]] - } - return $l -} -;# -;# ecrit un config spec. lfpnam list de full path de composants dans le Bag -;# -proc wokBAG:cfg:ListToConfig { lfpnam file } { - set l {} - foreach pnam $lfpnam { - lappend l "element * $pnam -nocheckout" - } - wokUtils:FILES:ListToFile $l $file - return -} -;# (((((((((((( E R R O R L O G )))))))))))) -;# -;# -proc wokBAG:errlog:ls { } { - foreach f [readdir [wokBAG:errlog:location]] { - puts $f - } -} -;# -;# -;# -proc wokBAG:errlog:purge { } { - foreach f [glob [wokBAG:errlog:location]/*] { - unlink $f - } -} -;# -;# -;# -proc wokBAG:errlog:Add { pnam } { - set p [file join [wokBAG:errlog:location] ${pnam}.[clock seconds]] - if ![ catch { set id [ open $p w ] } ] { - return $id - } else { - return {} - } -} -proc wokBAG:errlog:Regexp { } { - set rg1 {cleartool: Error:} -} diff --git a/src/WOKTclLib/p-ul.tcl b/src/WOKTclLib/p-ul.tcl deleted file mode 100755 index c0b1e8f..0000000 --- a/src/WOKTclLib/p-ul.tcl +++ /dev/null @@ -1,1362 +0,0 @@ -#======================================================================================================== -# p-put Version 3.02 beta (egu 17/07/98 ) -# ajout verification que les fichiers embarques ne sont pas protege en ecriture sous WNT -#======================================================================================================== - -# -# Usage -# -proc p-putUsage { } { - puts stdout {p-put Version 3.02 17/07/98} - puts stdout {Usage : p-put [-h] (this help)} - puts stdout {Usage : p-put [-web] (updating web site)} - puts stdout {Usage : p-put [...] -B -U
    } - #puts stdout { p-put [...] -B -U
      [-P ] } - puts stdout { p-put [...] -B -U
        [-P ] -L -C "comment" } - return -} - -proc p-put { args } { - global env - - set tblreq(-h) {} - set tblreq(-web) {} - set tblreq(-B) value_required:string - set tblreq(-U) value_required:string - set tblreq(-P) value_required:string - set tblreq(-L) value_required:string - set tblreq(-C) value_required:string - - set param {} - if { [putils:EASY:GETOPT param tabarg tblreq p-putUsage $args] == -1 } return - -#==================== OPTIONS SETTINGS ========================== - - if [info exists tabarg(-web)] { - update-web-data - return - } - - if [info exists tabarg(-h)] { - p-putUsage - return - } - - set param_length [llength $param] - - if { $param_length == 0 } { - puts stderr "Error : You must enter at least one configuration" - return error - } else { - set list_config {} - foreach config $param { - lappend list_config $config - } - } - - ### ABOUT UL ### - - set nbargx 0 - if [info exists tabarg(-B)] { - set SRC_BAG_PATH $tabarg(-B) - if ![file exists $SRC_BAG_PATH] { - puts stderr " Error : can not see $SRC_BAG_PATH" - return error - } - incr nbargx - } - - if [info exists tabarg(-U)] { - set SRC_BAG_DIR $tabarg(-U) - set SRC_DIR ${SRC_BAG_PATH}/${SRC_BAG_DIR} - if ![file exists ${SRC_DIR}] { - puts stderr " Error : can not see $SRC_BAG_DIR directory under $SRC_BAG_PATH" - return error - } - incr nbargx - } - - if [info exists tabarg(-P)] { - set PATCH $tabarg(-P) - set AUTONUM 0 - } else { - set PATCH {} - set AUTONUM 1 - } - - ### ABOUT PATCH ### - - set nbargy 0 - - if [info exists tabarg(-C)] { - set COMMENT $tabarg(-C) - incr nbargy - } - - - if [info exists tabarg(-L)] { - set LIST_FILE $tabarg(-L) - if ![file readable $LIST_FILE] { - puts stderr " Error : can not read $LIST_FILE" - return - } else { - set f [open $LIST_FILE r] - set PB 0 - while { [ gets $f line ] >= 0 } { - if ![catch { glob ${SRC_DIR}/${line} } ] { - foreach fich [glob ${SRC_DIR}/${line}] { - if ![file readable $fich] { - puts stderr " Error : can not read $fich" - set PB 1 - } - } - if { $env(WOKSTATION) == "wnt"} { - foreach fich [glob ${SRC_DIR}/${line}] { - if ![file writable $fich] { - puts stderr " Error : $fich not writable, problem will exist for next patch" - set PB 1 - } - } - } - } else { - puts stderr " Error : can not glob line ${SRC_DIR}/${line}" - set PB 1 - } - } - close $f - if { $PB == 1 } { - puts stderr " Procedure aborted " - return 0 - } - } - incr nbargy - } else { - foreach fich [recursive_glob ${SRC_DIR} *] { - if ![file readable $fich] { - puts stderr " Error : can not read $fich" - return - } - } - if { $env(WOKSTATION) == "wnt"} { - foreach fich [recursive_glob ${SRC_DIR} *] { - if ![file writable $fich] { - puts stderr " Error : $fich not writable, problem will exist for next patch" - return - } - } - } - } - - ### REFERENCE ### - - set ULBAG [wokparam -e %BAG_Home REFERENCE] - - ### LETS GO ### - - if [expr {$nbargx == 2 && $nbargy == 0}] { - if {[put-ul $SRC_BAG_PATH $SRC_BAG_DIR $ULBAG $list_config] == 1 } { return end } - return error - } - - if [expr { $nbargx == 2 && $nbargy == 2}] { - if {[put-patch $SRC_BAG_PATH $SRC_BAG_DIR $AUTONUM $PATCH $ULBAG $LIST_FILE $COMMENT $list_config] == 1 } { return end } - return error - } - -} - -##################### PUT-UL ###################################### - -proc put-ul { src_bag ul_name dest_dir config_list} { - - - if [file exists ${dest_dir}/${ul_name}.tar.gz] { - puts stderr "Error : ${ul_name}.tar.gz already exist in ${dest_dir}" - return 0 - } - - set savpwd [pwd] - cd ${src_bag}/${ul_name} - - puts stdout "Info : Creating ${dest_dir}/${ul_name}.tar" - - if { [putils:EASY:tar tarfromroot ${dest_dir}/${ul_name}.tar .] == -1 } { - puts stderr "Error while creating ${dest_dir}/{ul_name}.tar " - catch {unlink ${dest_dir}/${ul_name}.tar} - cd $savpwd - return 0 - } - - puts stdout "Info : Gziping ${dest_dir}/${ul_name}.tar" - - if { [putils:FILES:compress ${dest_dir}/${ul_name}.tar] == -1 } { - puts stderr "Error while creating ${dest_dir}/${ul_name}.tar.gz - catch {unlink ${dest_dir}/${ul_name}.tar} - catch {unlink ${dest_dir}/${ul_name}.tar.gz} - cd $savpwd - return 0 - } - - #### Construction du fichier de trace #### - puts stdout "Info : Creating trace file ${dest_dir}/TRC/${ul_name}.trc" - set trace [open ${dest_dir}/TRC/${ul_name}.trc w] - foreach fich [glob ${src_bag}/${ul_name}/*] { - puts $trace $fich - } - close $trace - - #### Inscription dans le(s) configul(s) #### - set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"] - foreach config $config_list { - set CONFIGUL ${dest_dir}/CONFIGUL.${config} - puts stdout " Updating $CONFIGUL" - set f [ open $CONFIGUL a+] - set s [format "%-18s %s" $ul_name $now] - puts $f $s - close $f - } - - ###fin - puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]" - cd $savpwd - - - #### mise a jour des fichiers du web #### - update-web-data - - return 1 -} - - -# -##################### PUT-PATCH ###################################### -# - -proc put-patch { src_bag ul_name AUTONUM patch_name dest_bag lst_patch comment config_list} { - - set dest_dir $dest_bag/PATCH - - ### Pour la numerotation automatique ### - if { $AUTONUM} { - set level [conf_ul_level $ul_name [lindex $config_list 0] $dest_bag] - foreach config $config_list { - if ![ file exists ${dest_dir}/PATCHISTO.${config} ] { - puts stderr "Error autonum: File ${dest_dir}/PATCHISTO.${config} dont exist, you must create it" - return 0 - } - set new_level [conf_ul_level $ul_name $config $dest_bag] - if { $new_level != $level } { - puts stderr " Error autonum : different patch levels in different configul " - return 0 - } - } - - - if { $level == -1 } { - puts stderr " Error : can't calculate patch levels " - return 0 - } - incr level - set patch_name ${ul_name}_${level} - puts stdout "Info : patch auto numerotation = $level" - } - - ##### - - set savpwd [pwd] - cd ${src_bag}/${ul_name} - - if [file exists ${dest_dir}/${patch_name}.tar.gz ] { - puts stderr "Error : File ${dest_dir}/${patch_name}.tar.gz already exists. Nothing done" - cd $savpwd - return 0 - } - - puts stdout "Info : Creating ${dest_dir}/${patch_name}.tar" - -if { [putils:EASY:tar tarfromliste ${dest_dir}/${patch_name}.tar ${lst_patch}] == -1 } { - puts stderr "Error while creating ${dest_dir}/{patch_name}.tar " - catch {unlink ${dest_dir}/{patch_name}.tar } - cd $savpwd - return 0 - } - - puts stdout "Info : Gziping ${dest_dir}/${patch_name}.tar" - if { [putils:FILES:compress ${dest_dir}/${patch_name}.tar] == -1 } { - puts stderr "Error while creating ${dest_dir}/${patch_name}.tar.gz - catch {unlink ${dest_dir}/${patch_name}.tar} - catch {unlink ${dest_dir}/${patch_name}.tar.gz} - cd $savpwd - return 0 - } - - puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]" - - #### Construction du fichier de trace #### - puts stdout "Info : Creating trace file ${dest_dir}/TRC/${patch_name}.trc" - set f [open $lst_patch r] - set trace [open ${dest_dir}/TRC/${patch_name}.trc w] - while { [ gets $f line ] >= 0 } { - foreach fich [glob ${src_bag}/${ul_name}/${line}] { - puts $trace $fich - } - } - close $f - close $trace - - #### Inscription dans le(s) patchisto(s) #### - - #set now [string range [fmtclock [getclock]] 0 18] - set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"] - set level [lindex [split ${patch_name} _] end] - set ul_name [lindex [split ${patch_name} _] 0] - foreach config $config_list { - set PATCHISTO "${dest_dir}/PATCHISTO.${config}" - puts stdout "Info : updating $PATCHISTO" - set f [open $PATCHISTO r+] - set indice 0 - while { [ gets $f line ] >= 0 } { - if [ ctype alnum [ lindex $line 0 ] ] { - set indice [ lindex $line 0 ] - } - } - incr indice - puts stdout "Info : $PATCHISTO patch indice = $indice" - close $f - set lpatch [putils:FILES:FileToList $PATCHISTO ] - set s [format "%-5s%-18s%3s %-5s %s" $indice $ul_name $level $now $comment] - lappend lpatch $s - putils:FILES:ListToFile $lpatch $PATCHISTO - } - - ###FIN - puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]" - cd $savpwd - - #### mise a jour des fichiers du web #### - update-web-data - - return 1 -} - -#================================================================================= -proc conf_ul_level { ul_name config bag_path } { - - set CONFIGUL ${bag_path}/CONFIGUL.${config} - set PATCHISTO ${bag_path}/PATCH/PATCHISTO.${config} - - set level -1 - if [file exists ${CONFIGUL} ] { - set f [open $CONFIGUL r ] - while {[gets $f line] >= 0 } { - if [ctype alnum [ cindex [lindex $line 0] 0 ] ] { - if { [lindex $line 0] == $ul_name } { - set level 0 - } - } - } - close $f - } - - if [file exists ${PATCHISTO}] { - set f [open $PATCHISTO r] - while { [ gets $f line ] >= 0 } { - if [ ctype alnum [ lindex $line 0 ] ] { - if { [lindex $line 1] == $ul_name } { - set level [lindex $line 2] - } - } - } - close $f - } - return $level -} - -################################################# -proc update-web-data { } { - - global env - set PROCFTPPATH $env(FACTORYHOME)/MajWeb - puts -nonewline "=== Updating www data....." - - if { $env(WOKSTATION) == "wnt"} { - if [file exists $PROCFTPPATH/putdata.ftp] { - if [catch { eval exec ftp {-v -i -s:$PROCFTPPATH/putdata.ftp} } status] { - puts stderr $status - } else { - puts " done ===" - } - } else { - puts stdout "Info : Cant find $PROCFTPPATH/putdata.ftp" - } - } else { - if [file exists $PROCFTPPATH/putdata.com] { - if [catch { eval exec $PROCFTPPATH/putdata.com } status] { - puts stderr $status - } else { - puts " done ===" - } - } else { - puts stdout "Info : Cant find $PROCFTPPATH/putdat.ftp" - } - } -return -} - -#======================================================================================================== -# p-get Version 3.04 (egu 29/09/98 ) -# ajout de l'option -f pour forcer l'install des patch -# (ajout de l'option -runtime pour ne pas faire de declarations -# liees a la descente des patchs)activite non visible -# Modification de nombreuses functions pour wok: wok n'est plus versionne -# suppression des options -v (verbose) et -n (no execute) -#======================================================================================================== -#======================================================================================================== -#======================================================================================================== - -proc p-get-usage { } { - puts stderr {} - puts stdout {p-get Version 3.04 (september 98)} - #puts stderr {Usage : p-get [-h][-f][-rt][-clean][-d dirinstall] [del list] [-P patch |-I indice]} - puts stderr {Usage : p-get [-h][-f][-clean][-d dirinstall] [del list] [-P patch |-I indice]} - puts stderr { -h : this help} - puts stderr { -f : force install} -# puts stderr { -rt : runtime mode} #fonctionne mais volontairement cache - puts stderr { -clean : clean mode} - puts stderr { [-d dirinstall] : directory to install ul} - puts stderr { : configuration} - puts stderr { [del list] : list of one or more Delivery: [ [del2] [del3] ... ]} - puts stderr { OR "ALL" ("ALL" is default value)} - puts stderr { [-P patch | : patch number OR "ALL" ("ALL" is default value)} - puts stderr { |-I indice] : indice number OR "ALL" ("ALL" is default value)} -# puts stderr { Online doc at http://info.paris1.matra-dtv.fr/Devlog/Departements/Dcfao/env/pget304.htm} - return -} - -#======================================================================================================== - -proc p-get { args } { - - global env - - set tblreq(-h) {} - set tblreq(-f) {} - set tblreq(-rt) {} - set tblreq(-clean) {} - set tblreq(-d) value_required:string - set tblreq(-P) value_required:string - set tblreq(-I) value_required:string - - set param {} - if { [putils:EASY:GETOPT param tabarg tblreq p-get-usage $args] == -1 } return - set param_length [llength $param] - - #======================================= VARIABLES SETTINGS ============================================= - if [info exists tabarg(-h)] { - p-get-usage - return - } - - #----------- WOK SETTINGS ------------------------------------- - wokclose -a [wokparam -e %[finfo]_Home] - set SRCBAGPATH [wokparam -e %BAG_Home REFERENCE] - set SRCPATCHPATH $SRCBAGPATH/PATCH - set DESTBAGPATH [wokparam -e %BAG_Home] - - #------------- OPTIONS SETTINGS ------------------------------- - set FORCE [info exists tabarg(-f)] - set RUNTIME [info exists tabarg(-rt)] - set CLEAN [info exists tabarg(-clean)] - - if [info exists tabarg(-d)] { - set NEWDIR $tabarg(-d) - } else { - set NEWDIR 0 - } - - if { $param_length == 0 } { - puts stderr " Error : You must at least enter a configuration" - p-get-usage - return - } - - set CONF [lindex $param 0] - set CONFIGUL ${SRCBAGPATH}/CONFIGUL.${CONF} - if { ![file exists $CONFIGUL] } { - puts stderr " Error : Cannot find $CONFIGUL, maybe version $CONF don't exist " - p-get-usage - return - } - - set PATCHISTO ${SRCPATCHPATH}/PATCHISTO.${CONF} - - set ul_list {} - if { $param_length == 1 } { lappend ul_list ALL } - if { $param_length >= 2 } { - if { [lindex $param 1] == "ALL" } { - lappend ul_list ALL - } else { - for { set i 1 } { $i < $param_length } { incr i } { - lappend ul_list [lindex $param $i] - } - } - } - - if [info exists tabarg(-P)] { - set maxlevel $tabarg(-P) - if { $maxlevel != "ALL" && [ctype digit $maxlevel] == 0 } { - puts stderr " Error : -P option must be a number or \"ALL\"" - p-get-usage - return - } - } else { - set maxlevel ALL - } - - if [info exists tabarg(-I)] { - set maxindice $tabarg(-I) - if { $maxindice != "ALL" && [ctype digit $maxindice] == 0 } { - puts stderr " Error : -I option must be a number or \"ALL\"" - p-get-usage - return - } - } else { - set maxindice ALL - } - - - #----------- OPTIONS RESTRICTIONS -------------------------- - - if { $maxlevel != "ALL" && $maxindice != "ALL" } { - puts stderr "Error : You can't use -I and -P options together" - return - } - - if { $maxlevel != "ALL" } { - if { [llength $ul_list] > 1 || [lindex $ul_list 0] == "ALL"} { - puts stderr "Error : You can't use -P option with more than one selected UL" - return - } - } - - #-- Infos -- - puts "SELECTED UL(s) : $ul_list" - puts "CONFIGURATION : $CONF" - puts "MAX PATCH LEVEL : $maxlevel" - puts "MAX INDICE LEVEL : $maxindice" - if { $NEWDIR != 0 } { - puts "INSTALLATION DIR : $NEWDIR" - } else { - puts "INSTALLATION DIR : $DESTBAGPATH" - } - if $FORCE { puts "FORCE ON" } - if $RUNTIME { puts "RUNTIME ON" } - puts {} - - - #================================= LET'S GO ============================================== - #====== creating array mytab of couples (ul full name - patch level to be installed) ====== - - #reconstruct ul_list if "ALL" ul specified - if { [lindex $ul_list 0] == "ALL" } { - set admdir [wokparam -e %[finfo]_Adm] - set file ${admdir}/${CONF}.edl - if [file exists $file] { - wokclose -a [wokparam -e %[finfo]_Home] - set lst_conf [join [wokparam -e %${CONF}_Config] ] - if ![ catch { wokparam -e %${CONF}_Runtime } gonogo ] { - foreach a [join [wokparam -e %${CONF}_Runtime] ] { lappend lst_conf $a } - } - set ul_list {} - foreach p $lst_conf { - if { [lindex [split $p "-"] 1] != $CONF } { - puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p" - #return - } else { - lappend ul_list [lindex [split $p "-"] 0] - } - } - foreach p $lst_conf { - if { [lindex [split $p "-"] 1] != $CONF } { - puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p" - #return - } else { - lappend ul_list [lindex [split $p "-"] 0] - } - } - } else { - puts stderr "Error: None ul installed. Option ul_list = ALL can't be used" - return - } - } - - #construct array from CONFIGUL file - if { [array-set-from-CONFIGUL tab $CONFIGUL $ul_list] == 0 } { return } - - if { [array exists tab] == 0 } { - puts stderr "Error : none del of $CONF matching given list" - return - } - - #construct array from PATCHISTO file - array-set-from-PATCHISTO tab $PATCHISTO $ul_list $maxindice $maxlevel - - #----------- Infos ----------------- - puts "***** install levels *****" - array-print tab - - - #====================== Installation from array "tab" =============================== - - set lstul [ lsort [array names tab] ] - - ### set destination directory ### - if { $NEWDIR != 0 } { - foreach MYUL $lstul { - set MYDEL [lindex [split $MYUL "-"] 0] - set PARCELPATH [parcel-path $MYUL $CONF] - - #verrue wok - if { $MYDEL == "wok"} { - set pat ${DESTBAGPATH}/${MYUL} - if { $NEWDIR != $pat } { - puts stderr "Error : wok cannot be install in a special directory" - return - } - } - #fin verrue wok - - if { $PARCELPATH != 0 && $PARCELPATH != $NEWDIR } { - puts stderr "${MYDEL}-${CONF} already exist in $PARCELPATH : Cannot create same parcel in $NEWDIR" - puts stderr "Nothing done" - return - } - } - } - - ### begin install from array tab ### - foreach MYUL $lstul { - if { $tab($MYUL) >= 0 } { - set MYDEL [lindex [split $MYUL "-"] 0] - - ### test for wok - if { $MYDEL == "wok"} { - set MYPARCEL ${MYUL} - set PARCELPATH ${DESTBAGPATH}/${MYPARCEL} - } else { - set MYPARCEL ${MYDEL}-${CONF} - if { $NEWDIR != 0 } { - set PARCELPATH $NEWDIR - } else { - set PARCELPATH [parcel-path $MYUL $CONF] - if { $PARCELPATH == 0 } { - set PARCELPATH ${DESTBAGPATH}/${MYPARCEL} - } - } - } - - if $FORCE { - set level_to_begin_install 0 - } else { - set installed_level [parcel-level $MYUL $CONF] - set level_to_begin_install [expr ( $installed_level + 1)] - } - - if { $level_to_begin_install > $tab($MYUL) } { - set bag_patch_level [conf_ul_level $MYUL $CONF $SRCBAGPATH] -#FUN 13/10/98 - if {$installed_level > $tab($MYUL)} { - puts "\nWarning: $MYUL is already at level $installed_level > $tab($MYUL)" - } else { - puts "\n----- $MYUL is already at level $installed_level (max = $bag_patch_level)" - } - } else { - set s [format "\n----- INSTALLING %-15s\t%-3s>> %-3s in %s -----" $MYUL $level_to_begin_install $tab($MYUL) $PARCELPATH ] - puts stdout $s - } - - for { set pnumber $level_to_begin_install } { $pnumber <= $tab($MYUL) } { incr pnumber } { - puts stdout "INSTALL LEVEL $pnumber" - switch $pnumber 0 { - if { ![install-ul $MYUL $SRCBAGPATH $PARCELPATH $CONF taberror $RUNTIME $FORCE]} { break } - set pnumber [expr max(0,[parcel-level $MYUL $CONF])] - } default { - if { ![install-patch $MYUL $pnumber $SRCPATCHPATH $PARCELPATH $CONF taberror] } { break } - - } - } - - if $CLEAN { - set lst_station [join [wokparam -e %[finfo -W]_Stations] " "] - foreach station [join [wokparam -e %REFERENCE_Stations] " "] { - if {[lsearch -exact $lst_station $station] == -1} { - puts stdout " - removing $station dependent files..." - if { [file exists $PARCELPATH/$station] } { catch { exec rm -rf $PARCELPATH/$station } } - if { [file exists $PARCELPATH/tmp/$station] } { catch { exec rm -rf $PARCELPATH/tmp/$station } } - if { [file exists $PARCELPATH/.adm/$station] } { catch { exec rm -rf $PARCELPATH/.adm/$station } } - } - } - } - } - } - array-print taberror - - return -} - -#================================================================= -# ARRAY-SET-FROM-CONFIGUL (egu) -# -# set "array_name" with couples (ul-level) get from "conf-file". -# with ul matching "ul-list" element -#================================================================= - -proc array-set-from-CONFIGUL { array_name conf_file ul_list } { - - upvar $array_name tab - if [file readable $conf_file ] { - set f [open $conf_file r] - set line {} - while {[gets $f line] >= 0 } { - if { [llength $line] != 0 } { - if { [ctype alnum [cindex [lindex $line 0] 0]] == 1 } { - set ul_name [lindex $line 0] - if { [lindex $ul_list 0] == "ALL" } { - set tab($ul_name) 0 - } else { - foreach ul $ul_list { - if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } { - set tab($ul_name) 0 - break - } - } - } - } - } - } - close $f - } else { - puts stderr "Error : Can not read $conf_file" - return 0 - } - - return 1 -} - - -#================================================================= -# ARRAY-SET-FROM-PATCHISTO (egu) -# -# set "array_name" with couples (ul-level) get from "patch-file" -# line of indice < max_i -# with ul matching "ul-list" element -# with level < max_p -#================================================================= - -proc array-set-from-PATCHISTO { array_name patch_file ul_list {max_i ALL} {max_p ALL} } { - - upvar $array_name tab - if { $max_i == "ALL" } { set maxindice 1000000 } else { set maxindice $max_i } - if { $max_p == "ALL" } { set maxpatch 1000000 } else { set maxpatch $max_p } - if [ file readable $patch_file ] { - set f [open $patch_file r] - set line {} - incr maxindice - while { [ gets $f line ] >= 0 && [ lindex $line 0 ] != $maxindice } { - if { [ llength $line ] != 0 } { - if { [ ctype alnum [ lindex $line 0 ] ] == 1 } { - - set ul_name [lindex $line 1] - set ul_level [lindex $line 2] - if { [lindex $ul_list 0] == "ALL" } { - set tab($ul_name) $ul_level - } else { - foreach ul $ul_list { - if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } { - set tab($ul_name) [expr min($ul_level,$maxpatch)] - break - } - } - } - } - } - } - close $f - } else { - #puts stderr "Info : Can't find $patch_file, no patch exist for this configuration" - return 0 - } - return 1 -} - -#================================================================= -# ARRAY-PRINT (egu) -#================================================================= -proc array-print { array_name } { - upvar $array_name tab - set lst [lsort [array names tab]] - foreach elt $lst { - set s [format "%-20s\t%s" $elt $tab($elt)] - puts stdout $s - } -} - -#================================================================= -# PARCEL-EXIST (egu) -# test if parcel exist -# Last modif: 27/07/98: for wok (param del become param ul) -#================================================================= - -proc parcel-exist { ul conf } { - set del [lindex [split $ul "-"] 0] - #verrue wok - if { $del == "wok" } { - if [file exists [wokparam -e %BAG_Home]/${ul}] { - return 1 - } else { - return 0 - } - } - #fin verrue wok - set ul_name ${del}-${conf} - set lst [ Winfo -p [finfo]:[finfo -W]] - if {[lsearch -exact $lst $ul_name] == -1} { return 0 } else { return 1 } -} -#================================================================= -# PARCEL-PATH (egu) -# return parcel-path, 0 if it parcel doesn't exist -# Last modif: 27/07/98: for wok (param del become param ul) -#================================================================= - -proc parcel-path { ul conf } { - set del [lindex [split $ul "-"] 0] - if [parcel-exist $ul $conf] { - if { $del == "wok" } { - set path [wokparam -e %BAG_Home]/${ul} - } else { - set path [wokinfo -p HomeDir [finfo]:[finfo -W]:${del}-${conf}] - } - return $path - } else { - return 0 - } -} -#================================================================= -# PARCEL-LEVEL (egu) -# return the patch top level already install, -1 if no install -# Last modif: 27/07/98: for wok (param del become param ul) -#================================================================= - -proc parcel-level { ul conf } { - if [parcel-exist $ul $conf] { - set del [lindex [split $ul "-"] 0] - if { $del == "wok" } { - set getpatch_file [parcel-path $ul $conf]/.${ul}.GETPATCH - } else { - set getpatch_file [parcel-path $ul $conf]/.${del}-${conf}.GETPATCH - } - if [file exists $getpatch_file] { - set list_level [lsort -integer [p-get-installed $getpatch_file]] - set index [llength $list_level] - incr index -1 - return [lindex $list_level $index] - } else { - return 0 - } - } else { - return -1 - } -} - -#================================================================= -# INSTALL-UL (egu) -# -# create and declare parcel, return 0 if failled -# if success : return patch level already install -# 27/07/98: verrue for wok (egu) ajout option force et runtime -# 10/08/98: supression option vernose et no-execute -#================================================================= - -proc install-ul { ul_name src_dir dest_dir conf tab_error RUNTIME FORCE} { - - ### variables setting - upvar $tab_error tab_err - - #verrue anti verion pour wok - set MYDEL [lindex [split $ul_name "-"] 0] - if { $MYDEL == "wok" } { - set MYPARCEL ${ul_name} - } else { - set MYPARCEL ${MYDEL}-${conf} - } - set WAREHOUSE_ADM_PATH [wokparam -e %[finfo -W]_Adm] - set wdeclare_file ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl - set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH - set parcellist_file ${WAREHOUSE_ADM_PATH}/ParcelList - - ### on verifie l'existence du fichier a decompresser - set tar ${src_dir}/${ul_name}.tar.gz - if ![file exists $tar] { - puts stderr ".... error" - puts stderr "Nothing done : Cannot find $tar" - set tab_err($ul_name) "Nothing done : Cannot find $tar" - return 0 - } - - ### test cause option -d : dest_dir peut deja exister - if { ![file exists $dest_dir] } { - puts stdout " - Mkdir $dest_dir ..." - if [catch { mkdir $dest_dir} mkstat] { - puts stderr ".... error" - puts stderr "Nothing done : Cannot create $dest_dir : $mkstat" - set tab_err($ul_name) "Nothing done : Cannot create $dest_dir : $mkstat" - return 0 - } - } - - ### security cleaning - if [file exists $getpatch_file] { - puts stdout " - remove $getpatch_file" - exec rm -rf $getpatch_file - } - - ### let's go - puts stdout " - Downloading $tar in $dest_dir..." - p-get-ptar $ul_name $dest_dir $tar - - ### in FORCE case without first classic install - - if { $MYDEL != "wok" && $FORCE } { - if ![file exists [wokparam -e %[finfo -W]_Adm]/${MYPARCEL}.edl] { - set FORCE 0 - puts stdout " -> Info: ${MYPARCEL} has never been declared, it will in spite of FORCE option" - } - } - - # if: verrue for wok: pas de declaration - if { $MYDEL != "wok" && !$FORCE } { - if { [file exists ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl] } { - puts stderr ".... error" - puts stderr "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists" - set tab_err($ul_name) "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists" - return 0 - } else { - puts stdout " - Wdeclare ${MYPARCEL} (Don't worry about \"Error : No entity...\")" - puts stdout " -> Info: Wdeclare create $wdeclare_file and update $parcellist_file" - - if { [catch { Wdeclare -p $MYPARCEL -d -DHome=${dest_dir} -DStations=[join [wokparam -e %[finfo -W]_Stations] " "] -DDelivery=${MYDEL} [finfo -W] } ] } { - puts stderr ".... error" - puts stderr "Error Wdeclare $MYPARCEL" - set tab_err($ul_name) "Error Wdeclare $MYPARCEL" - return 0 - } - } - - #declaration - set FACTORY_ADM_PATH [wokparam -e %[finfo]_Adm] - puts stdout " - Updating ${FACTORY_ADM_PATH}/${conf}.edl file... " - if {[maj-conf-edl $conf $MYPARCEL $RUNTIME] == 0 } { - puts stderr ".... error" - puts stderr "Cannot update ${FACTORY_ADM_PATH}/${conf}.edl" - set tab_err($ul_name) "Error : Cannot update ${FACTORY_ADM_PATH}/${conf}.edl" - return 0 - } - } - return 1 -} -#================================================================= -# MAJ-CONF-EDL (egu) -# Mise a jour du fichier BAG/adm/${conf}.edl -# return 1 si ok, 0 sinon -#================================================================= - -proc maj-conf-edl { conf new_parcel RUNTIME } { - set admdir [wokparam -e %[finfo]_Adm] - set lst_conf {} - set lst_runt {} - if [file exists ${admdir}/${conf}.edl] { - wokclose -a [wokparam -e %[finfo]_Home] - set lst_conf [join [wokparam -e %${conf}_Config] ] - ### test cause old version of $file.edl - if ![ catch { wokparam -e %${conf}_Runtime } toto ] { - set lst_runt [join [wokparam -e %${conf}_Runtime] ] - } - exec rm -rf ${admdir}/${conf}.edl - } else { - #lappend lst_conf $new_parcel - } - if { $RUNTIME } { - lappend lst_runt $new_parcel - } else { - lappend lst_conf $new_parcel - } - return [make-conf-edl $conf $lst_conf $lst_runt ] -} -#================================================================= -# MAKE-CONF-EDL (egu) -#================================================================= - -proc make-conf-edl { conf lst_conf lst_runt } { - set admdir [wokparam -e %[finfo]_Adm] - set path ${admdir}/${conf}.edl - if [ catch { set fid [ open $path w ] } ] { - return 0 - } else { - puts $fid "@set %${conf}_Config = \"$lst_conf\"; " - puts $fid "@set %${conf}_Runtime = \"$lst_runt\"; " - close $fid - wokclose -a [wokparam -e %[finfo]_Home] - return 1 - } -} -#================================================================= -# INSTALL-PATCH (egu) -#================================================================= - -proc install-patch { ul_name patch_level src_dir dest_dir conf tab_error} { - upvar $tab_error tab_err - set tar ${src_dir}/${ul_name}_${patch_level}.tar.gz - if ![catch { file exists $tar } ] { - set MYDEL [lindex [split $ul_name "-"] 0] - if { $MYDEL == "wok" } { - set MYPARCEL ${ul_name} - } else { - set MYPARCEL ${MYDEL}-${conf} - } - - #untar - puts stdout " - Downloading $tar in $dest_dir... " - p-get-ptar ${ul_name}_${patch_level} $dest_dir $tar - - # updating .GETPATCH file - set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH - puts stdout " - Updating $getpatch_file file..." - set now [string range [fmtclock [getclock]] 0 18] - if [file exists $getpatch_file] { - set lf [putils:FILES:FileToList $getpatch_file] - } else { - set lf {} - } - set s [format "%s %s %s %s" $ul_name ${ul_name}_${patch_level} $dest_dir $now] - lappend lf $s - putils:FILES:ListToFile $lf $getpatch_file - - - } else { - puts stderr ".... error" - puts stderr "Nothing done : Cannot find $tar" - set tab_err(${ul_name}_${patch_level}) "Nothing done : Cannot find $tar" - return 0 - } - return 1 -} - -#================================================================= -# P-GET-INSTALLED (egu) -# -# return list of patch'numbers already write in GETPATCH file -# return null list if file doesn't exist -#================================================================= - -proc p-get-installed { file } { - if { ![file exists $file] } { - return {} - } else { - set ll {} - foreach l [putils:FILES:FileToList $file] { - lappend ll [lindex [split [lindex $l 1] _] end] - } - return $ll - } -} - -###============================================================================================== - -proc p-get-ptar { MYUL ULBAG tar } { - - global tcl_platform - set savpwd [pwd] - cd $ULBAG - - if { "$tcl_platform(platform)" == "unix" } { - - putils:EASY:tar untarZ ${tar} - - } elseif { "$tcl_platform(platform)" == "windows" } { - set dirtmp [putils:EASY:tmpname ulget[id process]] - catch { mkdir $dirtmp } - putils:FILES:copy ${tar} $dirtmp/${MYUL}.tar.gz - - if { [file exists $dirtmp/${MYUL}.tar] } { - unlink $dirtmp/${MYUL}.tar - } - putils:FILES:uncompress $dirtmp/${MYUL}.tar.gz - if { [file exists $dirtmp/${MYUL}.tar] } { - puts stderr "Info : Downloading $tar in [pwd]... " - putils:EASY:tar untar $dirtmp/${MYUL}.tar - } - unlink $dirtmp/${MYUL}.tar - unlink -nocomplain $dirtmp - } - cd $savpwd - return -} - -# -# ###################################################################### -# -proc putils:EASY:GETOPT { prm table tablereq usage listarg } { - - upvar $table TLOC $tablereq TRQ $prm PARAM - catch {unset TLOC} - - set fill 0 - - foreach e $listarg { - if [regexp {^-.*} $e opt] { - if [info exists TRQ($opt)] { - set TLOC($opt) {} - set fill 1 - } else { - puts stderr "Error: Unknown option $e" - eval $usage - return -1 - } - } else { - if [info exist opt] { - set fill [regexp {value_required:(.*)} $TRQ($opt) all typ] - if { $fill } { - if { $TLOC($opt) == {} } { - set TLOC($opt) $e - set fill 0 - } else { - lappend PARAM $e - } - } else { - lappend PARAM $e - } - } else { - lappend PARAM $e - } - } - } - - foreach e [array names TLOC] { - if { [regexp {value_required:(.*)} $TRQ($e) all typ ] == 1 } { - if { $TLOC($e) == {} } { - puts "Error: Option $e requires a value" - eval $usage - return -1 - } - switch -- $typ { - - file { - } - - string { - } - - date { - } - - list { - set TLOC($e) [split $TLOC($e) ,] - } - - number { - if ![ regexp {^[0-9]+$} $TLOC($e) n ] { - puts "Error: Option $e requires a number." - eval $usage - return -1 - } - } - - } - - } - } - - return -} -# -# -# -proc putils:EASY:tar { option args } { - - catch { unset command return_output } - - switch -- $option { - - tarfromroot { - set name [lindex $args 0] - set root [lindex $args 1] - append command {tar cf } $name " " $root - } - - tarfromliste { - set name [lindex $args 0] - set list [lindex $args 1] - if [file exists $list] { - set liste [putils:FILES:FileToList [lindex $args 1]] - append command {tar cf } $name - foreach f $liste { -#fsa - set listeeval [eval glob $f] - foreach ff $listeeval { - append command " " $ff - } -#fsa append command " " $f - } - } else { - error "File $list not found" - return -1 - } - } - - untar { - set name [lindex $args 0] - append command {tar xomf } $name - } - - untarZ { - set name [lindex $args 0] -#fun append command uncompress { -c } $name { | tar xof - >& /dev/null } - append command gzip { -d -c } $name { | tar xomf - >& /dev/null } - } - - - ls { - set return_output 1 - set name [lindex $args 0] - append command {tar tvf } $name - } - - lsZ { - set return_output 1 - set name [lindex $args 0] -#fun append command uncompress { -c } $name { | tar tvf - } - append command gzip -d { -c } $name { | tar tvf - } - } - - } - - ;#puts "command = $command" - - if [catch {eval exec $command} status] { - puts stderr "Tar messages in command: $command" - puts stderr "Status : $status" - set statutar 1 - } else { - if [info exist return_output] { - set statutar $status - } else { - set statutar 1 - } - } - - return $statutar -} -# -# -# -proc putils:FILES:ListToFile { liste path } { - if [ catch { set id [ open $path w ] } ] { - return 0 - } else { - foreach e $liste { - puts $id $e - } - close $id - return 1 - } -} -# -# -# -proc putils:FILES:FileToList { path {sort 0} {trim 0} {purge 0} {emptl 1} } { - if ![ catch { set id [ open $path r ] } ] { - set l {} - while {[gets $id line] >= 0 } { - if { $trim } { - regsub -all {[ ]+} $line " " line - } - if { $emptl } { - if { [string length ${line}] != 0 } { - lappend l $line - } - } else { - lappend l $line - } - } - close $id - if { $sort } { - return [lsort $l] - } else { - return $l - } - } else { - return {} - } -} -# -# -# -proc putils:FILES:copy { fin fout } { - if { [catch { set in [ open $fin r ] } errin] == 0 } { - if { [catch { set out [ open $fout w ] } errout] == 0 } { - set nb [copyfile $in $out] - close $in - close $out - return $nb - } else { - puts stderr "Error: $errout" - return -1 - } - } else { - puts stderr "Error: $errin" - return -1 - } -} -# -# -## -proc putils:FILES:compress { fullpath } { - if [file exists ${fullpath}.gz] { - catch {unlink ${fullpath}.gz} - } -#fsa if [catch { exec compress -f $fullpath} status] - if [catch { exec gzip -f $fullpath} status] { - puts stderr "Error while compressing ${fullpath}: $status" - return -1 - } else { - return 1 - } -} - -proc putils:FILES:uncompress { fullpath } { -#fsa if [catch {exec uncompress -f $fullpath} status] -#fun:patch K4B_7 - if [catch {exec gzip -d -f $fullpath} status] { - puts stderr "Error while uncompressing ${fullpath}: $status" - return -1 - } else { - return 1 - } -} - -proc putils:EASY:tmpname { name } { - global env - global tcl_platform - if { "$tcl_platform(platform)" == "unix" } { - if [info exists env(TMPDIR)] { - return [file join $env(TMPDIR) $name] - } else { - return [file join "/tmp" $name] - } - } elseif { "$tcl_platform(platform)" == "windows" } { - return [file join $env(TMP) $name] - } - return {} -} - - diff --git a/src/WOKTclLib/padmin.tcl b/src/WOKTclLib/padmin.tcl deleted file mode 100755 index 56db109..0000000 --- a/src/WOKTclLib/padmin.tcl +++ /dev/null @@ -1,149 +0,0 @@ - -############################################################################# -# -# P A D M I N -# ___________ -# -############################################################################# -# -# Usage -# -proc padminUsage { } { - puts stderr \ - { - Usage : padmin [ options ... ] [pnam,...] - - This command operates on elements in the central BAG. - - Components: A component represents an UL and all its versions - - -param : List parameters relative to the BAG. - - -ls : List kwown components. - -rm : Deletes the components pnam1,pnam2 ... This will destroy the VOB associated and all - label attached to it in the Admin VOB. - - -mkadm : Creates the vob administration. - - -noexec : Don't execute. Only display script file. - - Types: Set of rules used to store files. - - -lsext : List known extensions. For more information, use -magic and explore - the magic file. - - - } - return -} -# -# Point d'entree de la commande -# -proc padmin { args } { - - set tblreq(-h) {} - - set tblreq(-mkadm) {} - set tblreq(-noexec) {} - set tblreq(-rm) value_required:list - - set tblreq(-lsext) {} - - set tblreq(-ls) value_required:string - - set tblreq(-magic) {} - - set tblreq(-param) {} - - set param {} - - if { [wokUtils:EASY:GETOPT param tabarg tblreq padminUsage $args] == -1 } return - - if { [info exists tabarg(-h)] } { - padminUsage - return - } - - if { [info exists tabarg(-param)] } { - padmin:param - return - } - - - set execute 1 - if { [info exists tabarg(-noexec)] } { set execute 0 } - - if { [info exists tabarg(-mkadm)] } { - set lvws [concat [wokBAG:view:Init IMPORT] [wokBAG:view:Init EXPORT]] - padmin:execute [wokUtils:EASY:stobs2 $lvws] $execute - set ladm [wokBAG:admin:Create] - padmin:execute [wokUtils:EASY:stobs2 $ladm] $execute - return - } - - if { [info exist tabarg(-rm)] } { - foreach pnam $tabarg(-rm) { - set res [wokBAG:cpnt:Del $pnam] - foreach lbs [wokBAG:cpnt:Patches $pnam] { - set res [concat $res [wokBAG:label:Del $lbs]] - } - padmin:execute $res $execute - } - return - } - - - - if { [info exist tabarg(-ls)] } { - puts "not yet" - } - - - if { [info exist tabarg(-lsext)] } { - foreach e [wokBAG:magic:kex] { - puts $e - } - return - } - - if { [info exist tabarg(-magic)] } { - foreach e [wokUtils:LIST:SortPurge [wokBAG:magic:Name]] { - puts "$e" - } - return - } - - - -} -;# -;# -;# -proc padmin:execute { res execute } { - if { $execute } { - wokUtils:FILES:ListToFile $res execute - wokUtils:EASY:Execute execute - unlink execute - } else { - foreach l $res { - puts "$l" - } - } -} -;# -;# Je m'emmerddre , tai vi o phap troi lanh qua !! -;# -proc padmin:param { } { - set maxl 0 - foreach name [wokBAG:bag:Names] { - set lb [$name 1] - if {[string length $lb] > $maxl} { - set maxl [string length $lb] - } - } - set maxl [expr {$maxl + 2}] - foreach name [wokBAG:bag:Names] { - puts stdout [format "%-*s %s" $maxl [$name 1] [$name]] - } - return -} diff --git a/src/WOKTclLib/pinstall.tcl b/src/WOKTclLib/pinstall.tcl deleted file mode 100755 index 7f4dc37..0000000 --- a/src/WOKTclLib/pinstall.tcl +++ /dev/null @@ -1,41 +0,0 @@ -proc pinstallUsage {} { - puts stderr { usage : pinstall parcelname } -} - -proc pinstall {args} { - - set tblreq(-h) {} - set param {} - - if { [wokUtils:EASY:GETOPT param table tblreq pinstallUsage $args] == -1 } return - - if { [info exists table(-h)] } { - pinstallUsage - return - } - - set ULNAME [lindex $param 0] - if { $ULNAME == {} } { - pinstallUsage - return - } - - set thefact [Sinfo -f] - set theware [finfo -W $thefact] - puts "Installing $ULNAME from Warehouse ${thefact}:${theware}" - wokcd ${thefact}:${theware} - wokcd $ULNAME - set theullibdir [wokparam -e WOKEntity_libdir ${thefact}:${theware}:${ULNAME}] - cd $theullibdir - foreach atempld [glob *.ldt] { - source $atempld - set goodlen [expr [string length $atempld] - 2] - set aldfile [crange $atempld 0 $goodlen] - set ldfileid [open $aldfile w] - puts $ldfileid [WOKDeliv_Makeld $thefact] - if {![catch {set esvers [wokparam -e %ENV_EngineStarterVersion]}]} { - puts $ldfileid $esvers - } - close $ldfileid - } -} diff --git a/src/WOKTclLib/pintegre.tcl b/src/WOKTclLib/pintegre.tcl deleted file mode 100755 index 6505356..0000000 --- a/src/WOKTclLib/pintegre.tcl +++ /dev/null @@ -1,698 +0,0 @@ -############################################################################# -# -# P I N T E G R E -# _______________ -# -############################################################################# -# -# Usage -# -proc pintegreUsage { } { - puts stderr \ - { - usage : pintegre [ ] - - is a number. The range of the report in the queue. - You get this number by using the command : pstore -ls - - -all : Process all reports in the queue. - -noexec : Don't execute. Only display script file. - -dump : Trace of commands in file. If file exists append commands. - } - return -} -# -# Point d'entree de la commande -# -proc pintegre { args } { - - set tblreq(-h) {} - set tblreq(-all) {} - set tblreq(-v) {} - set tblreq(-noexec) {} - set tblreq(-dump) value_required:string - - set param {} - if { [wokUtils:EASY:GETOPT param tabarg tblreq pintegreUsage $args] == -1 } return - set VERBOSE [info exists tabarg(-v)] - - if { [info exists tabarg(-h)] } { - pintegreUsage - return - } - - set fshop nil - - if { [info exists tabarg(-all)] } { - set LISTREPORT [pstore:Report:Get all $fshop ] - } else { - if { [llength $param] == 1 } { - set ID [lindex $param 0] - set LISTREPORT [pstore:Report:Get $ID $fshop ] - } else { - pintegreUsage - return -1 - } - } - - set execute 1 - if { [info exists tabarg(-noexec)] } { set execute 0 } - - if { [info exists tabarg(-dump)] } { - set FileDump $tabarg(-dump) - } - - set savpwd [pwd] - - foreach REPORT $LISTREPORT { - - if { [pstore:Report:Process $REPORT] != 1 } { - return - } - if { [set l [pstoreReportWasThere]] != {} } { - foreach f $l { - puts stderr "File $f has been removed since storage of that report." - } - pstore:Report:UnProcess $REPORT - return - } - pstoreReportHeader ReportHeader - pstoreReportBody ReportBody - set Config [pstoreReportConfig] - set pnam $ReportHeader(Parcel) - set label [wokBAG:cpnt:GetLabel $pnam] - set umaked [split $ReportHeader(Umaked) ,] - set tmpconf [lindex $Config 0] - - set depends [wokBAG:cfg:Complete $tmpconf $umaked] - - pstore:Report:UnProcess $REPORT - - if { $VERBOSE } { - puts stderr "Processing report in $REPORT" - puts stderr "Will use label $label to stick elements of this update." - puts stderr "Requires $umaked" - puts stderr "That is: $depends" - } - - set init $ReportHeader(Init) ;# Si Init != "NO" => level a creer et a updater si existe pas. - - if { "$init" != "NO" } { - cd $ReportHeader(Revision) - set x_1 [wokBAG:cpnt:Init $pnam $ReportHeader(Revision) $ReportHeader(FrigoName)/cvt_data] - set x_2 [wokBAG:journal:Init $pnam $ReportHeader(Journal)] - set x_3 [wokBAG:label:Init $label] - set x_4 [wokBAG:hlink:Init $pnam] - set x_5 [wokBAG:label:Stick $label $ReportHeader(Master)] - set x_6 [wokBAG:label:Stick $label [wokBAG:journal:name $pnam]] - set res [concat $x_1 $x_2 $x_3 $x_4 $x_5 $x_6] - } else { - set x_mod {} - foreach e [array names ReportBody ##,*] { - set dir [file join $ReportHeader(Master) [string range $e 4 end]] - if { $ReportBody($e) != {} } { - set x_mod [concat $x_mod [wokBAG:cpnt:UpdateDirectory $dir $ReportBody($e)]] - } - } - set x_add {} - foreach e [lsort -command wokUtils:FILES:Depth [array names ReportBody ++,*]] { - set dir [file join $ReportHeader(Master) [string range $e 4 end]] - if { $ReportBody($e) != {} } { - set x_add [concat $x_add [wokBAG:cpnt:CreateDirectory $dir $ReportBody($e)]] - } - } - set x_del {} - foreach e [lsort -decreasing -command wokUtils:FILES:Depth [array names ReportBody --,*]] { - set dir [file join $ReportHeader(Master) [string range $e 4 end]] - if { $ReportBody($e) != {} } { - set x_del [concat $x_del [wokBAG:cpnt:DeleteDirectory $dir $ReportBody($e)]] - } - } - set x_labinit [wokBAG:label:Init $label] - set j_upd [wokBAG:journal:Update $pnam $ReportHeader(Journal)] - set x_lab [wokBAG:label:Stick $label $ReportHeader(Master)] - set j_lab [wokBAG:label:Stick $label [wokBAG:journal:name $pnam]] - - set res [concat $x_mod $x_add $x_del $x_labinit $x_lab $j_upd $j_lab] - - } - - if { $depends != {} } { - set actdep [wokBAG:cfg:Complete $tmpconf $depends] - if { $actdep != {} } { - if { $VERBOSE } { puts stderr "Will link $label to $actdep" } - set res [concat $res [wokBAG:hlink:Attach $label $actdep]] - } - } - - if { [info exists FileDump] } { - wokUtils:FILES:AppendListToFile $res $FileDump - } - - wokUtils:FILES:ListToFile [wokUtils:EASY:stobs2 $res] $ReportHeader(COMMAND)_1 - if { $execute } { - if { [set fileid [wokBAG:errlog:Add $pnam]] != {} } { - wokUtils:EASY:Execute $ReportHeader(COMMAND)_1 sh $fileid - close $fileid - } else { - puts "Unable to open log file for writing" - return - } - } else { - wokUtils:EASY:Execute $ReportHeader(COMMAND)_1 noexec stdout - } - - ;# Mise a jour des levels - - puts "Mise a jour levels Config = $Config" - foreach cfg $Config { - set LABELTMP $ReportHeader(LABEL).$cfg - wokUtils:FILES:ListToFile $label $LABELTMP - if { "$init" != "NO" } { - puts -nonewline "on fait INIT ($cfg) ..." - ;# Init = ANAME il faut soit creer le level soit l'updater avec la nouvelle UL. - set flevel [wokBAG:level:file $init $cfg] - if [file exists $flevel] { - puts "dans un level qui existe" - set contents [wokUtils:FILES:FileToList $flevel] - wokUtils:FILES:ListToFile [concat $contents $label] $LABELTMP - set xlv [wokBAG:level:update $flevel $LABELTMP] - } else { - puts "dans un level qui n'existe pas " - set xlv [wokBAG:level:Init $init $cfg $LABELTMP] - } - } else { - ;# Init = NO Il faut recuperer le level auquel appartient pnam - set lvl [wokBAG:level:find $label $cfg] - if { $lvl != {} } { - wokUtils:FILES:ListToFile [lindex $lvl 1] $LABELTMP - set xlv [wokBAG:level:update [lindex $lvl 0] $LABELTMP] - } else { - puts stderr "Error updating levels for $label in $cfg . Level not found" - return - } - } - wokUtils:FILES:ListToFile [wokUtils:EASY:stobs2 $xlv] $ReportHeader(COMMAND)_2 - if { $execute } { - if { [set fileid [wokBAG:errlog:Add $pnam]] != {} } { - wokUtils:EASY:Execute $ReportHeader(COMMAND)_2 sh $fileid - close $fileid - } else { - puts "Unable to open log file for writing" - return - } - } else { - wokUtils:EASY:Execute $ReportHeader(COMMAND)_2 noexec stdout - } - } - - - ;# Destruction du report - if { $execute } { pstore:Report:Del $REPORT 1 } - - } - cd $savpwd - return -} - -############################################################################# -# -# P G E T -# _______ -# -############################################################################# -# -# Usage -# -proc pgetUsage { } { - puts stderr \ - { - Usage : pget [-h] [-d dir] -conf [-parcel ] [-P patch] - -h : this help - -d dir : Uses dir as directory for downloading files. - -conf name : configuration name. This parameter is required. - -parcel : list of one or more parcel. if this parameter is not given - install all parcels listed in name. - -v : verbose mode - -noexec : Display update operations but don't perform them. - [-P num ] : is a patch number. By default the parcel is downloaded up to its last patch. - This option can be used to specify the higher patch level you want to download. - This option cannot be used with more than one parcel specified in the -parcel option. - - Acces modes : By default, files of parcels are created (copied) in the bag of your factory. If you - specify -view then a ClearCase view will be configured so that - you can access (read) the parcels without copying them. Note that must - already exists. - } -} -# -# Point d'entree de la commande -# -proc pget { args } { - - set tblreq(-h) {} - set tblreq(-conf) value_required:string - set tblreq(-parcel) value_required:list - set tblreq(-d) value_required:string - set tblreq(-v) {} - set tblreq(-mode) value_required:string - set tblreq(-P) value_required:number - set tblreq(-cat) {} - set tblreq(-noexec) {} - - set param {} - if { [wokUtils:EASY:GETOPT param tabarg tblreq pgetUsage $args] == -1 } return - - if { $param != {} } { - pgetUsage - return - } - - - if { [info exists tabarg(-h)] } { - pgetUsage - return - } - - set VERBOSE [info exists tabarg(-v)] - - if { [info exists tabarg(-conf)] } { - set conf $tabarg(-conf) - } else { - pgetUsage - return - } - - if { [info exists tabarg(-cat)] } { - foreach pnam [lsort [wokBAG:cfg:read $conf]] { - puts $pnam - } - return - } - - - if [info exists tabarg(-mode)] { - set mode $tabarg(-mode) - } else { - set mode copy - } - - set view [wokBAG:view:GetViewExport] - ;# tester ici que la vue view existe - - set fact [wokinfo -f [wokcd]] - - if { [info exists tabarg(-d)] } { - set down $tabarg(-d) - if ![file exists $down] { - if { [wokUtils:DIR:create $down] == -1 } { - return - } - } - } else { - set down {} - } - - if { [info exists tabarg(-parcel)] } { - set lnuk $tabarg(-parcel) - } else { - set luli [pget:ulist read $conf $fact $down {} $VERBOSE] - if { $luli != {} } { - set lnuk {} - foreach p $luli { - if { $p != {} } { - if { "[wokBAG:cpnt:parse extension $p]" == "$conf" } { - lappend lnuk [wokBAG:cpnt:parse root $p] - } else { - puts stderr "Mismatch version for $p . Ignored." - } - } - } - } else { - puts stderr "Please Specify at least one parcel of this config." - puts stderr "All parcels defined in this config are:" - pget -cat -conf $conf - return - } - } - - if { [info exists tabarg(-P)] } { - if { [llength $lnuk] == 1 } { - set preq $tabarg(-P) - } else { - puts stderr "You cannot use -P option with more than one parcel." - return - } - } - - if { $VERBOSE } { puts "lnuk = $lnuk" } - # lnuk est la liste des ULs demandees dans la ligne de commande - # wokBAG:cfg:read retourne la liste des Uls de au dernier niveau - # pget:sink fait la correspondance CCL <-> CCL-B4-5_13 - # Il faudra mettre ici le niveau si il est demande et separer BASE, MODEL, APPLI - - set linst [pget:sink $lnuk [wokBAG:cfg:read $conf {}]] - if { $linst == {} } { - puts "No match for $lnuk in config $conf." - return - } - - # si preq est settee => il n'y a qu'une parcel , et on a demande une version precise. - # lcomp contient pour le level demandee la plus haute version connue. - # verifier que preq est inferieur ou egal a cette version. - - if [info exists preq] { - set vx [wokBAG:cpnt:parse version $linst] - if { $preq > $vx } { - puts stderr "Patch level $preq does not exist. Higher level is $vx." - return - } - set lres [wokBAG:cpnt:parse basename $linst]_${preq} - } else { - set lres $linst - } - - if { $VERBOSE } { puts "linst = $linst" } - ;# 1. Calcul du fichier ConfigSpec pour configurer la vue d'acces au Bag - ;# - wokBAG:cfg:ListToConfig $lres [set configspec [wokUtils:FILES:tmpname viewof[id user].setcs]] - - if { $VERBOSE } { - foreach x [wokUtils:FILES:FileToList $configspec] { puts $x } - } - - if { $VERBOSE } { - puts "Configuring view $view.." - } - - ;# 2. execute ( config + demarrage ) - ;# - set cfw [concat [wokBAG:view:setcs $configspec $view] [wokBAG:view:startview $view]] - - ;# 3. La demarrer - ;# - wokUtils:FILES:ListToFile $cfw [set cmdget [wokUtils:FILES:tmpname cmdget[id user]]] - wokUtils:EASY:Execute $cmdget sh stdout - - ;# 4. Mode increment, ou copy, ou view - ;# - switch -- $mode { - - increment { - set lget {} - foreach pnam_x $lres { - set jnl [wokBAG:journal:read ${pnam_x}] - set dfrom [wokBAG:cpnt:GetExportName [wokBAG:cpnt:parse basename ${pnam_x}]] - set dto [pget:down $conf $fact $down $pnam_x] - if { $VERBOSE } { puts stderr "Downloading ${pnam_x} in $dto" } - set lget [concat $lget [pget:getfiles ${pnam_x} $jnl $dfrom $dto]] - } - - ;# 5. Executer la copie - ;# - if { [info exists tabarg(-noexec)] } { - foreach x $lget { - puts "$x" - } - } else { - wokUtils:EASY:TclCommand $lget $VERBOSE - } - - pget:ulist write $conf $fact $down $lres $VERBOSE - } - - copy { - foreach pnam_x $lres { - set dfrom [wokBAG:cpnt:GetExportName [wokBAG:cpnt:parse basename ${pnam_x}]] - if { [file exist $dfrom] } { - set dto [pget:down $conf $fact $down ${pnam_x}] - if { $VERBOSE } { puts stderr "Downloading ${pnam_x} in $dto" } - set FunCopy wokUtils:FILES:copy - if { [info exists tabarg(-noexec)] } { set FunCopy pget:CopyNothing } - wokUtils:FILES:recopy $dfrom $dto $VERBOSE $FunCopy - } else { - puts stderr "Error: Directory $dfrom is unreachable." - } - } - - pget:ulist write $conf $fact $down $lres $VERBOSE - } - - view { - } - - } - - return -} -# -# retourne le nom du dir ou il faut descendre pnam_x -# -proc pget:down { conf fact down pnam_x } { - if { $down == {} } { - set root [wokinfo -p HomeDir ${fact}:[finfo -W $fact]] - return $root/[wokBAG:cpnt:parse root ${pnam_x}]-${conf} - } else { - return $down - } -} -# -# Lit/Ecrit la liste des Uls du bag de se trouvant listes dans . -# De fait le contenu de : Factory/adm/K4E_Config. -# ya qqche dans WOK pour lire mais pas pour ecrire -# quand on fait read: ulist = {} retourne dans la liste le contenu du parametre K4E_Config -# quand on fait write ulist = suite de pnam_x retourne une liste ayant le format suivant -# {KERNEL KERNEL-K4E down KERNEL-B4-2 8} -# -proc pget:ulist { option conf fact down ulist VERBOSE } { - switch -- $option { - - read { - set lvc [wokparam -l ${conf} $fact] - if { $lvc != {} } { - if { [lsearch -regexp $lvc %${conf}_Config=*] != -1 } { - catch { set value [wokparam -e %${conf}_Config $fact] } - if [info exists value] { - return [split [join $value]] - } else { - return {} - } - } else { - return {} - } - } else { - return {} - } - } - - write { - set bagName ${fact}:[finfo -W $fact] - set bagAdm [wokinfo -p AdmDir $bagName] - set ParcelListFile [wokinfo -p ParcelListFile $bagName] - set lp [wokUtils:FILES:FileToList $ParcelListFile] - set Config "@set %${conf}_Config = \"" - set Runtime "@set %${conf}_Runtime = \"" - foreach pnam_x $ulist { - set pclName [wokBAG:cpnt:parse root ${pnam_x}] - set pclHome [pget:down $conf $fact $down ${pnam_x}] - set pclAdm $pclHome/adm - catch { mkdir -path $pclAdm } - set edl [pget:declare ${pclName}-${conf} $pclName $pclHome $pclAdm] - if [wokUtils:FILES:ListToFile [list $edl] $bagAdm/${pclName}-${conf}.edl] { - if { $VERBOSE } { puts stderr "File $bagAdm/${pclName}-${conf}.edl has been created." } - } else { - puts stderr "Unable to create file $bagAdm/${pclName}-${conf}.edl" - } - pget:WVersion $bagName $conf ${pclName} ${pnam_x} - ;#if [wokUtils:FILES:ListToFile ${pnam_x} $pclAdm/${pclName}.version] { - ;#if { $VERBOSE } { puts stderr "File $pclAdm/${pclName}.version has been created" } - ;#} else { - ;# puts stderr "Unable to create file $pclAdm/${pclName}.version" - ;#} - append Config " ${pclName}-${conf}" - if { [lsearch $lp ${pclName}-${conf}] == -1 } { lappend lp ${pclName}-${conf} } - } - append Config "\";" - append Runtime "\";" - if [wokUtils:FILES:ListToFile [list $Config $Runtime] [wokinfo -p AdmDir $fact]/${conf}.edl] { - if { $VERBOSE } { puts stderr "File [wokinfo -p AdmDir $fact]/${conf}.edl has been updated" } - } else { - puts stderr "Unable to update file [wokinfo -p AdmDir $fact]/${conf}.edl" - } - if [wokUtils:FILES:ListToFile $lp $ParcelListFile] { - if { $VERBOSE } { puts stderr "File $ParcelListFile has been updated."} - } else { - puts stderr "Unable to update file $ParcelListFile." - } - } - } - -} -# -# retourne les occurences de lnuk = { CCL GRAPHIC KERNEL VIEWERS .. } -# trouvees dans loff = { KERNEL-B4-2_x CCL-B4-2_y GRAPHIC-B4-2_z ...} -# -proc pget:sink { lnuk loff } { - foreach p $loff { - set map([wokBAG:cpnt:parse root $p]) $p - } - set l {} - foreach p $lnuk { - if [info exists map($p)] { - lappend l $map($p) - } else { - puts stderr "Warning : $p not found in required config. Ignored" - } - } - return $l -} -;# -;# retourne la liste des commandes a passer pour updater le directory dest avec le patch pnam_x -;# La vue doit avoir ete configuree (element * pnam_x -nocheckout) -;# -proc pget:getfiles { pnam_x jnl dmas dest } { - if ![ catch { set fileid [ open $jnl r ] } ] { - pprepare:header:read $fileid RepHeader - wokUtils:EASY:ReadCompare ReportBody $fileid - if ![wokUtils:EASY:MapEmpty ReportBody] { - set x_mod {} - set vers ${pnam_x} - foreach e [array names ReportBody ##,*] { - set dir [string range $e 4 end] - if { $ReportBody($e) != {} } { - set x_mod [concat $x_mod [pget:UpdateDirectory $vers $dest $dmas $dir $ReportBody($e)]] - } - } - - set x_add {} - foreach e [lsort -command wokUtils:FILES:Depth [array names ReportBody ++,*]] { - set dir [string range $e 4 end] - if { $ReportBody($e) != {} } { - set x_add [concat $x_add [pget:CreateDirectory $vers $dest $dmas $dir $ReportBody($e)]] - } - } - - set x_del {} - foreach e [lsort -decreasing -command wokUtils:FILES:Depth [array names ReportBody --,*]] { - set dir [string range $e 4 end] - if { $ReportBody($e) != {} } { - set x_del [concat $x_del [pget:DeleteDirectory $vers $dest $dmas $dir $ReportBody($e)]] - } - } - - } - close $fileid - return [concat $x_mod $x_add $x_del] - } else { - puts stderr "pget:getfiles. Unable to open $jnl for reading." - return {} - } -} -;# -;# -;# -proc pget:UpdateDirectory { vers dest dmas dir lfile } { - set l {} - foreach e $lfile { - if [regexp { #[ ]*([^ ]*)[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem from] { - lappend l "wokUtils:FILES:copy [file join $dmas $dir $basn]@@/main/$vers [file join $dest $dir $basn]" - } elseif [regexp { \-[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem] { - lappend l "wokUtils:FILES:delete [file join $dest $dir $basn]" - } elseif [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] { - lappend l "wokUtils:FILES:copy [file join $dmas $dir $basn]@@/main/$vers [file join $dest $dir $basn]" - } else { - puts stderr "pget:UpdateDirectory: Line $e does not match anything !!" - return {} - } - } - return $l -} -;# -;# -;# -proc pget:CreateDirectory { vers dest dmas dir lfile } { - lappend l "wokUtils:DIR:create [file join $dest $dir]" - foreach e $lfile { - if [regexp { \+[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn from] { - if [file exists [file join $dmas $dir $basn]@@/main/$vers] { - lappend l "wokUtils:FILES:copy [file join $dmas $dir $basn]@@/main/$vers [file join $dest $dir $basn]" - } else { - puts stderr "pget:CreateDirectory: [file join $dmas $dir $basn]@@/main/$vers not found" - } - } else { - puts stderr "pget:CreateDirectory: Line $e does not match anything !!" - return {} - } - } - return $l -} -;# -;# Removes all files in dir but dont removes directory itself. Merdier aggregats -;# -proc pget:DeleteDirectory { vers dest dmas dir lfile } { - foreach e $lfile { - if [regexp { \-[ ]*([^ ]*)[ ]*([^ ]*)} $e all basn elem] { - lappend l "wokUtils:FILES:delete [file join $dest $dir $basn]" - } - } - ;#lappend l "rmdir [file join $dest $dir]" - return $l -} -;# -;# Remplace Wdeclare.. -;# 1. ce qui est retourne doit etre ecrit dans CCL-K4E.edl dans l'adm du bag et s'appeler CCL-K4E.edl. -;# Wdeclare -p ${pclName}-${conf} -d -DHome=$pclHome -DDelivery=$pclName $bagName -;# -;# p = CCL-K4E -;# d = CCL -;# h = /adv_22/WOK/BAG/CCL-K4E -;# a = /adv_22/WOK/BAG/CCL-K4E/adm -;# -proc pget:declare { p d h a } { - append st {@ifnotdefined ( %__PNAM_EDL ) then} \n - append st {@set %__PNAM_EDL = "";} \n - append st {@set %__PNAM_Home = "__HOME";} \n - append st {@set %__PNAM_Adm = "__ADM";} \n - append st {@set %__PNAM_Stations = "sun ao1 sil hp";} \n - append st {@set %__PNAM_DBMSystems = " DFLT ";} \n - append st {@set %__PNAM_Delivery = "__NAME";} \n - append st {@ifdefined(%ShopName) then} \n - append st {@uses "USECONFIG.edl";} \n - append st {@endif;} \n - append st {@endif;} \n - regsub -all {__PNAM} $st $p r1 - regsub -all {__NAME} $r1 $d r2 - regsub -all {__HOME} $r2 $h r3 - regsub -all {__ADM} $r3 $a xx - return $xx -} -;# -;# Retourne le nom de l'UL -;# -proc pget:RVersion { bagName conf PclName } { - if [wokinfo -x ${bagName}:${PclName}-${conf}] { - set pclAdm [wokinfo -p admdir ${bagName}:${PclName}-${conf}]/${PclName}.version - return [wokUtils:FILES:FileToList $pclAdm] - } else { - return {} - } -} -;# -;# -;# -proc pget:WVersion { bagName conf PclName version } { - set pclAdm [wokinfo -p admdir ${bagName}:${PclName}-${conf}]/${PclName}.version - return [wokUtils:FILES:ListToFile $version $pclAdm] -} -;# -;# -;# -proc pget:specialwok { } { -} -;# -;# copy avec -noexec mode. -;# -proc pget:CopyNothing { f1 f2 } { - puts stderr "copy $f1 $f2" - return -} diff --git a/src/WOKTclLib/pnews.tcl b/src/WOKTclLib/pnews.tcl deleted file mode 100755 index 77c5df3..0000000 --- a/src/WOKTclLib/pnews.tcl +++ /dev/null @@ -1,61 +0,0 @@ -############################################################################# -# -# P N E W S -# _________ -# -############################################################################# -# -# Usage -# -proc wokpnewsUsage { } { - puts stderr \ - { - Usage : pnews [-h] [-parcel ] - - } -} -# -# Point d'entree de la commande -# -proc pnews { args } { - - set tblreq(-h) {} - set tblreq(-parcel) value_required:string - - set param {} - if { [wokUtils:EASY:GETOPT param tabarg tblreq wokpnewsUsage $args] == -1 } return - - - if { [info exists tabarg(-h)] } { - wokpnewsUsage - return - } - - set VERBOSE [info exists tabarg(-v)] - - if { [info exists tabarg(-parcel)] } { - pnews:journal $tabarg(-parcel) - return - } - - return -} -# -# Retourne la liste des Uls du bag de se trouvant listes dans -# -proc pnews:journal { {regx *} } { - wokBAG:label:dump JNL long - set blank " " - if [array exists JNL] { - set i 0 - foreach n [lsort -command wokUtils:TIME:clrsort [array names JNL]] { - set i [incr i] - set pnam [lindex [split $JNL($n)] 0] - if [string match $regx $pnam] { - set b [string range $blank 1 [expr {30 - [string length $pnam] }]] - puts [format "%3d - %s%s (Done at %s)" $i $pnam $b $n ] - } - } - } - return -} diff --git a/src/WOKTclLib/pprepare.tcl b/src/WOKTclLib/pprepare.tcl deleted file mode 100755 index 4054cba..0000000 --- a/src/WOKTclLib/pprepare.tcl +++ /dev/null @@ -1,336 +0,0 @@ -############################################################################# -# -# P P R E P A R E -# _______________ -# -############################################################################# -# -# Usage -# -proc wokpprepareUsage { } { - puts stderr \ - { - Usage: pprepare Pnam [ options... ] - - Compare the parcel Pnam in the local bag with its last occurence in - the reference bag. Pnam should be given with its full path, in the format - FACTORY:BAGNAME:PARCELNAME - - File extensions in Pnam are checked against a list of known types. - If some extensions are unknown, a warning is issued. - - Options for specifying location and contents of the parcel Pnam. - -from specify that must be used as the contents of Pnam. - By default is the root directory of the parcel in the bag of - your factory. - - -init specify that Pnam is a new parcel to be initialized in the - reference BAG. No comparison is done. is a character string - that identify the level the parcel belongs to. should be - given using uppercase letter. - - -req specify a list of parcels used to build Pnam. - By default this list is automatically inserted using the requisites - declared in your bag. - - Options for specifying output. - - By default, creates a file named Pnam.report in the current directory. - If option -o is specified the output is written in file. - By default the identical files are not listed unless option -show= is - specified. - - Options for filtering comparison: - - By default, all the directories and files under Pnam root directory - are compared with the contents of the last occurence of pnam in - the reference bag. You can avoid some of these comparisons with the - following options. - - -depth depth : Subdirectories whose level is greater than depth are - not compared. (Directory itself is depth = 0 ) - -ext e1,e2,..: Select extension file to be compared. Extenstions must - separated by comma, and begin with a dot (.) - -dir d1,d2,. : Select directory names to be compared. Names can be - glob-style match. - -Xdir d1,d2, : Same as above but excludes listed directories. - - Examples: - - Writes in /tmp/report the compared state of parcel KL:BAG:KERNEL-B4-1 - with the last occurence of KERNEL-B4-1 in the reference BAG. - - tclsh> pprepare KL:BAG:KERNEL-B4-1 -o /tmp/report - - } - return -} -# -# Point d'entree de la commande -# -proc pprepare { args } { - - set tblreq(-h) {} - set tblreq(-o) value_required:file - set tblreq(-show=) {} - set tblreq(-init) value_required:string - set tblreq(-from) value_required:file - set tblreq(-v) {} - set tblreq(-V) {} - set tblreq(-req) value_required:string - set tblreq(-depth) value_required:string - set tblreq(-ext) value_required:list - set tblreq(-dir) value_required:list - set tblreq(-xdir) value_required:list - - set param {} - if { [wokUtils:EASY:GETOPT param tabarg tblreq wokpprepareUsage $args] == -1 } return - - if [info exists tabarg(-h)] { - wokpprepareUsage - return - } - - set verbose 0 - if { [info exists tabarg(-v)] || [info exists tabarg(-V)] } { set verbose 1 } - - if { [llength $param] != 1 } { - wokpprepareUsage - return - } - - set hidee 1 - if [info exists tabarg(-show=)] { - set hidee 0 - } - - - set init NO - if [info exists tabarg(-init)] { - set init $tabarg(-init) - } - - if { [set comp [package require Wokutils]] != {} } { - set compare_routine wokcmp - } else { - set compare_routine wokUtils:FILES:AreSame - } - - if { $verbose } { puts "Will use the command $compare_routine for file comparison." ; flush stdout } - - set inam [lindex $param 0] - - if [info exists tabarg(-from)] { - set pnam $inam ;# si il n'y a pas de : - set drev $tabarg(-from) - } else { - if [wokinfo -x $inam] { - set pnam [wokinfo -n $inam] - set drev [wokinfo -p HomeDir $inam] - } else { - puts "Qui peut me dire comment on utilise simplement wokinfo et Cie.. ??" - puts "En attendant specifier la parcel avec son full path. Ex KERNEL:BAG:KERNEL-B6-1" - puts "ou utiliser l'option -from pour dire ou faut prendre les directories de l'UL" - return - } - } - - if [info exists tabarg(-req)] { - set umak $tabarg(-req) - } else { - set umak [pprepare:depends:read $inam] - } - - set dmas [wokBAG:cpnt:GetImportName $pnam] - if { "$init" == "NO" } { - if { $verbose } { puts "Will use $dmas as directory for comparison" ; flush stdout } - if { [file exists $dmas] } { - if { ![file isdirectory $dmas] } { - puts stderr "$dmas is not a directory" - return - } - if { $verbose } { puts -nonewline "Reading $dmas ..."; flush stdout } - - wokUtils:FILES:DirToMap $dmas mas - - if { $verbose } { puts "Done" ; flush stdout} - if [info exists mas(/lost+found)] { - unset mas(/lost+found) - } - } - } - - if { [file exists $drev] } { - if { ![file isdirectory $drev] } { - puts stderr "$drev is not a directory" - return - } - if { $verbose } { puts -nonewline "Reading $drev ..." ; flush stdout } - wokUtils:FILES:DirToMap $drev rev - if { $verbose } { puts "Done" ; flush stdout } - if [info exists rev(/lost+found)] { - unset rev(/lost+found) - } - } else { - puts stderr "Directory $drev does not exists." - return - } - - if [info exists tabarg(-o)] { - if [ catch { set fileid [ open [set written $tabarg(-o)] w ] } status ] { - puts stderr "$status" - return - } - } else { - if [ catch { set fileid [ open [set written [pwd]/${pnam}.report] w ] } status ] { - puts stderr "$status" - return - } - } - - set gblist {} - if [info exists tabarg(-ext)] { - foreach e $tabarg(-ext) { - lappend gblist $e - } - } - - if [info exists tabarg(-depth)] { - set depth [expr $tabarg(-depth) + 1] - if [array exists mas] { - foreach ky [array names mas] { - if { [expr [llength [split $ky /]] -1] >= $depth } { - unset mas($ky) - } - } - } - foreach ky [array names rev] { - if { [expr [llength [split $ky /]] -1] >= $depth } { - unset rev($ky) - } - } - } - - if [info exists tabarg(-dir)] { - foreach ptn $tabarg(-dir) { - if [array exists mas] { - foreach ky [array names mas] { - if ![string match $ptn $ky] { - unset mas($ky) - } - } - } - foreach ky [array names rev] { - if ![string match $ptn $ky] { - unset rev($ky) - } - } - } - } - - if [info exists tabarg(-xdir)] { - foreach ptn $tabarg(-xdir) { - if [array exists mas] { - foreach ky [array names mas] { - if [string match $ptn $ky] { - unset mas($ky) - } - } - } - foreach ky [array names rev] { - if [string match $ptn $ky] { - unset rev($ky) - } - } - } - } - ;# bai gio em phai di lam... - if { $verbose } { puts -nonewline "Begin comparison ..." ; flush stdout } - wokUtils:EASY:Compare mas rev MAPWRK $compare_routine $hidee $gblist - if { $verbose } { puts "Done ..." ; flush stdout } - - pprepare:header:write $pnam $dmas $drev $init $umak $fileid - wokUtils:EASY:WriteCompare $dmas $drev MAPWRK $fileid - pprepare:comments:write $fileid - - if { [string match file* $fileid] } { - close $fileid - } - - set l [wokUtils:EASY:RevFiles MAPWRK] - wokUtils:EASY:ext $l Extensions - if { [set unk [wokBAG:magic:CheckExt [array names Extensions]]] != {} } { - foreach ext $unk { - puts "Error : Unknown extension $ext" - } - } - - puts "File $written has been created." - return -} -;# -;# retourne le header d'un report dans map. -;# -proc pprepare:header:read { fileid map } { - upvar $map TLOC - while {[gets $fileid x] >= 0} { - if { [regexp {^Parcel : (.*)} $x all pnam] } {set f0 1 } - if { [regexp {^Master : (.*)} $x all dmas] } {set f1 1 } - if { [regexp {^Revision: (.*)} $x all drev] } {set f2 1 } - if { [regexp {^Init : (.*)} $x all init] } {set f3 1 } - if { [regexp {^Umaked : (.*)} $x all umak] } {set f4 1 } - if { [info exists f0] && [info exists f1] && [info exists f2] && [info exists f3] && [info exists f4]} { - array set TLOC [list Parcel $pnam Master $dmas Revision $drev Init $init Umaked $umak] - return 1 - } - } - return {} -} -;# -;# ecrit le header d'un report. -;# -proc pprepare:header:write { pnam dir1 dir2 init umak fileid } { - puts $fileid "Parcel : $pnam" - puts $fileid "Master : $dir1" - puts $fileid "Revision: $dir2" - puts $fileid "Init : $init" - puts $fileid "Umaked : $umak" - return -} -;# -;# retourne les commentaires d'un report -;# -proc pprepare:comments:read { fileid } { - set l {} - while {[gets $fileid x] >= 0} { - lappend l $x - } - return $l -} -;# -;# ecrit un template de commentaires d'un report -;# -proc pprepare:comments:write { fileid } { - puts $fileid "is" - puts $fileid " Author :" - puts $fileid " Study/CSR :" - puts $fileid " Debug :" - puts $fileid " Improvements :" - puts $fileid " News :" - puts $fileid " Deletions :" - puts $fileid " Impact :" - puts $fileid " Comments :" - puts $fileid "end;" -} -;# -;# recupere les dependances de fab i. e. lit un machin ecrit -;# /adv_20/MDL/BAG/GEOMETRY-M4-6/adm/GEOMETRY.depul qui contient (GEOMLITE-M4-6 KERNEL-K4L) -;# -;# inam est un FULL PATH. -;# -proc pprepare:depends:read { inam } { - if [wokinfo -x $inam] { - set nam [wokBAG:cpnt:parse root [wokinfo -n $inam]] - return [wokUtils:FILES:FileToList [wokinfo -p AdmDir $inam]/$nam.depul] - } -} diff --git a/src/WOKTclLib/pstore.tcl b/src/WOKTclLib/pstore.tcl deleted file mode 100755 index ae841fd..0000000 --- a/src/WOKTclLib/pstore.tcl +++ /dev/null @@ -1,476 +0,0 @@ - -############################################################################# -# -# P S T O R E -# ___________ -# -############################################################################# -# -# Usage -# -proc pstoreUsage { } { - puts stderr \ - { - Usage : pstore [-conf cnam1,cnam2,..] [-f] [-rm|-ls|-cat] [filename] - - pstore filename -conf option : Add a report in the report's list from . - -conf option is mandatory. : Will update during integration. (pintegre) - - pstore [-ls] : Lists pending reports with their owner and IDs. - pstore -cat : Shows the content of . - pstore [-f] -rm : Remove a report from the queue - : (-f used to force if you dont own the report). - - -dump : Dump contents of Report . - -check : Check that all files referenced in queue have not - not been modified since their storage. - - } - return -} -# -# Point d'entree de la commande -# -proc pstore { args } { - - set tblreq(-h) {} - set tblreq(-f) {} - set tblreq(-rm) {} - set tblreq(-ls) {} - set tblreq(-cat) {} - - set tblreq(-dump) {} - set tblreq(-check) {} - - set tblreq(-conf) value_required:list - - - set param {} - - if { [wokUtils:EASY:GETOPT param tabarg tblreq pstoreUsage $args] == -1 } return - - set option_specified [array exists tabarg] - - if { [info exists tabarg(-h)] } { - pstoreUsage - return - } - - if { [info exists tabarg(-f)] } { - set forced -1 - } else { - set forced 0 - } - - - - set fshop nil - - set FrigoName [pstore:Report:MkRoot $fshop 1] - - if { $FrigoName == {} } { - msgprint -c WOKBAG -e "Bad queue name." - return - } - - set ListReport [pstore:Report:GetReportList $FrigoName] - - ;# - ;# Options ne s'appliquant pas a un ID - ;# - set ID [lindex $param 0] - - if { $ID == {} } { - if { ( [info exists tabarg(-ls)] == 1 ) || ( $option_specified == 0 ) } { - set i 0 - foreach e $ListReport { - set user [wokUtils:FILES:Userid $FrigoName/$e] - set str [pstore:Report:GetPrettyName $e] - if { $str != {} } { - set rep [string range [lindex $str 0] 0 19] - set dte [lindex $str 1] - puts [format "%3d - %-10s %-20s (stored at %s)" [incr i] $user $rep $dte ] - } else { - msgprint -c WOKBAG -e "Bad entry ($e) found in report.list" - } - } - return - } elseif { [info exists tabarg(-check)] } { - set LISTREPORT [pstore:Report:Get all $fshop] - foreach REPORT $LISTREPORT { - set cmd [pstore:Report:Process $REPORT] - if { [info procs pstoreReportWasThere] != {} } { - if { [set l [pstoreReportWasThere]] != {} } { - foreach f $l { - puts stderr "File $f has been removed since storage of that report." - } - return - } - } - if { [info procs pstoreReportRemember] != {} } { - if { [set l [pstoreReportRemember]] != {} } { - foreach [list fn dt] $l { - puts -nonewline stderr "File date has changed for $fn." - puts stderr "Was stored at [fmtclock $dt]. Current is [fmtclock [file mtime $fn]]" - } - } - } - pstore:Report:UnProcess $REPORT - } - return - } - } - - if { [info exists tabarg(-check)] || [info exists tabarg(-ls)] } { - pstoreUsage - return - } - - - ;# - ;# Options s'appliquant a un ID - ;# - - if ![wokUtils:FILES:ValidName $ID] { - msgprint -c WOKBAG -e "Malformed command or invalid file name $ID" - return {} - } - - - - if [info exists tabarg(-rm)] { - set entry [pstore:Report:GetTrueName $ID $ListReport] - if { $entry != {} } { - pstore:Report:Del $FrigoName/$entry $forced - } - return - } - - if [info exists tabarg(-cat)] { - set entry [pstore:Report:GetTrueName $ID $ListReport] - if { $entry != {} } { - set rep $FrigoName/$entry/report-orig - if { [file exists $rep] } { - return [exec cat $rep] - } else { - msgprint -c WOKBAG -e "File $rep not found." - } - } - return - } - - if [info exists tabarg(-dump)] { - set entry [pstore:Report:GetTrueName $ID [pstore:Report:GetReportList $FrigoName]] - return [pstore:Report:Dump $FrigoName/$entry] - } - - - if { [info exists tabarg(-conf)] } { - set Config $tabarg(-conf) - } else { - pstoreUsage - return - } - - if [file exists [set report [lindex $ID 0]]] { - if ![ catch { set fileid [ open $report r ] } ] { - pprepare:header:read $fileid RepHeader - set pnam $RepHeader(Parcel) - if ![pstore:Report:Exists $pnam $ListReport] { - wokUtils:EASY:ReadCompare map $fileid - if ![wokUtils:EASY:MapEmpty map] { - set entry [pstore:Report:GetUniqueName $pnam] - if { $entry != {} } { - if [pstore:Report:Add $Config $report RepHeader map $FrigoName/${entry}] { - msgprint -c WOKBAG -i [set subject "Report $report has been stored."] - seek $fileid 0 start - pstore:mail:Send "With love from $pnam ..." [read $fileid] - close $fileid - } else { - msgprint -c WOKBAG -e " during storage of $report" - catch { exec rm -rf $FrigoName/${entry} } - } - } else { - msgprint -c WOKBAG -e "Parcel name $pnam should not contains a comma." - } - } else { - msgprint -c WOKBAG -e "Report $report is empty." - } - } else { - msgprint -c WOKBAG -e "A report for parcel $pnam is already in queue." - } - } else { - msgprint -c WOKBAG -e "File $report cannot be read." - } - } else { - msgprint -c WOKBAG -e "File $report not found." - } - return -} -#;> -# Ajoute un report dans un frigo -#;< -proc pstore:Report:Add { Config report Header table frigo } { - upvar $Header RepHeader $table RepBody - - mkdir -path $frigo - chmod 0777 $frigo - - set RepHeader(FrigoName) $frigo - wokUtils:FILES:ListToFile {} [set RepHeader(COMMAND) $frigo/COMMAND] - wokUtils:FILES:ListToFile {} [set RepHeader(LABEL) $frigo/LABEL] - wokUtils:FILES:copy $report [set RepHeader(Journal) $frigo/report-orig] - wokUtils:EASY:ListToProc $Config $frigo/Config.tcl pstoreReportConfig - wokUtils:EASY:MapToProc RepHeader $frigo/Header.tcl pstoreReportHeader - wokUtils:EASY:MapToProc RepBody $frigo/Body.tcl pstoreReportBody - set l [wokUtils:EASY:RevFiles RepBody] - wokUtils:FILES:ListToFile [wokUtils:FILES:WasThere $l pstoreReportWasThere] $frigo/WasThere.tcl - source $frigo/WasThere.tcl - if { [set ll [pstoreReportWasThere]] == {} } { - wokUtils:FILES:ListToFile [wokUtils:FILES:Remember $l pstoreReportRemember] $frigo/Remember.tcl - chmod 0777 [list $frigo/Config.tcl $frigo/Header.tcl $frigo/Body.tcl $frigo/Remember.tcl $frigo/report-orig $frigo/COMMAND $frigo/LABEL] - rename pstoreReportWasThere {} - wokUtils:EASY:ext $l Extensions - if { [set unk [wokBAG:magic:CheckExt [array names Extensions]]] != {} } { - foreach ext $unk { - puts "Error : Unknown extension $ext ( $Extensions($ext) )" - } - return 0 - } - return 1 - } else { - foreach f $ll { - puts stderr "File $f not found" - } - rename pstoreReportWasThere {} - return 0 - } -} -#;> -# Lit un report enregistre par pstore, remplit une table -#;< -proc pstore:Report:Process { RepName } { - foreach file [list Config.tcl WasThere.tcl Remember.tcl Header.tcl Body.tcl] { - if { [file exists $RepName/$file] } { - source $RepName/$file - } else { - puts stderr "Report:Process. File $file not found in $RepName." - return 0 - } - } - return 1 -} -#;> -# retire les procs utilisees par un report -# Pour l'instant RepName n'est pas utilise (la proc est independante !!). -#;< -proc pstore:Report:UnProcess { RepName } { - foreach proc [list pstoreReportConfig pstoreReportWasThere pstoreReportRemember pstoreReportHeader pstoreReportBody] { - if { [info procs $proc] != {} } { - rename $proc {} - } - } -} -#;> -# Retire un report du frigo, le report est donne par son full path -#;< -proc pstore:Report:Del { LISTREPORT {forced -1} } { - foreach entry $LISTREPORT { - if { [file owned $entry] || $forced != -1 } { - if { [pstore:Report:RmEntry $entry] == -1 } { - return -1 - } - } else { - msgprint -c WOKBAG -e "You are not the owner of this report." - return -1 - } - } - return -} -#;> -# Detruit effectivement une entry (full path) dans la queue. -#;< -proc pstore:Report:RmEntry { fullentry } { - foreach itm [glob -nocomplain $fullentry/*] { - if [file isdirectory $itm] { - wokUtils:FILES:removedir $itm - } - } - wokUtils:FILES:removedir $fullentry - return -} -;# -;# -;# -proc pstore:Report:Getexcep { } { - return [list LABEL COMMAND Remember.tcl Header.tcl Body.tcl cvt_data report-orig] -} - -#;> -# Pour debugger. Imprime tout ce qui se trouve accroche sous ID -#;< -proc pstore:Report:Dump { D } { - wokUtils:FILES:FindFile $D * -} -#;> -# Retourne le nom de l'entry associee a ReportID {} sinon -#;< -proc pstore:Report:GetTrueName { ReportID listreport } { - set ln [llength $listreport] - if { $ln > 0 } { - if [ regexp {^[0-9]+$} $ReportID ] { - set idm1 [expr $ReportID - 1] - set res [lindex $listreport $idm1] - if { $res != {} } { - return $res - } else { - msgprint -c WOKBAG -e "Bad report ID. Should be a digit and range into ( 1 and $ln ) " - return {} - } - } else { - msgprint -c WOKBAG -e "Bad report ID. Should be a digit and range into ( 1 and $ln ) " - return {} - } - } else { - msgprint -c WOKBAG -e "Report Queue is empty." - return {} - - } -} -#;> -# -# Retourne un nom de directory unique base sur l'heure /append le nom du report -# -#;< -proc pstore:Report:GetUniqueName { name } { - if { [string first , $name] == -1 } { - return [getclock],${name} - } else { - return {} - } -} -#;> -# A partir d'un nom genere par GetUniqueName, retourne une liste de 2 elem -# 1. La date ayant servi a creer le directory -# 2. Le nom du report -#;< -proc pstore:Report:GetPrettyName { Uniquename } { - set l [split $Uniquename ,] - return [list [lindex $l 1] [fmtclock [lindex $l 0]] ] -} -;# -;# Retourne 1 si pnam est deja dans la liste des reports. -;# -proc pstore:Report:Exists { pnam ListReport } { - if { [lsearch -glob $ListReport *,$pnam] == -1 } { - return 0 - } else { - return 1 - } -} -#;> -# Retourne la liste des reports ordonnee par rapport a leur date d'arrivee -#;< -proc pstore:Report:GetReportList { FrigoName } { - if [file exists $FrigoName] { - return [lsort -command pstore:Report:SortEntry [readdir $FrigoName] ] - } else { - return {} - } -} -#;> -# Retourne l'index dans la queue d'un report -1 si existe pas -#;< -proc pstore:Report:Index { FrigoName Truename } { - set i [lsearch [pstore:Report:GetReportList $FrigoName] $Truename] - if { $i != -1 } { - return [expr $i + 1] - } else { - return -1 - } -} -#;> -# Retourne a partir d'un full path le nom du report -#;< -proc pstore:Report:Head { fullpath } { - if [regexp {.*/([0-9]*,[^/]*)} $fullpath all rep] { - return $rep - } else { - return {} - } -} -#; -# Retourne la longueur de la liste des reports en attente dans shop -#;< -proc pstore:Report:QueueLength { fshop } { - return [llength [pstore:Report:GetReportList [pstore:Report:GetRootName]]] -} - -#;> -# Commande utilise pour le tri ci dessus: (u,string1 > v,string2 <=> u > v) -#;< -proc pstore:Report:SortEntry { a b } { - set lna [split $a ,] - set lnb [split $b ,] - return [expr [lindex $lna 0] - [lindex $lnb 0] ] -} - -;# -;# Retourne un ou plusieurs pathes de report, mangeables par pstore:Report:Process -;# -proc pstore:Report:Get { id fshop } { - set l {} - if { [pstore:Report:QueueLength $fshop] != 0 } { - set FrigoName [pstore:Report:GetRootName] - if { $FrigoName != {} } { - set ListReport [pstore:Report:GetReportList $FrigoName] - if { $ListReport != {} } { - if { "$id" == "all" } { - foreach e $ListReport { - lappend l $FrigoName/$e - } - } else { - set brep [pstore:Report:GetTrueName $id $ListReport] - if { "$brep" != "" } { - lappend l $FrigoName/$brep - } - } - } else { - msgprint -c WOKBAG -e "Unable to get report list." - } - } else { - msgprint -c WOKBAG -e "Administration directory for $fshop not found. No report was stored." - } - } else { - msgprint -c WOKBAG -i "Report queue is empty." - } - return $l -} -;# -;# Create root for report's queue. -;# -proc pstore:Report:MkRoot { fshop {create 0} } { - set root [pstore:Report:GetRootName] - if [file exists $root] { - return $root - } else { - if { $create } { - wokUtils:DIR:create $root - chmod 0777 $root - return $root - } else { - return {} - } - } -} -;# -;# Actually send the mail. -;# The user "from" -;# The subject -;# -proc pstore:mail:Send { subject text } { - foreach user [pstore:mail:Users] { - wokUtils:EASY:mail $user [id user] {} $subject $text send - } - -} diff --git a/src/WOKTclLib/ptypefile.tcl b/src/WOKTclLib/ptypefile.tcl deleted file mode 100755 index c2908bc..0000000 --- a/src/WOKTclLib/ptypefile.tcl +++ /dev/null @@ -1,217 +0,0 @@ -proc ptypefile_usage { } { - puts stderr \ - { - Usage: ptypefile -[hwt] [-S ao1,sil,sun,hp,wnt] - - Context: - The command must be runned from a workbnech belonging to a workshop which contains - the given parcel in its ParcelList - - ptypefile -h displays this text - - ptypefile -w - displays on the standard output the non kept type files. - - ptypefile - generates a type file in the adm directory of the parcel for ALL UNIX PLATFORMS - - ptypefile -S ao1,sil - generates a type file in the adm directory of the parcel ONLY for the given platforms - - ptypefile -S wnt - generates a type file in the adm directory of the parcel ONLY for wnt platform - - ptypefile -t - generates a type file in the adm directory where the package libraries contained in a toolkit - are removed from the type file. - - 3 files are generated: - parcel.typ contains pairs of file type, relative path which will be taken into account - during packaging. - parcel.unktyp file warns the UNKNOWN types i.e. not taken into account - parcel.notyp warns all the files that will be removed while packaging the parcel for Quantum - } -} -proc ptypefile { args } { - ;# Options - ;# - set tblreq(-h) {} - set tblreq(-w) {} - set tblreq(-t) {} - set tblreq(-S) value_required:list - ;# Parameters - ;# - set param {} - if {[wokUtils:EASY:GETOPT param table tblreq ptypefile_usage $args] == -1 } return - ;# - if { [info exists table(-h)] } { - ptypefile_usage - return - } - set warn 0 - if { [info exists table(-w)] } { - set warn 1 - } - if { [info exists table(-t)] } { - set tkpriority 1 - msgprint -w "SORRY NOT YET IMPLEMENTED ...." - return - } - set statlist { ao1 hp sil sun } - if { [info exists table(-S)] } { - set statlist $table(-S) - } - set parc [lindex $param 0] - if { $parc == "" } { - ptypefile_usage - return - } - set parcname [wokinfo -n $parc] - # sauvons la plateforme en cours - set curstation [wokparam -v %Station] - ;# sauvons - catch {exec cp "[wokparam -v %${parcname}_Adm]/${parcname}.typ" "[wokparam -v %${parcname}_Adm]/${parcname}.typ-sav"} - set typfile [open "[wokparam -v %${parcname}_Adm]/$parcname.typ" w+] - set notypfile [open "[wokparam -v %${parcname}_Adm]/$parcname.notyp" w+] - set unktypfile [open "[wokparam -v %${parcname}_Adm]/$parcname.unktyp" w+] - # Traitons d'abord les fichiers non plateformes dependants - # les uds de l'ul - ;# catch { - foreach ud [ pinfo -l $parc] { - set lstwokfilecom "[uinfo -Fi $parc:$ud ] [uinfo -Fb $parc:$ud ] " - puts " UD $ud " - foreach wokfile $lstwokfilecom { - switch -exact [lindex $wokfile 0] { - EXTERNLIB - - admfile - - ccldrv - - dbadmfile - - demofile - - derivated - - dummy - - infofile - - intdat - - object - - pubinclude - - source - - srcinc - - stadmfile - - sttmpdir - - testobject {typnotkept $warn $wokfile $notypfile } - cclcfg - - cclrun - - corelisp - - dbunit - - 'default' - - engdatfile - - engine - - englisp - - englispfile - - executable - - icon - - iconfd - - loginfile - - motifdefault - - msentity - - msgfile - - shapefile - - shellcfg - - shellscript - - template - - testexec { typkept $wokfile $parcname $ud $typfile } - datafile { typdatafile $warn $wokfile $parcname $ud $typfile $notypfile } - default { typunknown $wokfile $unktypfile} - } - } - foreach worksta $statlist { - wokprofile -S $worksta - set lstwokfilesta [uinfo -Fs $parc:$ud ] - foreach wokfile $lstwokfilesta { - switch -exact [lindex $wokfile 0] { - EXTERNLIB - - admfile - - ccldrv - - dbadmfile - - demofile - - derivated - - dummy - - infofile - - intdat - - object - - pubinclude - - source - - srcinc - - stadmfile - - sttmpdir - - testobject { typnotkept $warn $wokfile $notypfile } - cclcfg - - cclrun - - corelisp - - dbunit - - 'default' - - engdatfile - - engine - - englisp - - englispfile - - executable - - icon - - iconfd - - motifdefault - - msentity - - msgfile - - shapefile - - shellcfg - - shellscript - - template - - testexec { typkept $wokfile $parcname $ud $typfile } - library { typlibrary $warn $wokfile $parcname $ud $typfile $notypfile } - datafile { typdatafile $warn $wokfile $parcname $ud $typfile $notypfile } - loginfile { typloginfile $warn $wokfile $parcname $ud $typfile $notypfile } - default { typunknown $wokfile $unktypfile } - } - } - } - } - ;# } - close $typfile - close $unktypfile - close $notypfile - ;# on remet la station - wokprofile -S $curstation -} -;# -proc typkept { wokfile parcname ud typfile } { - puts $typfile "[lindex $wokfile 0] [string range [wokinfo -p [lindex $wokfile 0]:[lindex $wokfile 1] ${parcname}:${ud}] [expr [string length [wokparam -v %${parcname}_Home]] + 1] end]" -} -proc typnotkept { warn wokfile notypfile } { - if { $warn } { msgprint -w "TYPE $wokfile NOT KEPT" } - puts $notypfile "TYPE $wokfile NOT KEPT" -} -proc typunknown { wokfile unktypfile } { - msgprint -e "TYPE $wokfile UNKNOWN " - puts $unktypfile "TYPE $wokfile UNKNOWN" -} - -proc typlibrary { warn wokfile parcname ud typfile notypfile } { - ;# rajouter pktklist et tkpriority apres - if {[file extension [lindex $wokfile 1]] == ".Z"} { - typnotkept $warn $wokfile $notypfile - } else { - typkept $wokfile $parcname $ud $typfile - } -} -proc typdatafile { warn wokfile parcname ud typfile notypfile} { - if {[file extension [lindex $wokfile 1]] == ".ilm"} { - typnotkept $warn $wokfile $notypfile - } else { - typkept $wokfile $parcname $ud $typfile - } -} -proc typloginfile { warn wokfile parcname ud typfile notypfile } { - if {[file extension [lindex $wokfile 1]] == ".edl"} { - typnotkept $warn $wokfile $notypfile - } else { - typkept $wokfile $parcname $ud $typfile - } -} - diff --git a/src/WOKTclLib/template.dsp b/src/WOKTclLib/template.dsp deleted file mode 100755 index b9b9555..0000000 --- a/src/WOKTclLib/template.dsp +++ /dev/null @@ -1,94 +0,0 @@ -# Microsoft Developer Studio Project File - Name="__TKNAM__" - Package Owner=<4> -# Microsoft Developer Studio Generated Build File, Format Version 6.00 -# ** DO NOT EDIT ** - -# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 - -CFG=__TKNAM__ - Win32 Debug -!MESSAGE This is not a valid makefile. To build this project using NMAKE, -!MESSAGE use the Export Makefile command and run -!MESSAGE -!MESSAGE NMAKE /f "__TKNAM__.mak". -!MESSAGE -!MESSAGE You can specify a configuration when running NMAKE -!MESSAGE by defining the macro CFG on the command line. For example: -!MESSAGE -!MESSAGE NMAKE /f "__TKNAM__.mak" CFG="__TKNAM__ - Win32 Debug" -!MESSAGE -!MESSAGE Possible choices for configuration are: -!MESSAGE -!MESSAGE "__TKNAM__ - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") -!MESSAGE "__TKNAM__ - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") -!MESSAGE - -# Begin Project -# PROP AllowPerConfigDependencies 0 -# PROP Scc_ProjName "" -# PROP Scc_LocalPath "" -CPP=cl.exe -MTL=midl.exe -RSC=rc.exe - -!IF "$(CFG)" == "__TKNAM__ - Win32 Release" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "Release" -# PROP BASE Intermediate_Dir "..\..\win32\obj\__TKNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "..\..\win32\bin" -# PROP Intermediate_Dir "..\..\win32\obj\__TKNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /FD /c -# ADD CPP /nologo /MD /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "WNT" /D "CSFDB"/D "No_Exception" /FD /c -# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /o "NUL" /win32 -# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /o "NUL" /win32 -# ADD BASE RSC /l 0x40c /d "NDEBUG" -# ADD RSC /l 0x40c /d "NDEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386 -# ADD LINK32 __TKDEP__ opengl32.lib glu32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ws2_32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /machine:I386 /libpath:"..\..\win32\lib" /implib:"..\..\win32\lib\__TKNAM__.lib" - -!ELSEIF "$(CFG)" == "__TKNAM__ - Win32 Debug" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 1 -# PROP BASE Output_Dir "Debug" -# PROP BASE Intermediate_Dir "..\..\win32\objd\__TKNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 1 -# PROP Output_Dir "..\..\win32\bind" -# PROP Intermediate_Dir "..\..\win32\objd\__TKNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /FD /c -# ADD CPP /nologo /MDd /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /D "WNT" /D "CSFDB" /FD /c -# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /o "NUL" /win32 -# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /o "NUL" /win32 -# ADD BASE RSC /l 0x40c /d "_DEBUG" -# ADD RSC /l 0x40c /d "_DEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386 /pdbtype:sept -# ADD LINK32 __TKDEP__ opengl32.lib glu32.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ws2_32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /incremental:no /debug /machine:IX86 /libpath:"..\..\win32\libd" /pdb:"..\..\win32\bind\__TKNAM__.pdb" /implib:"..\..\win32\libd\__TKNAM__.lib" - -!ENDIF - -# Begin Target - -# Name "__TKNAM__ - Win32 Release" -# Name "__TKNAM__ - Win32 Debug" -# Begin Group "Source files" -__FILES__ -# End Group -# End Target -# End Project diff --git a/src/WOKTclLib/template.dspx b/src/WOKTclLib/template.dspx deleted file mode 100755 index 6bc39cf..0000000 --- a/src/WOKTclLib/template.dspx +++ /dev/null @@ -1,94 +0,0 @@ -# Microsoft Developer Studio Project File - Name="__XQTNAM__" - Package Owner=<4> -# Microsoft Developer Studio Generated Build File, Format Version 6.00 -# ** DO NOT EDIT ** - -# TARGTYPE "Win32 (x86) Application" 0x0103 - -CFG=__XQTNAM__ - Win32 Debug -!MESSAGE This is not a valid makefile. To build this project using NMAKE, -!MESSAGE use the Export Makefile command and run -!MESSAGE -!MESSAGE NMAKE /f "__XQTNAM__.mak". -!MESSAGE -!MESSAGE You can specify a configuration when running NMAKE -!MESSAGE by defining the macro CFG on the command line. For example: -!MESSAGE -!MESSAGE NMAKE /f "__XQTNAM__.mak" CFG="__XQTNAM__ - Win32 Debug" -!MESSAGE -!MESSAGE Possible choices for configuration are: -!MESSAGE -!MESSAGE "__XQTNAM__ - Win32 Release" (based on "Win32 (x86) Console Application") -!MESSAGE "__XQTNAM__ - Win32 Debug" (based on "Win32 (x86) Console Application") -!MESSAGE - -# Begin Project -# PROP AllowPerConfigDependencies 0 -# PROP Scc_ProjName "" -# PROP Scc_LocalPath "" -CPP=cl.exe -MTL=midl.exe -RSC=rc.exe - -!IF "$(CFG)" == "__XQTNAM__ - Win32 Release" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 0 -# PROP BASE Output_Dir "Release" -# PROP BASE Intermediate_Dir "..\..\win32\obj\__XQTNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 0 -# PROP Output_Dir "..\..\win32\bin" -# PROP Intermediate_Dir "..\..\win32\obj\__XQTNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /FD /c -# ADD CPP /nologo __COMPOPT__ /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "No_Exception" /D "_WINDOWS" /D "WNT" /D "CSFDB" /FD /c -# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32 -# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32 -# ADD BASE RSC /l 0x409 /d "NDEBUG" -# ADD RSC /l 0x409 /d "NDEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 -# ADD LINK32 __TKDEP__ /nologo /subsystem:console /machine:I386 /libpath:"..\..\win32\lib" /implib:"..\..\win32\lib\__XQTNAM__.lib" - -!ELSEIF "$(CFG)" == "__XQTNAM__ - Win32 Debug" - -# PROP BASE Use_MFC 0 -# PROP BASE Use_Debug_Libraries 1 -# PROP BASE Output_Dir "Debug" -# PROP BASE Intermediate_Dir "..\..\win32\objd\__XQTNAM__" -# PROP BASE Target_Dir "" -# PROP Use_MFC 0 -# PROP Use_Debug_Libraries 1 -# PROP Output_Dir "..\..\win32\bind" -# PROP Intermediate_Dir "..\..\win32\objd\__XQTNAM__" -# PROP Ignore_Export_Lib 0 -# PROP Target_Dir "" -# ADD BASE CPP /nologo /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /FD /GZ /c -# ADD CPP /nologo __COMPOPTD__ /W3 /GX /Zi /Od /D "WIN32" /D "DEB" /D "_DEBUG" /D "_WINDOWS" /D "WNT" /D "CSFDB" /FD /GZ /c -# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32 -# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32 -# ADD BASE RSC /l 0x409 /d "_DEBUG" -# ADD RSC /l 0x409 /d "_DEBUG" -BSC32=bscmake.exe -# ADD BASE BSC32 /nologo -# ADD BSC32 /nologo -LINK32=link.exe -# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept -# ADD LINK32 __TKDEP__ /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept /libpath:"..\..\win32\libd" /implib:"..\..\win32\libd\__XQTNAM__.lib" - -!ENDIF - -# Begin Target - -# Name "__XQTNAM__ - Win32 Release" -# Name "__XQTNAM__ - Win32 Debug" -# Begin Group "Source Files" -__FILES__ -# End Group -# End Target -# End Project diff --git a/src/WOKTclLib/template.vcproj b/src/WOKTclLib/template.vcproj deleted file mode 100755 index 80c89d4..0000000 --- a/src/WOKTclLib/template.vcproj +++ /dev/null @@ -1,156 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - __FILES__ - - - - - diff --git a/src/WOKTclLib/template.vcprojx b/src/WOKTclLib/template.vcprojx deleted file mode 100755 index 4503238..0000000 --- a/src/WOKTclLib/template.vcprojx +++ /dev/null @@ -1,150 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -__FILES__ - - - - - diff --git a/src/WOKTclLib/wokOUC.tcl b/src/WOKTclLib/wokOUC.tcl deleted file mode 100755 index 3c2c8e7..0000000 --- a/src/WOKTclLib/wokOUC.tcl +++ /dev/null @@ -1,481 +0,0 @@ - -proc wokOUC:DBG { {root {}} } { - global IWOK_GLOBALS - global IWOK_WINDOWS - set w .oucewokk4dev - set hli $IWOK_WINDOWS($w,OUC,hlist) - foreach c [$hli info children $root] { - puts "$c : data <[$hli info data $c]>" - wokOUC:DBG $c - } - return -} - - - -############################################################################# -# -# O U C -# _____ -# -############################################################################# -proc wokOUC:Exit { w } { - global IWOK_WINDOWS - destroy $w - wokButton delw [list ouce $w] - foreach var [array names IWOK_WINDOWS $w,OUC,*] { - unset IWOK_WINDOWS($var) - } - return -} - -proc wokOUC:Help { w } { - return -} - -proc wokOUC:Create { {loc {}} } { - global IWOK_WINDOWS - global IWOK_GLOBALS - - if { $loc == {} } { - set verrue [wokCWD readnocell] - } else { - regexp {(.*):OUCE} $loc all verrue - } - - if ![wokinfo -x $verrue] { - wokDialBox .wokcd {Unknown location} "Location $verrue is unknown" {} -1 OK - return - } - set fshop [wokinfo -s $verrue] - - set w [wokTPL ouce${verrue}] - if [winfo exists $w ] { - wm deiconify $w - raise $w - return - } - - toplevel $w - wm title $w "OUCE of $fshop" - wm geometry $w 880x555+515+2 - - wokButton setw [list ouce $w] - - menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 - menu $w.file.m - $w.file.m add command -label "Exit " -underline 1 -command [list wokOUC:Exit $w] - - menubutton $w.help -menu $w.help.m -text Help -underline 0 -takefocus 0 - menu $w.help.m - $w.help.m add command -label "Help" -underline 1 -command [list wokOUC:Help $w] - - frame $w.top -relief sunken -bd 1 - - tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50 - pack $w.top.pane -side top -expand yes -fill both -padx 10 -pady 10 - - set p1 [$w.top.pane add tree -min 70 -size 200] - set p2 [$w.top.pane add text -min 70] - - set tree [tixTree $p1.tree -options {hlist.separator "^" hlist.selectMode single }] - set text [tixScrolledText $p2.text ] ; $text subwidget text config -font $IWOK_GLOBALS(font) - - $tree config -opencmd [list wokOUC:Tree:Open $w] -browsecmd [list wokOUC:Tree:Browse $w] - - pack $p1.tree -expand yes -fill both -padx 1 -pady 1 - pack $p2.text -expand yes -fill both -padx 1 -pady 1 - - set IWOK_WINDOWS($w,OUC,tree) $tree - set IWOK_WINDOWS($w,OUC,hlist) [$tree subwidget hlist] - set IWOK_WINDOWS($w,OUC,text) [$text subwidget text] - set IWOK_WINDOWS($w,OUC,label) [label $w.lab] - set IWOK_WINDOWS($w,OUC,shop) $fshop - set IWOK_WINDOWS($w,OUC,root) [wokOUC:GetRootName $fshop] - set IWOK_WINDOWS($w,OUC,dupstyle) [tixDisplayStyle imagetext -fg orange] - - tixButtonBox $w.act -orientation horizontal -relief flat -padx 0 -pady 0 - - - tixForm $w.file ; tixForm $w.help -right -2 - tixForm $w.act -top $w.file -left 2 - tixForm $w.top -top $w.act -left 2 -right %99 -bottom $w.lab - tixForm $w.lab -left 2 -right %99 -bottom %99 - - bind $IWOK_WINDOWS($w,OUC,hlist) { - wokOUC:Tree:diff [winfo toplevel %W] - } - bind $IWOK_WINDOWS($w,OUC,hlist) { - wokOUC:Tree:diff [winfo toplevel %W] - } - wokOUC:Tree:Fill $w - - return -} - -proc wokOUC:Tree:diff { w } { - global IWOK_WINDOWS - if ![info exists IWOK_WINDOWS($w,OUC,v1)] { - set IWOK_WINDOWS($w,OUC,v1) [$IWOK_WINDOWS($w,OUC,hlist) info anchor] - } else { - if ![info exists IWOK_WINDOWS($w,OUC,v2)] { - set IWOK_WINDOWS($w,OUC,v2) [$IWOK_WINDOWS($w,OUC,hlist) info anchor] - set pth1 [lindex [lindex [$IWOK_WINDOWS($w,OUC,hlist) info data $IWOK_WINDOWS($w,OUC,v1)] 1] 2] - set pth2 [lindex [lindex [$IWOK_WINDOWS($w,OUC,hlist) info data $IWOK_WINDOWS($w,OUC,v2)] 1] 2] - if { [file exists $pth1] && [file exists $pth2] } { - wokDiffInText $IWOK_WINDOWS($w,OUC,text) $pth1 $pth2 - if [wokUtils:EASY:INPATH xdiff] { - } - } - } - } - return -} -#;> -# Pour iwok Ecrit la table dans un tree -#;< -proc wokOUC:Tree:Fill { w } { - global IWOK_WINDOWS - tixBusy $w on - set fshop $IWOK_WINDOWS($w,OUC,shop) - set root $IWOK_WINDOWS($w,OUC,root) - set hlist $IWOK_WINDOWS($w,OUC,hlist) - set filima [tix getimage textfile] - foreach e [lsort [readdir $root]] { - set ldup [llength [set lem [wokUtils:FILES:FileToList $root/$e]]] - if { $lem != {} } { - if { $ldup == 1 } { - $hlist add $e -itemtype imagetext -text $e \ - -image $filima \ - -data [list HEADER [list $ldup $lem]] - } else { - $hlist add $e -itemtype imagetext -text $e -style $IWOK_WINDOWS($w,OUC,dupstyle) \ - -image $filima \ - -data [list HEADER [list $ldup $lem]] - } - $IWOK_WINDOWS($w,OUC,tree) setmode $e open - update - } else { - unlink $root/$e - } - } - tixBusy $w off - return -} - - -proc wokOUC:Tree:Open { w dir } { - global IWOK_WINDOWS - global IWOK_GLOBALS - if {[$IWOK_WINDOWS($w,OUC,hlist) info children $dir] != {}} { - foreach kid [$IWOK_WINDOWS($w,OUC,hlist) info children $dir] { - $IWOK_WINDOWS($w,OUC,hlist) show entry $kid - } - } else { - tixBusy $w on - set lem [lindex [lindex [$IWOK_WINDOWS($w,OUC,hlist) info data $dir] 1] 1] - set upd {} - foreach f $lem { - set lf [split $f] - if { [file exists [lindex $lf 2]] } { - lappend upd $f - set adr [lindex $lf 0] - $IWOK_WINDOWS($w,OUC,hlist) add ${dir}^${adr} -itemtype imagetext \ - -text [join [lrange [split $adr :] 2 3] :] \ - -image $IWOK_GLOBALS(image,[lindex $lf 1]) \ - -data [list PATH [list $adr [lindex $lf 1] [lindex $lf 2]]] - } - } - update - if { $upd != {} } { - wokUtils:FILES:ListToFile $upd $IWOK_WINDOWS($w,OUC,root)/$dir - } else { - unlink $IWOK_WINDOWS($w,OUC,root)/$dir - } - tixBusy $w off - } - return -} - -proc wokOUC:Tree:Browse { w dir } { - global IWOK_WINDOWS - - ;# parce qu'elle est aussi appelee dans le bind - if { [info exists IWOK_WINDOWS($w,OUC,v1)] && [info exists IWOK_WINDOWS($w,OUC,v2)] } { - unset IWOK_WINDOWS($w,OUC,v1) IWOK_WINDOWS($w,OUC,v2) - return - } - - set data [$IWOK_WINDOWS($w,OUC,hlist) info data $dir] - set type [lindex $data 0] - - switch -- $type { - - PATH { - set dd [lindex $data 1] - set adr [lindex $dd 0] - set typ [lindex $dd 1] - set pth [lindex $dd 2] - wokReadFile $IWOK_WINDOWS($w,OUC,text) $pth - } - - HEADER { - } - } - - return -} - -# -#;> -# Ajoute une entry pour lname { nam1 nam2 ..} a l'adresse adr -# wokOUC:Add WOK:k4dev k4dev:adnk4:WOKAPI package /adv_23/WOK/k4dev/adnk4/src/WOKAPI WOKAPI_Command.c -# Dans le cad d'une duplication update GetDupName -#;< -proc wokOUC:Add { fshop adr typ dir lname } { - set root [wokOUC:GetRootName $fshop 1] - set dupl [wokOUC:GetDupName $fshop 1] - foreach name $lname { - set entry $root/$name - if { [file exists $entry] == 1 } { - set lem [wokUtils:FILES:FileToList $entry] - set new {} - set add 1 - set nbe 0 - foreach f $lem { - set lf [split $f] - set a [lindex $lf 0] - set t [lindex $lf 1] - set p [lindex $lf 2] - if { [file exist $p] } { - lappend new $f - incr nbe - } - if { "$a" == "$adr" && "$t" == "$typ" && "$p" == "$dir"} { - set add 0 - } - } - if { $add } { - lappend new "$adr $typ $dir/$name" - } - wokUtils:FILES:ListToFile $new $entry - if { $nbe > 1 } { - wokUtils:FILES:touch $dupl/$name - } - } else { - wokUtils:FILES:ListToFile [list "$adr $typ $dir/$name"] $entry - chmod 0777 $entry - } - } - return -} -#;> -# Teste si une entry existe, la detruit sinon. -# -#;< -proc wokOUC:Exists { fshop adr typ name } { - set root [wokOUC:GetRootName $fshop] - set entry $root/$name - if { [file exists $entry] } { - set lem [wokUtils:FILES:FileToList $entry] - set new {} - set x 0 - foreach f $lem { - set lf [split $f] - set a [lindex $lf 0] - set t [lindex $lf 1] - set p [lindex $lf 2] - if [file exist $p] { - lappend new $f - } - if { "$a" == "$adr" && "$t" == "$typ" } { - set x 1 - } - } - if { $new != {} } { - wokUtils:FILES:ListToFile $new $entry - } else { - set x 0 - unlink $entry - } - return $x - } else { - return 0 - } -} -#;> -# Retourne le full path du repertoire d'administration de wsee pour un ilot donne. -# 1. Si create = 1 le cree dans le cas ou il n'existe pas. -#;< -proc wokOUC:GetRootName { fshop {create 0} } { - set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/OUC_ENTRIES - if [file exists $diradm] { - return $diradm - } else { - if { $create } { - msgprint -c WOKVC -i "Creating file $diradm" - mkdir -path $diradm - chmod 0777 $diradm - return $diradm - } else { - return {} - } - } -} -proc wokOUC:GetDupName { fshop {create 0} } { - set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/OUC_DUP - if [file exists $diradm] { - return $diradm - } else { - if { $create } { - msgprint -c WOKVC -i "Creating file $diradm" - mkdir -path $diradm - chmod 0777 $diradm - return $diradm - } else { - return {} - } - } -} - -#;> -# remplit root avec le contenu de fshop sauf le workbench appele ref. -# prevoir de faire mv root ->root-sav et d'ecrire dans root neuve. -#;< -proc wokOUC:Make { fshop {wr ref} } { - set wr ref - set root [wokOUC:GetRootName $fshop 1] - foreach adr [wokFind $fshop] { - if {"[wokinfo -t $adr]" == "devunit" } { - if { "[wokinfo -n [wokinfo -w $adr]]" != "$wr" } { - set typ [uinfo -t $adr] - set dir [wokinfo -p source:. ${adr}] - set lname {} - foreach f [glob -nocomplain $dir/*] { - if { "[set n [wokOUC:Valid $f]]" != {} } { - lappend lname $n - } - } - puts "Creer les entries de $adr avec:" - ;#puts "lname = $lname" - wokOUC:Add $fshop $adr $typ $dir $lname - } - } - } - return -} - -proc wokOUC:Clean { fshop {type entries} } { - switch -- $type { - entries { - set root [wokOUC:GetRootName $fshop] - foreach f [glob -nocomplain $root/*] { - if [catch { unlink $f } status] { - puts "Clean: $status" - } - } - } - - dup { - set duproot [wokOUC:GetDupName $fshop] - foreach f [glob -nocomplain $duproot/*] { - if [catch { unlink $f } status] { - puts "Clean: $status" - } - } - } - } - return -} - -proc wokOUC:Dump { fshop {type entries} } { - switch -- $type { - - entries { - set root [wokOUC:GetRootName $fshop] - foreach f [glob -nocomplain $root/*] { - puts $f - } - } - - dup { - set duproot [wokOUC:GetDupName $fshop] - foreach f [glob -nocomplain $duproot/*] { - puts $f - } - } - } - return -} - -proc wokOUC:Valid { p } { - if { ![file isdirectory $p] } { - set e [file extension [set n [file tail $p]]] - if { ![string match {*~} $n] } { - if { ![string match {*~} $e] } { - if { ![string match {#*#} $n] } { - if { ![string match {*-sav} $e] } { - return $n - } else { - return {} - } - } else { - return {} - } - } else { - return {} - } - } else { - return {} - } - } else { - return {} - } - - -} - - - - - -#;> -# Pour la commande -#;< -proc wokOUC:Tree:Print { w } { - global IWOK_WINDOWS - global IWOK_GLOBALS - set fshop $IWOK_WINDOWS($w,OUC,shop) - set root $IWOK_WINDOWS($w,OUC,root) - set hlist $IWOK_WINDOWS($w,OUC,hlist) - set filima [tix getimage textfile] - foreach e [lsort [readdir $root]] { - set lem [wokUtils:FILES:FileToList $root/$e] - if { $lem != {} } { - $hlist add $e -itemtype imagetext -text $e \ - -image $filima \ - -data [list HEADER {}] - set upd {} - foreach f $lem { - set lf [split $f] - if { [file exists [lindex $lf 2]] } { - lappend upd $f - set adr [lindex $lf 0] - $hlist add ${e}^${adr} -itemtype imagetext \ - -text [join [lrange [split $adr :] 1 2] :] \ - -image $IWOK_GLOBALS(image,[lindex $lf 1]) \ - -data [list PATH [list $adr lindex $lf 2]] - } - } - update - if { $upd != {} } { - wokUtils:FILES:ListToFile $upd $root/$e - } else { - unlink $root/$e - } - } else { - unlink $root/$e - } - } - return -} diff --git a/src/WOKTclLib/woksh.el-wnt b/src/WOKTclLib/woksh.el-wnt deleted file mode 100755 index 6328e9c..0000000 --- a/src/WOKTclLib/woksh.el-wnt +++ /dev/null @@ -1,357 +0,0 @@ -;;; woksh.el --- WOK TCL interface - -;;; Code: - -(require 'comint) -(require 'shell) -(require 'wok-comm) - -;;(defvar woksh-program "tclsh" -(defvar woksh-program "D:/DevTools/TclTk/bin/ntsh.exe" - "*Name of program to invoke woksh") - -(defvar woksh-explicit-args nil - "*List of arguments to pass to woksh on the command line.") - -(defvar woksh-mode-hook nil - "*Hooks to run after setting current buffer to woksh-mode.") - -(defvar woksh-process-connection-type t - "*If non-`nil', use a pty for the local woksh process. -If `nil', use a pipe (if pipes are supported on the local system). - -Generally it is better not to waste ptys on systems which have a static -number of them. On the other hand, some implementations of `woksh' assume -a pty is being used, and errors will result from using a pipe instead.") - -(defvar woksh-directory-tracking-mode 'local - "*Control whether and how to do directory tracking in an woksh buffer. - -nil means don't do directory tracking. - -t means do so using an ftp remote file name. - -Any other value means do directory tracking using local file names. -This works only if the remote machine and the local one -share the same directories (through NFS). This is the default. - -This variable becomes local to a buffer when set in any fashion for it. - -It is better to use the function of the same name to change the behavior of -directory tracking in an woksh session once it has begun, rather than -simply setting this variable, since the function does the necessary -re-synching of directories.") - -(make-variable-buffer-local 'woksh-directory-tracking-mode) - -;; Initialize woksh mode map. -(defvar woksh-mode-map '()) -(cond - ((null woksh-mode-map) - (setq woksh-mode-map (if (consp shell-mode-map) - (cons 'keymap shell-mode-map) - (copy-keymap shell-mode-map))) - (define-key woksh-mode-map "\C-c\C-c" 'woksh-send-Ctrl-C) - (define-key woksh-mode-map "\C-c\C-d" 'woksh-send-Ctrl-D) - (define-key woksh-mode-map "\C-c\C-z" 'woksh-send-Ctrl-Z) - (define-key woksh-mode-map "\C-c\C-\\" 'woksh-send-Ctrl-backslash) - (define-key woksh-mode-map "\C-d" 'woksh-delchar-or-send-Ctrl-D) - (define-key woksh-mode-map "\C-i" 'woksh-tab-or-complete))) - - -;;(add-hook 'same-window-regexps "^\\*woksh-.*\\*\\(\\|<[0-9]+>\\)") - -(defvar woksh-history nil) - -;;;###autoload -(defun woksh (input-args &optional buffer) - "Open a woksh" - - (interactive (list - "1566" - current-prefix-arg)) - - (let* ((process-connection-type woksh-process-connection-type) - (args nil) - (buffer-name "*woksh*") - (iport (string-to-int input-args)) - proc) - - (cond ((null buffer)) - ((stringp buffer) - (setq buffer-name buffer)) - ((bufferp buffer) - (setq buffer-name (buffer-name buffer))) - ((numberp buffer) - (setq buffer-name (format "%s<%d>" buffer-name buffer))) - (t - (setq buffer-name (generate-new-buffer-name buffer-name)))) - - (setq buffer (get-buffer-create buffer-name)) - (pop-to-buffer buffer-name) - - (cond - ((comint-check-proc buffer-name)) - (t - (comint-exec buffer buffer-name woksh-program nil args) - (setq proc (get-buffer-process buffer)) - ;; Set process-mark to point-max in case there is text in the - ;; buffer from a previous exited process. - (set-marker (process-mark proc) (point-max)) - (woksh-mode) - - ;; comint-output-filter-functions is just like a hook, except that the - ;; functions in that list are passed arguments. add-hook serves well - ;; enough for modifying it. - (add-hook 'comint-output-filter-functions 'woksh-carriage-filter) - - (cd-absolute (concat comint-file-name-prefix "~/")))) - (if (not (eq iport 0)) - (if (not (wok-connectedp)) - (progn - (send-string nil (format "wokemacs_init %d\n" iport)) - (wok-connect-to-controller "localhost" iport) - (send-string nil "auto_load wok_cd_proc\n") - (erase-buffer) - ))))) - -(defun woksh-mode () - "Set major-mode for woksh sessions. -If `woksh-mode-hook' is set, run it." - (interactive) - (kill-all-local-variables) - (shell-mode) - (setq major-mode 'woksh-mode) - (setq mode-name "woksh") - (use-local-map woksh-mode-map) - (setq shell-dirtrackp woksh-directory-tracking-mode) - (make-local-variable 'comint-file-name-prefix) - (run-hooks 'woksh-mode-hook)) - -(defun woksh-directory-tracking-mode (&optional prefix) - "Do remote or local directory tracking, or disable entirely. - -If called with no prefix argument or a unspecified prefix argument (just -``\\[universal-argument]'' with no number) do remote directory tracking via -ange-ftp. If called as a function, give it no argument. - -If called with a negative prefix argument, disable directory tracking -entirely. - -If called with a positive, numeric prefix argument, e.g. -``\\[universal-argument] 1 M-x woksh-directory-tracking-mode\'', -then do directory tracking but assume the remote filesystem is the same as -the local system. This only works in general if the remote machine and the -local one share the same directories (through NFS)." - (interactive "P") - (cond - ((or (null prefix) - (consp prefix)) - (setq woksh-directory-tracking-mode t) - (setq shell-dirtrackp t) - (setq comint-file-name-prefix "")) - ((< prefix 0) - (setq woksh-directory-tracking-mode nil) - (setq shell-dirtrackp nil)) - (t - (setq woksh-directory-tracking-mode 'local) - (setq comint-file-name-prefix "") - (setq shell-dirtrackp t))) - (cond - (shell-dirtrackp - (let* ((proc (get-buffer-process (current-buffer))) - (proc-mark (process-mark proc)) - (current-input (buffer-substring proc-mark (point-max))) - (orig-point (point)) - (offset (and (>= orig-point proc-mark) - (- (point-max) orig-point)))) - (unwind-protect - (progn - (delete-region proc-mark (point-max)) - (goto-char (point-max)) - (shell-resync-dirs)) - (goto-char proc-mark) - (insert current-input) - (if offset - (goto-char (- (point-max) offset)) - (goto-char orig-point))))))) - - -;; Parse a line into its constituent parts (words separated by -;; whitespace). Return a list of the words. -(defun woksh-parse-words (line) - (let ((list nil) - (posn 0) - (match-data (match-data))) - (while (string-match "[^ \t\n]+" line posn) - (setq list (cons (substring line (match-beginning 0) (match-end 0)) - list)) - (setq posn (match-end 0))) - (store-match-data (match-data)) - (nreverse list))) - -(defun woksh-carriage-filter (string) - (let* ((point-marker (point-marker)) - (end (process-mark (get-buffer-process (current-buffer)))) - (beg (or (and (boundp 'comint-last-output-start) - comint-last-output-start) - (- end (length string))))) - (goto-char beg) - (while (search-forward "\C-m" end t) - (delete-char -1)) - (goto-char point-marker))) - -(defun woksh-send-Ctrl-C () - (interactive) - (send-string nil "\C-c")) - -(defun woksh-send-Ctrl-D () - (interactive) - (send-string nil "\C-d")) - -(defun woksh-send-Ctrl-Z () - (interactive) - (send-string nil "\C-z")) - -(defun woksh-send-Ctrl-backslash () - (interactive) - (send-string nil "\C-\\")) - -(defun woksh-delchar-or-send-Ctrl-D (arg) - "\ -Delete ARG characters forward, or send a C-d to process if at end of buffer." - (interactive "p") - (if (eobp) - (woksh-send-Ctrl-D) - (delete-char arg))) - -(defun woksh-tab-or-complete () - "Complete file name if doing directory tracking, or just insert TAB." - (interactive) - (if woksh-directory-tracking-mode - (comint-dynamic-complete) - (insert "\C-i"))) -;; - -(defun wok-command (command) - (interactive (list (read-from-minibuffer "Command : " - nil nil nil 'woksh-history))) - (save-excursion - - (if (not (wok-connectedp)) - (if (equal "yes" (completing-read "WOK not connected: connect ? (yes/no) : " - '(("yes") ("no")) nil t - '("yes" . 0) 'woksh-history)) - (woksh "1566" "*woksh*") - )) - - (if (wok-connectedp) - (progn - (set-buffer "*woksh*") - (woksh-parse-words (wok-send-command command))) - (progn - (ding) - (error "Wok controller not connected"))))) - -;; Goto Entity - -(defun wokcd ( userpath ) - "\ -Moves into a Wok entity" - (interactive (list (read-from-minibuffer "wokcd : " - nil nil nil 'woksh-history))) - - (wok-command (format "wokcd %s" userpath))) - - -(defun wcd ( Unit ) - (interactive (list (read-from-minibuffer "wcd : " - nil nil nil 'woksh-history))) - (wok-command (format "wokcd %s -PSrc" Unit))) - -;;; woksh.el ends here -(defvar woksh-entity-history nil) -(defvar woksh-type-history nil) -(defvar woksh-name-history nil) - -(defun wok-dired ( Entity Type ) - (interactive (list - (setq myent (completing-read "Entity : " - (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil - (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history)) - (completing-read "Type : " - (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil - '("source" . 0) 'woksh-type-history))) - ;; insert formatted string into a buffer - (let ((type Type)) - (if (not (string-match ":" Type)) - (setq type (format "%s:." Type))) - (set-buffer (dired - (car (wok-command (format "wokinfo -p %s %s\n" type Entity))))) - - (rename-buffer (format "%s-%s [%s] (%s)" - (car (wok-command (format "wokinfo -n %s" Entity))) - type - (car (wok-command (format "wokinfo -N %s" Entity))) - (car (wok-command (format "wokinfo -t %s" Entity))))))) - -(defun wok-findfile ( Entity Type FileName ) - (interactive (list - (setq myent (completing-read "Entity : " - (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil - (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history)) - (setq mytype (completing-read "Type : " - (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil - '("source" . 0) 'woksh-type-history)) - (completing-read "Name : " - (mapcar 'list (wok-command (format "uinfo -fT%s %s" mytype myent))) nil nil - '("" . 0) 'woksh-name-history))) - ;; insert formatted string into a buffer - (set-buffer (find-file - (car (wok-command (format "woklocate -p %s:%s:%s\n" Entity Type FileName))))) - ) - -(defun wok-locate ( Entity Type FileName ) - (interactive (list - (setq myent (completing-read "Entity : " - (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil - (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history)) - (setq mytype (completing-read "Type : " - (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil - '("source" . 0) 'woksh-type-history)) - (completing-read "Name : " - (mapcar 'list (wok-command (format "uinfo -fT%s %s" mytype myent))) nil nil - '("" . 0) 'woksh-name-history))) - ;; insert formatted string into a buffer - (car (wok-command (format "woklocate -p %s:%s:%s\n" Entity Type FileName))) - ) - - -(setq wok-compile-defaults '('("umake") ("umake -o obj") ("umake -o exec") ("umake -o xcpp"))) - -(defun wok-compile ( commande ) - (interactive (list - (completing-read "Command : " - wok-compile-defaults nil nil - "umake " 'woksh-history))) - (set-buffer "*woksh*") - (wok-command commande)) - -(defun concat-list-error (thelist) - (let ((res " ")) - (mapcar (lambda (x) - (setq res (concat res x " "))) - thelist) - res)) - -(defun receive-tcl-error (linearg) - (interactive) - - (kill-buffer (switch-to-buffer-other-window "*compilation*")) - (switch-to-buffer-other-window "*compilation*") - (compilation-mode) - (goto-char (point-max)) - (insert "\n\n") - (insert-file linearg) - (compile-goto-error) -) -- 2.39.5