+++ /dev/null
-/* 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"
-};
+++ /dev/null
-#
-# Interface ClearCase.
-#
-proc wokIntegre:BASE:ftos { file vrs } {
- return {}
-}
-#;>
-#
-#;<
-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 {}
-}
+++ /dev/null
-;#
-;# (((((((((((( 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 <level> avec le contenu de from
-;# <flevel> : fichier associe au level
-;# <from> : 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 <cfg>
-;# 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 <tag> avec le fichier configspec <file>
-;#
-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:
-;# <sta> 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 ))))))))))))
-;#
-;# <name> : 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:}
-}
+++ /dev/null
-#========================================================================================================\r
-# p-put Version 3.02 beta (egu 17/07/98 )\r
-# ajout verification que les fichiers embarques ne sont pas protege en ecriture sous WNT\r
-#========================================================================================================\r
-\r
-# \r
-# Usage\r
-# \r
-proc p-putUsage { } {\r
- puts stdout {p-put Version 3.02 17/07/98}\r
- puts stdout {Usage : p-put [-h] (this help)}\r
- puts stdout {Usage : p-put [-web] (updating web site)}\r
- puts stdout {Usage : p-put <cfg> [<cfg1>...] -B <BAG> -U <UL> } \r
- #puts stdout { p-put <cfg> [<cfg1>...] -B <BAG> -U <UL> [-P <patch>] }\r
- puts stdout { p-put <cfg> [<cfg1>...] -B <BAG> -U <UL> [-P <patch>] -L <liste-patch> -C "comment" }\r
- return\r
-}\r
-\r
-proc p-put { args } {\r
- global env\r
-\r
- set tblreq(-h) {}\r
- set tblreq(-web) {}\r
- set tblreq(-B) value_required:string\r
- set tblreq(-U) value_required:string\r
- set tblreq(-P) value_required:string\r
- set tblreq(-L) value_required:string\r
- set tblreq(-C) value_required:string\r
-\r
- set param {}\r
- if { [putils:EASY:GETOPT param tabarg tblreq p-putUsage $args] == -1 } return\r
-\r
-#==================== OPTIONS SETTINGS ==========================\r
-\r
- if [info exists tabarg(-web)] {\r
- update-web-data\r
- return\r
- }\r
-\r
- if [info exists tabarg(-h)] {\r
- p-putUsage\r
- return\r
- }\r
-\r
- set param_length [llength $param]\r
-\r
- if { $param_length == 0 } {\r
- puts stderr "Error : You must enter at least one configuration"\r
- return error\r
- } else {\r
- set list_config {}\r
- foreach config $param {\r
- lappend list_config $config\r
- }\r
- }\r
-\r
- ### ABOUT UL ###\r
-\r
- set nbargx 0\r
- if [info exists tabarg(-B)] {\r
- set SRC_BAG_PATH $tabarg(-B)\r
- if ![file exists $SRC_BAG_PATH] { \r
- puts stderr " Error : can not see $SRC_BAG_PATH"\r
- return error\r
- }\r
- incr nbargx\r
- }\r
-\r
- if [info exists tabarg(-U)] {\r
- set SRC_BAG_DIR $tabarg(-U)\r
- set SRC_DIR ${SRC_BAG_PATH}/${SRC_BAG_DIR}\r
- if ![file exists ${SRC_DIR}] { \r
- puts stderr " Error : can not see $SRC_BAG_DIR directory under $SRC_BAG_PATH"\r
- return error\r
- }\r
- incr nbargx\r
- }\r
-\r
- if [info exists tabarg(-P)] {\r
- set PATCH $tabarg(-P)\r
- set AUTONUM 0\r
- } else {\r
- set PATCH {}\r
- set AUTONUM 1\r
- }\r
-\r
- ### ABOUT PATCH ###\r
-\r
- set nbargy 0\r
-\r
- if [info exists tabarg(-C)] {\r
- set COMMENT $tabarg(-C)\r
- incr nbargy\r
- }\r
- \r
- \r
- if [info exists tabarg(-L)] {\r
- set LIST_FILE $tabarg(-L)\r
- if ![file readable $LIST_FILE] { \r
- puts stderr " Error : can not read $LIST_FILE"\r
- return\r
- } else {\r
- set f [open $LIST_FILE r]\r
- set PB 0\r
- while { [ gets $f line ] >= 0 } {\r
- if ![catch { glob ${SRC_DIR}/${line} } ] {\r
- foreach fich [glob ${SRC_DIR}/${line}] {\r
- if ![file readable $fich] {\r
- puts stderr " Error : can not read $fich"\r
- set PB 1\r
- } \r
- } \r
- if { $env(WOKSTATION) == "wnt"} {\r
- foreach fich [glob ${SRC_DIR}/${line}] {\r
- if ![file writable $fich] {\r
- puts stderr " Error : $fich not writable, problem will exist for next patch"\r
- set PB 1\r
- }\r
- }\r
- }\r
- } else {\r
- puts stderr " Error : can not glob line ${SRC_DIR}/${line}"\r
- set PB 1\r
- }\r
- }\r
- close $f\r
- if { $PB == 1 } { \r
- puts stderr " Procedure aborted " \r
- return 0\r
- }\r
- }\r
- incr nbargy\r
- } else {\r
- foreach fich [recursive_glob ${SRC_DIR} *] {\r
- if ![file readable $fich] {\r
- puts stderr " Error : can not read $fich"\r
- return\r
- }\r
- }\r
- if { $env(WOKSTATION) == "wnt"} {\r
- foreach fich [recursive_glob ${SRC_DIR} *] {\r
- if ![file writable $fich] {\r
- puts stderr " Error : $fich not writable, problem will exist for next patch"\r
- return\r
- }\r
- }\r
- }\r
- }\r
-\r
- ### REFERENCE ###\r
-\r
- set ULBAG [wokparam -e %BAG_Home REFERENCE]\r
-\r
- ### LETS GO ###\r
- \r
- if [expr {$nbargx == 2 && $nbargy == 0}] {\r
- if {[put-ul $SRC_BAG_PATH $SRC_BAG_DIR $ULBAG $list_config] == 1 } { return end }\r
- return error\r
- }\r
-\r
- if [expr { $nbargx == 2 && $nbargy == 2}] {\r
- if {[put-patch $SRC_BAG_PATH $SRC_BAG_DIR $AUTONUM $PATCH $ULBAG $LIST_FILE $COMMENT $list_config] == 1 } { return end }\r
- return error\r
- } \r
- \r
-}\r
-\r
-##################### PUT-UL ######################################\r
-\r
-proc put-ul { src_bag ul_name dest_dir config_list} {\r
- \r
- \r
- if [file exists ${dest_dir}/${ul_name}.tar.gz] {\r
- puts stderr "Error : ${ul_name}.tar.gz already exist in ${dest_dir}"\r
- return 0\r
- }\r
- \r
- set savpwd [pwd]\r
- cd ${src_bag}/${ul_name} \r
-\r
- puts stdout "Info : Creating ${dest_dir}/${ul_name}.tar"\r
- \r
- if { [putils:EASY:tar tarfromroot ${dest_dir}/${ul_name}.tar .] == -1 } {\r
- puts stderr "Error while creating ${dest_dir}/{ul_name}.tar "\r
- catch {unlink ${dest_dir}/${ul_name}.tar}\r
- cd $savpwd\r
- return 0\r
- } \r
- \r
- puts stdout "Info : Gziping ${dest_dir}/${ul_name}.tar"\r
- \r
- if { [putils:FILES:compress ${dest_dir}/${ul_name}.tar] == -1 } {\r
- puts stderr "Error while creating ${dest_dir}/${ul_name}.tar.gz\r
- catch {unlink ${dest_dir}/${ul_name}.tar}\r
- catch {unlink ${dest_dir}/${ul_name}.tar.gz}\r
- cd $savpwd\r
- return 0\r
- }\r
-\r
- #### Construction du fichier de trace ####\r
- puts stdout "Info : Creating trace file ${dest_dir}/TRC/${ul_name}.trc"\r
- set trace [open ${dest_dir}/TRC/${ul_name}.trc w]\r
- foreach fich [glob ${src_bag}/${ul_name}/*] {\r
- puts $trace $fich\r
- }\r
- close $trace\r
-\r
- #### Inscription dans le(s) configul(s) ####\r
- set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"]\r
- foreach config $config_list {\r
- set CONFIGUL ${dest_dir}/CONFIGUL.${config}\r
- puts stdout " Updating $CONFIGUL"\r
- set f [ open $CONFIGUL a+]\r
- set s [format "%-18s %s" $ul_name $now]\r
- puts $f $s\r
- close $f\r
- }\r
-\r
- ###fin\r
- puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]"\r
- cd $savpwd\r
-\r
-\r
- #### mise a jour des fichiers du web #### \r
- update-web-data\r
-\r
- return 1 \r
-}\r
-\r
-\r
-#\r
-##################### PUT-PATCH ######################################\r
-#\r
-\r
-proc put-patch { src_bag ul_name AUTONUM patch_name dest_bag lst_patch comment config_list} {\r
- \r
- set dest_dir $dest_bag/PATCH\r
-\r
- ### Pour la numerotation automatique ###\r
- if { $AUTONUM} {\r
- set level [conf_ul_level $ul_name [lindex $config_list 0] $dest_bag]\r
- foreach config $config_list {\r
- if ![ file exists ${dest_dir}/PATCHISTO.${config} ] {\r
- puts stderr "Error autonum: File ${dest_dir}/PATCHISTO.${config} dont exist, you must create it"\r
- return 0\r
- }\r
- set new_level [conf_ul_level $ul_name $config $dest_bag]\r
- if { $new_level != $level } {\r
- puts stderr " Error autonum : different patch levels in different configul "\r
- return 0\r
- }\r
- }\r
- \r
- \r
- if { $level == -1 } { \r
- puts stderr " Error : can't calculate patch levels "\r
- return 0\r
- }\r
- incr level\r
- set patch_name ${ul_name}_${level}\r
- puts stdout "Info : patch auto numerotation = $level"\r
- }\r
-\r
- #####\r
-\r
- set savpwd [pwd]\r
- cd ${src_bag}/${ul_name}\r
- \r
- if [file exists ${dest_dir}/${patch_name}.tar.gz ] {\r
- puts stderr "Error : File ${dest_dir}/${patch_name}.tar.gz already exists. Nothing done"\r
- cd $savpwd\r
- return 0\r
- }\r
-\r
- puts stdout "Info : Creating ${dest_dir}/${patch_name}.tar"\r
- \r
-if { [putils:EASY:tar tarfromliste ${dest_dir}/${patch_name}.tar ${lst_patch}] == -1 } {\r
- puts stderr "Error while creating ${dest_dir}/{patch_name}.tar "\r
- catch {unlink ${dest_dir}/{patch_name}.tar }\r
- cd $savpwd\r
- return 0\r
- } \r
- \r
- puts stdout "Info : Gziping ${dest_dir}/${patch_name}.tar"\r
- if { [putils:FILES:compress ${dest_dir}/${patch_name}.tar] == -1 } {\r
- puts stderr "Error while creating ${dest_dir}/${patch_name}.tar.gz\r
- catch {unlink ${dest_dir}/${patch_name}.tar}\r
- catch {unlink ${dest_dir}/${patch_name}.tar.gz}\r
- cd $savpwd\r
- return 0\r
- }\r
-\r
- puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]"\r
- \r
- #### Construction du fichier de trace ####\r
- puts stdout "Info : Creating trace file ${dest_dir}/TRC/${patch_name}.trc"\r
- set f [open $lst_patch r]\r
- set trace [open ${dest_dir}/TRC/${patch_name}.trc w]\r
- while { [ gets $f line ] >= 0 } {\r
- foreach fich [glob ${src_bag}/${ul_name}/${line}] {\r
- puts $trace $fich\r
- }\r
- }\r
- close $f\r
- close $trace\r
- \r
- #### Inscription dans le(s) patchisto(s) ####\r
- \r
- #set now [string range [fmtclock [getclock]] 0 18]\r
- set now [clock format [getclock] -format "%d/%m/%y %H:%M:%S"]\r
- set level [lindex [split ${patch_name} _] end]\r
- set ul_name [lindex [split ${patch_name} _] 0]\r
- foreach config $config_list {\r
- set PATCHISTO "${dest_dir}/PATCHISTO.${config}"\r
- puts stdout "Info : updating $PATCHISTO"\r
- set f [open $PATCHISTO r+]\r
- set indice 0\r
- while { [ gets $f line ] >= 0 } {\r
- if [ ctype alnum [ lindex $line 0 ] ] {\r
- set indice [ lindex $line 0 ]\r
- }\r
- }\r
- incr indice\r
- puts stdout "Info : $PATCHISTO patch indice = $indice"\r
- close $f\r
- set lpatch [putils:FILES:FileToList $PATCHISTO ]\r
- set s [format "%-5s%-18s%3s %-5s %s" $indice $ul_name $level $now $comment]\r
- lappend lpatch $s\r
- putils:FILES:ListToFile $lpatch $PATCHISTO\r
- }\r
-\r
- ###FIN\r
- puts stdout " success... at [set now [string range [fmtclock [getclock]] 0 18]]"\r
- cd $savpwd\r
-\r
- #### mise a jour des fichiers du web #### \r
- update-web-data\r
-\r
- return 1 \r
-}\r
-\r
-#=================================================================================\r
-proc conf_ul_level { ul_name config bag_path } {\r
-\r
- set CONFIGUL ${bag_path}/CONFIGUL.${config}\r
- set PATCHISTO ${bag_path}/PATCH/PATCHISTO.${config}\r
-\r
- set level -1\r
- if [file exists ${CONFIGUL} ] { \r
- set f [open $CONFIGUL r ]\r
- while {[gets $f line] >= 0 } {\r
- if [ctype alnum [ cindex [lindex $line 0] 0 ] ] {\r
- if { [lindex $line 0] == $ul_name } {\r
- set level 0\r
- }\r
- }\r
- }\r
- close $f\r
- }\r
- \r
- if [file exists ${PATCHISTO}] { \r
- set f [open $PATCHISTO r]\r
- while { [ gets $f line ] >= 0 } {\r
- if [ ctype alnum [ lindex $line 0 ] ] {\r
- if { [lindex $line 1] == $ul_name } {\r
- set level [lindex $line 2]\r
- }\r
- }\r
- }\r
- close $f\r
- }\r
- return $level\r
-}\r
-\r
-#################################################\r
-proc update-web-data { } {\r
-\r
- global env \r
- set PROCFTPPATH $env(FACTORYHOME)/MajWeb\r
- puts -nonewline "=== Updating www data....."\r
-\r
- if { $env(WOKSTATION) == "wnt"} {\r
- if [file exists $PROCFTPPATH/putdata.ftp] { \r
- if [catch { eval exec ftp {-v -i -s:$PROCFTPPATH/putdata.ftp} } status] {\r
- puts stderr $status\r
- } else {\r
- puts " done ==="\r
- }\r
- } else {\r
- puts stdout "Info : Cant find $PROCFTPPATH/putdata.ftp"\r
- }\r
- } else {\r
- if [file exists $PROCFTPPATH/putdata.com] { \r
- if [catch { eval exec $PROCFTPPATH/putdata.com } status] {\r
- puts stderr $status\r
- } else {\r
- puts " done ==="\r
- }\r
- } else {\r
- puts stdout "Info : Cant find $PROCFTPPATH/putdat.ftp"\r
- }\r
- }\r
-return\r
-}\r
-\r
-#========================================================================================================\r
-# p-get Version 3.04 (egu 29/09/98 )\r
-# ajout de l'option -f pour forcer l'install des patch\r
-# (ajout de l'option -runtime pour ne pas faire de declarations\r
-# liees a la descente des patchs)activite non visible\r
-# Modification de nombreuses functions pour wok: wok n'est plus versionne\r
-# suppression des options -v (verbose) et -n (no execute)\r
-#========================================================================================================\r
-#========================================================================================================\r
-#========================================================================================================\r
-\r
-proc p-get-usage { } {\r
- puts stderr {}\r
- puts stdout {p-get Version 3.04 (september 98)}\r
- #puts stderr {Usage : p-get [-h][-f][-rt][-clean][-d dirinstall] <conf> [del list] [-P patch |-I indice]}\r
- puts stderr {Usage : p-get [-h][-f][-clean][-d dirinstall] <conf> [del list] [-P patch |-I indice]}\r
- puts stderr { -h : this help}\r
- puts stderr { -f : force install}\r
-# puts stderr { -rt : runtime mode} #fonctionne mais volontairement cache\r
- puts stderr { -clean : clean mode}\r
- puts stderr { [-d dirinstall] : directory to install ul}\r
- puts stderr { <conf> : configuration}\r
- puts stderr { [del list] : list of one or more Delivery: [ <del1> [del2] [del3] ... ]}\r
- puts stderr { OR "ALL" ("ALL" is default value)}\r
- puts stderr { [-P patch | : patch number OR "ALL" ("ALL" is default value)}\r
- puts stderr { |-I indice] : indice number OR "ALL" ("ALL" is default value)}\r
-# puts stderr { Online doc at http://info.paris1.matra-dtv.fr/Devlog/Departements/Dcfao/env/pget304.htm}\r
- return\r
-}\r
-\r
-#========================================================================================================\r
-\r
-proc p-get { args } {\r
- \r
- global env\r
- \r
- set tblreq(-h) {}\r
- set tblreq(-f) {}\r
- set tblreq(-rt) {}\r
- set tblreq(-clean) {}\r
- set tblreq(-d) value_required:string\r
- set tblreq(-P) value_required:string\r
- set tblreq(-I) value_required:string\r
- \r
- set param {}\r
- if { [putils:EASY:GETOPT param tabarg tblreq p-get-usage $args] == -1 } return\r
- set param_length [llength $param]\r
- \r
- #======================================= VARIABLES SETTINGS =============================================\r
- if [info exists tabarg(-h)] {\r
- p-get-usage\r
- return\r
- }\r
- \r
- #----------- WOK SETTINGS ------------------------------------- \r
- wokclose -a [wokparam -e %[finfo]_Home]\r
- set SRCBAGPATH [wokparam -e %BAG_Home REFERENCE]\r
- set SRCPATCHPATH $SRCBAGPATH/PATCH\r
- set DESTBAGPATH [wokparam -e %BAG_Home]\r
-\r
- #------------- OPTIONS SETTINGS -------------------------------\r
- set FORCE [info exists tabarg(-f)]\r
- set RUNTIME [info exists tabarg(-rt)]\r
- set CLEAN [info exists tabarg(-clean)]\r
-\r
- if [info exists tabarg(-d)] {\r
- set NEWDIR $tabarg(-d)\r
- } else {\r
- set NEWDIR 0\r
- }\r
- \r
- if { $param_length == 0 } {\r
- puts stderr " Error : You must at least enter a configuration"\r
- p-get-usage\r
- return\r
- }\r
-\r
- set CONF [lindex $param 0]\r
- set CONFIGUL ${SRCBAGPATH}/CONFIGUL.${CONF}\r
- if { ![file exists $CONFIGUL] } {\r
- puts stderr " Error : Cannot find $CONFIGUL, maybe version $CONF don't exist "\r
- p-get-usage\r
- return\r
- }\r
- \r
- set PATCHISTO ${SRCPATCHPATH}/PATCHISTO.${CONF}\r
- \r
- set ul_list {}\r
- if { $param_length == 1 } { lappend ul_list ALL }\r
- if { $param_length >= 2 } {\r
- if { [lindex $param 1] == "ALL" } { \r
- lappend ul_list ALL \r
- } else {\r
- for { set i 1 } { $i < $param_length } { incr i } {\r
- lappend ul_list [lindex $param $i]\r
- }\r
- }\r
- }\r
- \r
- if [info exists tabarg(-P)] {\r
- set maxlevel $tabarg(-P)\r
- if { $maxlevel != "ALL" && [ctype digit $maxlevel] == 0 } {\r
- puts stderr " Error : -P option must be a number or \"ALL\""\r
- p-get-usage\r
- return\r
- }\r
- } else {\r
- set maxlevel ALL\r
- }\r
- \r
- if [info exists tabarg(-I)] {\r
- set maxindice $tabarg(-I)\r
- if { $maxindice != "ALL" && [ctype digit $maxindice] == 0 } {\r
- puts stderr " Error : -I option must be a number or \"ALL\""\r
- p-get-usage\r
- return\r
- }\r
- } else {\r
- set maxindice ALL\r
- }\r
- \r
- \r
- #----------- OPTIONS RESTRICTIONS --------------------------\r
- \r
- if { $maxlevel != "ALL" && $maxindice != "ALL" } {\r
- puts stderr "Error : You can't use -I and -P options together"\r
- return\r
- }\r
- \r
- if { $maxlevel != "ALL" } {\r
- if { [llength $ul_list] > 1 || [lindex $ul_list 0] == "ALL"} {\r
- puts stderr "Error : You can't use -P option with more than one selected UL"\r
- return\r
- }\r
- }\r
- \r
- #-- Infos --\r
- puts "SELECTED UL(s) : $ul_list"\r
- puts "CONFIGURATION : $CONF"\r
- puts "MAX PATCH LEVEL : $maxlevel"\r
- puts "MAX INDICE LEVEL : $maxindice"\r
- if { $NEWDIR != 0 } {\r
- puts "INSTALLATION DIR : $NEWDIR"\r
- } else {\r
- puts "INSTALLATION DIR : $DESTBAGPATH"\r
- }\r
- if $FORCE { puts "FORCE ON" }\r
- if $RUNTIME { puts "RUNTIME ON" }\r
- puts {}\r
-\r
- \r
- #================================= LET'S GO ==============================================\r
- #====== creating array mytab of couples (ul full name - patch level to be installed) ======\r
-\r
- #reconstruct ul_list if "ALL" ul specified\r
- if { [lindex $ul_list 0] == "ALL" } {\r
- set admdir [wokparam -e %[finfo]_Adm]\r
- set file ${admdir}/${CONF}.edl\r
- if [file exists $file] {\r
- wokclose -a [wokparam -e %[finfo]_Home]\r
- set lst_conf [join [wokparam -e %${CONF}_Config] ]\r
- if ![ catch { wokparam -e %${CONF}_Runtime } gonogo ] {\r
- foreach a [join [wokparam -e %${CONF}_Runtime] ] { lappend lst_conf $a }\r
- } \r
- set ul_list {}\r
- foreach p $lst_conf {\r
- if { [lindex [split $p "-"] 1] != $CONF } {\r
- puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p"\r
- #return\r
- } else {\r
- lappend ul_list [lindex [split $p "-"] 0]\r
- } \r
- }\r
- foreach p $lst_conf {\r
- if { [lindex [split $p "-"] 1] != $CONF } {\r
- puts stdout " Info: I don't take accompt of a bad parcel name in your $file : $p"\r
- #return\r
- } else {\r
- lappend ul_list [lindex [split $p "-"] 0]\r
- } \r
- }\r
- } else {\r
- puts stderr "Error: None ul installed. Option ul_list = ALL can't be used"\r
- return\r
- }\r
- }\r
-\r
- #construct array from CONFIGUL file\r
- if { [array-set-from-CONFIGUL tab $CONFIGUL $ul_list] == 0 } { return }\r
-\r
- if { [array exists tab] == 0 } {\r
- puts stderr "Error : none del of $CONF matching given list"\r
- return\r
- }\r
-\r
- #construct array from PATCHISTO file\r
- array-set-from-PATCHISTO tab $PATCHISTO $ul_list $maxindice $maxlevel\r
- \r
- #----------- Infos ----------------- \r
- puts "***** install levels *****"\r
- array-print tab\r
- \r
-\r
- #====================== Installation from array "tab" ===============================\r
- \r
- set lstul [ lsort [array names tab] ]\r
- \r
- ### set destination directory ###\r
- if { $NEWDIR != 0 } {\r
- foreach MYUL $lstul {\r
- set MYDEL [lindex [split $MYUL "-"] 0]\r
- set PARCELPATH [parcel-path $MYUL $CONF]\r
- \r
- #verrue wok\r
- if { $MYDEL == "wok"} {\r
- set pat ${DESTBAGPATH}/${MYUL}\r
- if { $NEWDIR != $pat } {\r
- puts stderr "Error : wok cannot be install in a special directory"\r
- return\r
- }\r
- }\r
- #fin verrue wok\r
- \r
- if { $PARCELPATH != 0 && $PARCELPATH != $NEWDIR } {\r
- puts stderr "${MYDEL}-${CONF} already exist in $PARCELPATH : Cannot create same parcel in $NEWDIR"\r
- puts stderr "Nothing done"\r
- return\r
- }\r
- }\r
- }\r
-\r
- ### begin install from array tab ###\r
- foreach MYUL $lstul {\r
- if { $tab($MYUL) >= 0 } {\r
- set MYDEL [lindex [split $MYUL "-"] 0]\r
- \r
- ### test for wok \r
- if { $MYDEL == "wok"} { \r
- set MYPARCEL ${MYUL}\r
- set PARCELPATH ${DESTBAGPATH}/${MYPARCEL}\r
- } else {\r
- set MYPARCEL ${MYDEL}-${CONF}\r
- if { $NEWDIR != 0 } {\r
- set PARCELPATH $NEWDIR \r
- } else {\r
- set PARCELPATH [parcel-path $MYUL $CONF]\r
- if { $PARCELPATH == 0 } {\r
- set PARCELPATH ${DESTBAGPATH}/${MYPARCEL}\r
- }\r
- }\r
- }\r
- \r
- if $FORCE { \r
- set level_to_begin_install 0 \r
- } else {\r
- set installed_level [parcel-level $MYUL $CONF]\r
- set level_to_begin_install [expr ( $installed_level + 1)]\r
- }\r
- \r
- if { $level_to_begin_install > $tab($MYUL) } {\r
- set bag_patch_level [conf_ul_level $MYUL $CONF $SRCBAGPATH]\r
-#FUN 13/10/98 \r
- if {$installed_level > $tab($MYUL)} {\r
- puts "\nWarning: $MYUL is already at level $installed_level > $tab($MYUL)"\r
- } else {\r
- puts "\n----- $MYUL is already at level $installed_level (max = $bag_patch_level)"\r
- }\r
- } else {\r
- set s [format "\n----- INSTALLING %-15s\t%-3s>> %-3s in %s -----" $MYUL $level_to_begin_install $tab($MYUL) $PARCELPATH ]\r
- puts stdout $s\r
- }\r
- \r
- for { set pnumber $level_to_begin_install } { $pnumber <= $tab($MYUL) } { incr pnumber } {\r
- puts stdout "INSTALL LEVEL $pnumber"\r
- switch $pnumber 0 {\r
- if { ![install-ul $MYUL $SRCBAGPATH $PARCELPATH $CONF taberror $RUNTIME $FORCE]} { break }\r
- set pnumber [expr max(0,[parcel-level $MYUL $CONF])]\r
- } default {\r
- if { ![install-patch $MYUL $pnumber $SRCPATCHPATH $PARCELPATH $CONF taberror] } { break }\r
- \r
- }\r
- }\r
- \r
- if $CLEAN {\r
- set lst_station [join [wokparam -e %[finfo -W]_Stations] " "]\r
- foreach station [join [wokparam -e %REFERENCE_Stations] " "] {\r
- if {[lsearch -exact $lst_station $station] == -1} { \r
- puts stdout " - removing $station dependent files..."\r
- if { [file exists $PARCELPATH/$station] } { catch { exec rm -rf $PARCELPATH/$station } }\r
- if { [file exists $PARCELPATH/tmp/$station] } { catch { exec rm -rf $PARCELPATH/tmp/$station } }\r
- if { [file exists $PARCELPATH/.adm/$station] } { catch { exec rm -rf $PARCELPATH/.adm/$station } }\r
- }\r
- }\r
- }\r
- }\r
- }\r
- array-print taberror\r
- \r
- return\r
-}\r
-\r
-#=================================================================\r
-# ARRAY-SET-FROM-CONFIGUL (egu)\r
-#\r
-# set "array_name" with couples (ul-level) get from "conf-file".\r
-# with ul matching "ul-list" element\r
-#=================================================================\r
-\r
-proc array-set-from-CONFIGUL { array_name conf_file ul_list } {\r
-\r
- upvar $array_name tab\r
- if [file readable $conf_file ] {\r
- set f [open $conf_file r]\r
- set line {}\r
- while {[gets $f line] >= 0 } { \r
- if { [llength $line] != 0 } { \r
- if { [ctype alnum [cindex [lindex $line 0] 0]] == 1 } { \r
- set ul_name [lindex $line 0]\r
- if { [lindex $ul_list 0] == "ALL" } {\r
- set tab($ul_name) 0\r
- } else {\r
- foreach ul $ul_list {\r
- if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } {\r
- set tab($ul_name) 0 \r
- break\r
- }\r
- }\r
- }\r
- }\r
- }\r
- }\r
- close $f\r
- } else {\r
- puts stderr "Error : Can not read $conf_file"\r
- return 0\r
- }\r
-\r
- return 1\r
-}\r
-\r
-\r
-#=================================================================\r
-# ARRAY-SET-FROM-PATCHISTO (egu)\r
-#\r
-# set "array_name" with couples (ul-level) get from "patch-file"\r
-# line of indice < max_i\r
-# with ul matching "ul-list" element \r
-# with level < max_p\r
-#=================================================================\r
-\r
-proc array-set-from-PATCHISTO { array_name patch_file ul_list {max_i ALL} {max_p ALL} } {\r
-\r
- upvar $array_name tab\r
- if { $max_i == "ALL" } { set maxindice 1000000 } else { set maxindice $max_i }\r
- if { $max_p == "ALL" } { set maxpatch 1000000 } else { set maxpatch $max_p }\r
- if [ file readable $patch_file ] {\r
- set f [open $patch_file r]\r
- set line {}\r
- incr maxindice\r
- while { [ gets $f line ] >= 0 && [ lindex $line 0 ] != $maxindice } {\r
- if { [ llength $line ] != 0 } { \r
- if { [ ctype alnum [ lindex $line 0 ] ] == 1 } {\r
- \r
- set ul_name [lindex $line 1]\r
- set ul_level [lindex $line 2]\r
- if { [lindex $ul_list 0] == "ALL" } {\r
- set tab($ul_name) $ul_level \r
- } else {\r
- foreach ul $ul_list {\r
- if { $ul == $ul_name || $ul == [lindex [split $ul_name "-"] 0 ] } {\r
- set tab($ul_name) [expr min($ul_level,$maxpatch)] \r
- break\r
- }\r
- }\r
- }\r
- }\r
- }\r
- }\r
- close $f\r
- } else {\r
- #puts stderr "Info : Can't find $patch_file, no patch exist for this configuration"\r
- return 0\r
- }\r
- return 1\r
-}\r
-\r
-#=================================================================\r
-# ARRAY-PRINT (egu)\r
-#=================================================================\r
-proc array-print { array_name } {\r
- upvar $array_name tab\r
- set lst [lsort [array names tab]] \r
- foreach elt $lst {\r
- set s [format "%-20s\t%s" $elt $tab($elt)]\r
- puts stdout $s\r
- }\r
-}\r
-\r
-#=================================================================\r
-# PARCEL-EXIST (egu)\r
-# test if parcel exist\r
-# Last modif: 27/07/98: for wok (param del become param ul)\r
-#=================================================================\r
-\r
-proc parcel-exist { ul conf } {\r
- set del [lindex [split $ul "-"] 0]\r
- #verrue wok\r
- if { $del == "wok" } { \r
- if [file exists [wokparam -e %BAG_Home]/${ul}] { \r
- return 1 \r
- } else {\r
- return 0\r
- }\r
- }\r
- #fin verrue wok\r
- set ul_name ${del}-${conf}\r
- set lst [ Winfo -p [finfo]:[finfo -W]]\r
- if {[lsearch -exact $lst $ul_name] == -1} { return 0 } else { return 1 }\r
-}\r
-#=================================================================\r
-# PARCEL-PATH (egu)\r
-# return parcel-path, 0 if it parcel doesn't exist\r
-# Last modif: 27/07/98: for wok (param del become param ul)\r
-#=================================================================\r
-\r
-proc parcel-path { ul conf } {\r
- set del [lindex [split $ul "-"] 0]\r
- if [parcel-exist $ul $conf] {\r
- if { $del == "wok" } {\r
- set path [wokparam -e %BAG_Home]/${ul}\r
- } else {\r
- set path [wokinfo -p HomeDir [finfo]:[finfo -W]:${del}-${conf}]\r
- }\r
- return $path\r
- } else {\r
- return 0\r
- }\r
-}\r
-#=================================================================\r
-# PARCEL-LEVEL (egu)\r
-# return the patch top level already install, -1 if no install\r
-# Last modif: 27/07/98: for wok (param del become param ul)\r
-#=================================================================\r
-\r
-proc parcel-level { ul conf } {\r
- if [parcel-exist $ul $conf] {\r
- set del [lindex [split $ul "-"] 0]\r
- if { $del == "wok" } { \r
- set getpatch_file [parcel-path $ul $conf]/.${ul}.GETPATCH \r
- } else {\r
- set getpatch_file [parcel-path $ul $conf]/.${del}-${conf}.GETPATCH\r
- }\r
- if [file exists $getpatch_file] {\r
- set list_level [lsort -integer [p-get-installed $getpatch_file]]\r
- set index [llength $list_level]\r
- incr index -1\r
- return [lindex $list_level $index]\r
- } else {\r
- return 0\r
- }\r
- } else {\r
- return -1\r
- }\r
-}\r
-\r
-#=================================================================\r
-# INSTALL-UL (egu)\r
-#\r
-# create and declare parcel, return 0 if failled\r
-# if success : return patch level already install\r
-# 27/07/98: verrue for wok (egu) ajout option force et runtime\r
-# 10/08/98: supression option vernose et no-execute\r
-#=================================================================\r
-\r
-proc install-ul { ul_name src_dir dest_dir conf tab_error RUNTIME FORCE} {\r
- \r
- ### variables setting\r
- upvar $tab_error tab_err\r
-\r
- #verrue anti verion pour wok\r
- set MYDEL [lindex [split $ul_name "-"] 0]\r
- if { $MYDEL == "wok" } {\r
- set MYPARCEL ${ul_name}\r
- } else {\r
- set MYPARCEL ${MYDEL}-${conf}\r
- }\r
- set WAREHOUSE_ADM_PATH [wokparam -e %[finfo -W]_Adm]\r
- set wdeclare_file ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl \r
- set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH\r
- set parcellist_file ${WAREHOUSE_ADM_PATH}/ParcelList \r
- \r
- ### on verifie l'existence du fichier a decompresser\r
- set tar ${src_dir}/${ul_name}.tar.gz\r
- if ![file exists $tar] {\r
- puts stderr ".... error"\r
- puts stderr "Nothing done : Cannot find $tar"\r
- set tab_err($ul_name) "Nothing done : Cannot find $tar"\r
- return 0\r
- }\r
- \r
- ### test cause option -d : dest_dir peut deja exister\r
- if { ![file exists $dest_dir] } {\r
- puts stdout " - Mkdir $dest_dir ..."\r
- if [catch { mkdir $dest_dir} mkstat] {\r
- puts stderr ".... error"\r
- puts stderr "Nothing done : Cannot create $dest_dir : $mkstat"\r
- set tab_err($ul_name) "Nothing done : Cannot create $dest_dir : $mkstat"\r
- return 0\r
- }\r
- }\r
- \r
- ### security cleaning\r
- if [file exists $getpatch_file] { \r
- puts stdout " - remove $getpatch_file"\r
- exec rm -rf $getpatch_file \r
- }\r
- \r
- ### let's go\r
- puts stdout " - Downloading $tar in $dest_dir..."\r
- p-get-ptar $ul_name $dest_dir $tar\r
- \r
- ### in FORCE case without first classic install\r
- \r
- if { $MYDEL != "wok" && $FORCE } { \r
- if ![file exists [wokparam -e %[finfo -W]_Adm]/${MYPARCEL}.edl] { \r
- set FORCE 0 \r
- puts stdout " -> Info: ${MYPARCEL} has never been declared, it will in spite of FORCE option"\r
- }\r
- }\r
- \r
- # if: verrue for wok: pas de declaration\r
- if { $MYDEL != "wok" && !$FORCE } {\r
- if { [file exists ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl] } {\r
- puts stderr ".... error"\r
- puts stderr "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists"\r
- set tab_err($ul_name) "Cannot create ${WAREHOUSE_ADM_PATH}/${MYPARCEL}.edl : file already exists"\r
- return 0\r
- } else {\r
- puts stdout " - Wdeclare ${MYPARCEL} (Don't worry about \"Error : No entity...\")" \r
- puts stdout " -> Info: Wdeclare create $wdeclare_file and update $parcellist_file"\r
- \r
- if { [catch { Wdeclare -p $MYPARCEL -d -DHome=${dest_dir} -DStations=[join [wokparam -e %[finfo -W]_Stations] " "] -DDelivery=${MYDEL} [finfo -W] } ] } {\r
- puts stderr ".... error" \r
- puts stderr "Error Wdeclare $MYPARCEL"\r
- set tab_err($ul_name) "Error Wdeclare $MYPARCEL"\r
- return 0\r
- } \r
- }\r
- \r
- #declaration\r
- set FACTORY_ADM_PATH [wokparam -e %[finfo]_Adm]\r
- puts stdout " - Updating ${FACTORY_ADM_PATH}/${conf}.edl file... "\r
- if {[maj-conf-edl $conf $MYPARCEL $RUNTIME] == 0 } {\r
- puts stderr ".... error"\r
- puts stderr "Cannot update ${FACTORY_ADM_PATH}/${conf}.edl"\r
- set tab_err($ul_name) "Error : Cannot update ${FACTORY_ADM_PATH}/${conf}.edl"\r
- return 0\r
- }\r
- } \r
- return 1 \r
-}\r
-#=================================================================\r
-# MAJ-CONF-EDL (egu)\r
-# Mise a jour du fichier BAG/adm/${conf}.edl\r
-# return 1 si ok, 0 sinon\r
-#=================================================================\r
-\r
-proc maj-conf-edl { conf new_parcel RUNTIME } {\r
- set admdir [wokparam -e %[finfo]_Adm]\r
- set lst_conf {}\r
- set lst_runt {}\r
- if [file exists ${admdir}/${conf}.edl] {\r
- wokclose -a [wokparam -e %[finfo]_Home]\r
- set lst_conf [join [wokparam -e %${conf}_Config] ]\r
- ### test cause old version of $file.edl\r
- if ![ catch { wokparam -e %${conf}_Runtime } toto ] {\r
- set lst_runt [join [wokparam -e %${conf}_Runtime] ]\r
- } \r
- exec rm -rf ${admdir}/${conf}.edl \r
- } else {\r
- #lappend lst_conf $new_parcel\r
- } \r
- if { $RUNTIME } {\r
- lappend lst_runt $new_parcel\r
- } else {\r
- lappend lst_conf $new_parcel\r
- }\r
- return [make-conf-edl $conf $lst_conf $lst_runt ]\r
-}\r
-#=================================================================\r
-# MAKE-CONF-EDL (egu)\r
-#=================================================================\r
-\r
-proc make-conf-edl { conf lst_conf lst_runt } {\r
- set admdir [wokparam -e %[finfo]_Adm]\r
- set path ${admdir}/${conf}.edl\r
- if [ catch { set fid [ open $path w ] } ] {\r
- return 0\r
- } else {\r
- puts $fid "@set %${conf}_Config = \"$lst_conf\"; "\r
- puts $fid "@set %${conf}_Runtime = \"$lst_runt\"; "\r
- close $fid\r
- wokclose -a [wokparam -e %[finfo]_Home]\r
- return 1\r
- }\r
-}\r
-#=================================================================\r
-# INSTALL-PATCH (egu)\r
-#=================================================================\r
-\r
-proc install-patch { ul_name patch_level src_dir dest_dir conf tab_error} {\r
- upvar $tab_error tab_err\r
- set tar ${src_dir}/${ul_name}_${patch_level}.tar.gz\r
- if ![catch { file exists $tar } ] {\r
- set MYDEL [lindex [split $ul_name "-"] 0]\r
- if { $MYDEL == "wok" } {\r
- set MYPARCEL ${ul_name}\r
- } else {\r
- set MYPARCEL ${MYDEL}-${conf}\r
- }\r
-\r
- #untar\r
- puts stdout " - Downloading $tar in $dest_dir... "\r
- p-get-ptar ${ul_name}_${patch_level} $dest_dir $tar\r
- \r
- # updating .GETPATCH file\r
- set getpatch_file ${dest_dir}/.${MYPARCEL}.GETPATCH\r
- puts stdout " - Updating $getpatch_file file..."\r
- set now [string range [fmtclock [getclock]] 0 18]\r
- if [file exists $getpatch_file] {\r
- set lf [putils:FILES:FileToList $getpatch_file]\r
- } else {\r
- set lf {}\r
- }\r
- set s [format "%s %s %s %s" $ul_name ${ul_name}_${patch_level} $dest_dir $now]\r
- lappend lf $s\r
- putils:FILES:ListToFile $lf $getpatch_file\r
- \r
- \r
- } else {\r
- puts stderr ".... error"\r
- puts stderr "Nothing done : Cannot find $tar"\r
- set tab_err(${ul_name}_${patch_level}) "Nothing done : Cannot find $tar"\r
- return 0\r
- }\r
- return 1\r
-}\r
-\r
-#=================================================================\r
-# P-GET-INSTALLED (egu)\r
-#\r
-# return list of patch'numbers already write in GETPATCH file \r
-# return null list if file doesn't exist\r
-#=================================================================\r
-\r
-proc p-get-installed { file } {\r
- if { ![file exists $file] } {\r
- return {}\r
- } else {\r
- set ll {}\r
- foreach l [putils:FILES:FileToList $file] {\r
- lappend ll [lindex [split [lindex $l 1] _] end]\r
- }\r
- return $ll\r
- }\r
-}\r
-\r
-###==============================================================================================\r
-\r
-proc p-get-ptar { MYUL ULBAG tar } {\r
-\r
- global tcl_platform\r
- set savpwd [pwd]\r
- cd $ULBAG\r
-\r
- if { "$tcl_platform(platform)" == "unix" } {\r
-\r
- putils:EASY:tar untarZ ${tar}\r
-\r
- } elseif { "$tcl_platform(platform)" == "windows" } {\r
- set dirtmp [putils:EASY:tmpname ulget[id process]]\r
- catch { mkdir $dirtmp }\r
- putils:FILES:copy ${tar} $dirtmp/${MYUL}.tar.gz\r
-\r
- if { [file exists $dirtmp/${MYUL}.tar] } {\r
- unlink $dirtmp/${MYUL}.tar\r
- }\r
- putils:FILES:uncompress $dirtmp/${MYUL}.tar.gz\r
- if { [file exists $dirtmp/${MYUL}.tar] } {\r
- puts stderr "Info : Downloading $tar in [pwd]... "\r
- putils:EASY:tar untar $dirtmp/${MYUL}.tar\r
- }\r
- unlink $dirtmp/${MYUL}.tar\r
- unlink -nocomplain $dirtmp\r
- }\r
- cd $savpwd\r
- return\r
-}\r
-\r
-#\r
-# ######################################################################\r
-#\r
-proc putils:EASY:GETOPT { prm table tablereq usage listarg } {\r
-\r
- upvar $table TLOC $tablereq TRQ $prm PARAM\r
- catch {unset TLOC}\r
-\r
- set fill 0\r
-\r
- foreach e $listarg {\r
- if [regexp {^-.*} $e opt] {\r
- if [info exists TRQ($opt)] {\r
- set TLOC($opt) {}\r
- set fill 1\r
- } else {\r
- puts stderr "Error: Unknown option $e"\r
- eval $usage\r
- return -1\r
- }\r
- } else {\r
- if [info exist opt] {\r
- set fill [regexp {value_required:(.*)} $TRQ($opt) all typ]\r
- if { $fill } {\r
- if { $TLOC($opt) == {} } {\r
- set TLOC($opt) $e\r
- set fill 0\r
- } else {\r
- lappend PARAM $e\r
- }\r
- } else {\r
- lappend PARAM $e\r
- }\r
- } else {\r
- lappend PARAM $e\r
- }\r
- }\r
- }\r
-\r
- foreach e [array names TLOC] {\r
- if { [regexp {value_required:(.*)} $TRQ($e) all typ ] == 1 } {\r
- if { $TLOC($e) == {} } {\r
- puts "Error: Option $e requires a value"\r
- eval $usage\r
- return -1\r
- }\r
- switch -- $typ {\r
-\r
- file {\r
- }\r
-\r
- string {\r
- }\r
- \r
- date {\r
- }\r
-\r
- list {\r
- set TLOC($e) [split $TLOC($e) ,]\r
- }\r
-\r
- number {\r
- if ![ regexp {^[0-9]+$} $TLOC($e) n ] {\r
- puts "Error: Option $e requires a number."\r
- eval $usage\r
- return -1\r
- }\r
- }\r
-\r
- }\r
- \r
- }\r
- }\r
-\r
- return\r
-}\r
-#\r
-#\r
-#\r
-proc putils:EASY:tar { option args } {\r
- \r
- catch { unset command return_output }\r
- \r
- switch -- $option {\r
- \r
- tarfromroot {\r
- set name [lindex $args 0]\r
- set root [lindex $args 1]\r
- append command {tar cf } $name " " $root\r
- }\r
- \r
- tarfromliste {\r
- set name [lindex $args 0]\r
- set list [lindex $args 1]\r
- if [file exists $list] {\r
- set liste [putils:FILES:FileToList [lindex $args 1]]\r
- append command {tar cf } $name\r
- foreach f $liste {\r
-#fsa\r
- set listeeval [eval glob $f]\r
- foreach ff $listeeval {\r
- append command " " $ff\r
- }\r
-#fsa append command " " $f\r
- }\r
- } else {\r
- error "File $list not found"\r
- return -1\r
- }\r
- }\r
- \r
- untar {\r
- set name [lindex $args 0]\r
- append command {tar xomf } $name\r
- }\r
- \r
- untarZ {\r
- set name [lindex $args 0]\r
-#fun append command uncompress { -c } $name { | tar xof - >& /dev/null }\r
- append command gzip { -d -c } $name { | tar xomf - >& /dev/null }\r
- }\r
-\r
-\r
- ls {\r
- set return_output 1\r
- set name [lindex $args 0]\r
- append command {tar tvf } $name\r
- }\r
-\r
- lsZ {\r
- set return_output 1\r
- set name [lindex $args 0]\r
-#fun append command uncompress { -c } $name { | tar tvf - }\r
- append command gzip -d { -c } $name { | tar tvf - }\r
- }\r
-\r
- }\r
- \r
- ;#puts "command = $command"\r
- \r
- if [catch {eval exec $command} status] {\r
- puts stderr "Tar messages in command: $command"\r
- puts stderr "Status : $status"\r
- set statutar 1\r
- } else {\r
- if [info exist return_output] {\r
- set statutar $status\r
- } else {\r
- set statutar 1\r
- }\r
- }\r
-\r
- return $statutar\r
-}\r
-#\r
-#\r
-#\r
-proc putils:FILES:ListToFile { liste path } {\r
- if [ catch { set id [ open $path w ] } ] {\r
- return 0\r
- } else {\r
- foreach e $liste {\r
- puts $id $e\r
- }\r
- close $id\r
- return 1\r
- }\r
-}\r
-#\r
-#\r
-#\r
-proc putils:FILES:FileToList { path {sort 0} {trim 0} {purge 0} {emptl 1} } {\r
- if ![ catch { set id [ open $path r ] } ] {\r
- set l {}\r
- while {[gets $id line] >= 0 } {\r
- if { $trim } {\r
- regsub -all {[ ]+} $line " " line\r
- }\r
- if { $emptl } {\r
- if { [string length ${line}] != 0 } {\r
- lappend l $line\r
- }\r
- } else {\r
- lappend l $line\r
- }\r
- }\r
- close $id\r
- if { $sort } {\r
- return [lsort $l]\r
- } else {\r
- return $l\r
- }\r
- } else {\r
- return {}\r
- }\r
-}\r
-#\r
-#\r
-#\r
-proc putils:FILES:copy { fin fout } {\r
- if { [catch { set in [ open $fin r ] } errin] == 0 } {\r
- if { [catch { set out [ open $fout w ] } errout] == 0 } {\r
- set nb [copyfile $in $out]\r
- close $in \r
- close $out\r
- return $nb\r
- } else {\r
- puts stderr "Error: $errout"\r
- return -1\r
- }\r
- } else {\r
- puts stderr "Error: $errin"\r
- return -1\r
- }\r
-}\r
-#\r
-#\r
-##\r
-proc putils:FILES:compress { fullpath } {\r
- if [file exists ${fullpath}.gz] {\r
- catch {unlink ${fullpath}.gz}\r
- }\r
-#fsa if [catch { exec compress -f $fullpath} status] \r
- if [catch { exec gzip -f $fullpath} status] {\r
- puts stderr "Error while compressing ${fullpath}: $status"\r
- return -1\r
- } else {\r
- return 1\r
- }\r
-}\r
-\r
-proc putils:FILES:uncompress { fullpath } {\r
-#fsa if [catch {exec uncompress -f $fullpath} status]\r
-#fun:patch K4B_7\r
- if [catch {exec gzip -d -f $fullpath} status] {\r
- puts stderr "Error while uncompressing ${fullpath}: $status"\r
- return -1\r
- } else {\r
- return 1\r
- }\r
-}\r
-\r
-proc putils:EASY:tmpname { name } {\r
- global env\r
- global tcl_platform\r
- if { "$tcl_platform(platform)" == "unix" } {\r
- if [info exists env(TMPDIR)] {\r
- return [file join $env(TMPDIR) $name]\r
- } else { \r
- return [file join "/tmp" $name]\r
- }\r
- } elseif { "$tcl_platform(platform)" == "windows" } {\r
- return [file join $env(TMP) $name]\r
- }\r
- return {}\r
-}\r
-\r
-\r
+++ /dev/null
-
-#############################################################################
-#
-# 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
-}
+++ /dev/null
-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
- }
-}
+++ /dev/null
-#############################################################################
-#
-# P I N T E G R E
-# _______________
-#
-#############################################################################
-#
-# Usage
-#
-proc pintegreUsage { } {
- puts stderr \
- {
- usage : pintegre [ <reportID> ]
-
- <reportID> 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 <file> : 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 <name> [-parcel <p1,p2,..>] [-P patch]
- -h : this help
- -d dir : Uses dir as directory for downloading files.
- -conf name : configuration name. This parameter is required.
- -parcel <p1,p2..> : 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 ] : <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 <Myview> then a ClearCase view <Myview> will be configured so that
- you can access (read) the parcels without copying them. Note that <Myview> 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 <conf> 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 <fact> se trouvant listes dans <conf>.
-# 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
-}
+++ /dev/null
-#############################################################################
-#
-# P N E W S
-# _________
-#
-#############################################################################
-#
-# Usage
-#
-proc wokpnewsUsage { } {
- puts stderr \
- {
- Usage : pnews [-h] [-parcel <p1,p2,..>]
-
- }
-}
-#
-# 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 <factory> se trouvant listes dans <config>
-#
-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
-}
+++ /dev/null
-#############################################################################
-#
-# 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 <dir> specify that <dir> must be used as the contents of Pnam.
- By default <dir> is the root directory of the parcel in the bag of
- your factory.
-
- -init <level> specify that Pnam is a new parcel to be initialized in the
- reference BAG. No comparison is done. <level> is a character string
- that identify the level the parcel belongs to. <level> 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 <file> 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]
- }
-}
+++ /dev/null
-
-#############################################################################
-#
-# 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 <filename>.
- -conf option is mandatory. : Will update <cnam1,cnam2> during integration. (pintegre)
-
- pstore [-ls] : Lists pending reports with their owner and IDs.
- pstore -cat <report_ID> : Shows the content of <report_ID>.
- pstore [-f] -rm <report_ID>: Remove a report from the queue
- : (-f used to force if you dont own the report).
-
- -dump <report_ID> : 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
- }
-
-}
+++ /dev/null
-proc ptypefile_usage { } {
- puts stderr \
- {
- Usage: ptypefile -[hwt] [-S ao1,sil,sun,hp,wnt] <Parcelname>
-
- 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 <Parcelname>
- displays on the standard output the non kept type files.
-
- ptypefile <Parcelname>
- generates a type file in the adm directory of the parcel for ALL UNIX PLATFORMS
-
- ptypefile -S ao1,sil <ParcelName>
- generates a type file in the adm directory of the parcel ONLY for the given platforms
-
- ptypefile -S wnt <ParcelName>
- generates a type file in the adm directory of the parcel ONLY for wnt platform
-
- ptypefile -t <Parcelname>
- 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
- }
-}
-
+++ /dev/null
-# 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
+++ /dev/null
-# 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
+++ /dev/null
-<?xml version="1.0" encoding="windows-1251"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.10"
- Name="__TKNAM__"
- SccProjectName=""
- SccLocalPath="">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Release|Win32"
- OutputDirectory=".\..\..\win32\bin"
- IntermediateDirectory=".\..\..\win32\obj\__TKNAM__"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- AdditionalOptions="/DWNT"
- Optimization="2"
- InlineFunctionExpansion="1"
- PreprocessorDefinitions="NDEBUG;WIN32;_WINDOWS;WNT;No_Exception;CSFDB"
- StringPooling="TRUE"
- RuntimeLibrary="2"
- EnableFunctionLevelLinking="TRUE"
- PrecompiledHeaderFile=".\..\..\win32\obj\__TKNAM__/__TKNAM__.pch"
- AssemblerListingLocation=".\..\..\win32\obj\__TKNAM__/"
- ObjectFile=".\..\..\win32\obj\__TKNAM__/"
- ProgramDataBaseFileName=".\..\..\win32\obj\__TKNAM__/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="__TKDEP__ opengl32.lib glu32.lib ws2_32.lib odbc32.lib odbccp32.lib"
- OutputFile=".\..\..\win32\bin/__TKNAM__.dll"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- AdditionalLibraryDirectories="..\..\win32\lib"
- ProgramDatabaseFile=".\..\..\win32\bin/__TKNAM__.pdb"
- SubSystem="2"
- ImportLibrary="..\..\win32\lib\__TKNAM__.lib"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\..\..\win32\bin/__TKNAM__.tlb"
- HeaderFileName=""/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCXMLDataGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- <Tool
- Name="VCManagedWrapperGeneratorTool"/>
- <Tool
- Name="VCAuxiliaryManagedWrapperGeneratorTool"/>
- </Configuration>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory=".\..\..\win32\bind"
- IntermediateDirectory=".\..\..\win32\objd\__TKNAM__"
- ConfigurationType="2"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE"
- ManagedExtensions="FALSE"
- WholeProgramOptimization="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- AdditionalOptions="/DWNT"
- Optimization="0"
- InlineFunctionExpansion="1"
- PreprocessorDefinitions="DEB;_DEBUG;WIN32;_WINDOWS;WNT;CSFDB"
- RuntimeLibrary="3"
- PrecompiledHeaderFile=".\..\..\win32\objd\__TKNAM__/__TKNAM__.pch"
- AssemblerListingLocation=".\..\..\win32\objd\__TKNAM__/"
- ObjectFile=".\..\..\win32\objd\__TKNAM__/"
- ProgramDataBaseFileName=".\..\..\win32\objd\__TKNAM__/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"
- Detect64BitPortabilityProblems="FALSE"
- DebugInformationFormat="3"
- CompileAs="0"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="__TKDEP__ opengl32.lib glu32.lib ws2_32.lib odbc32.lib odbccp32.lib"
- OutputFile=".\..\..\win32\bind/__TKNAM__.dll"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- AdditionalLibraryDirectories="..\..\win32\libd"
- GenerateDebugInformation="TRUE"
- ProgramDatabaseFile="..\..\win32\bind\__TKNAM__.pdb"
- SubSystem="2"
- ImportLibrary="..\..\win32\libd\__TKNAM__.lib"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="_DEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\..\..\win32\bind/__TKNAM__.tlb"
- HeaderFileName=""/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="_DEBUG"
- Culture="1036"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCXMLDataGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- <Tool
- Name="VCManagedWrapperGeneratorTool"/>
- <Tool
- Name="VCAuxiliaryManagedWrapperGeneratorTool"/>
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source files"
- Filter="">
- __FILES__
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
+++ /dev/null
-<?xml version="1.0" encoding="windows-1251"?>
-<VisualStudioProject
- ProjectType="Visual C++"
- Version="7.10"
- Name="__XQTNAM__"
- ProjectGUID="{193A5B07-7F8B-4280-9F4E-32D5F326DFC5}"
- SccProjectName=""
- SccLocalPath="">
- <Platforms>
- <Platform
- Name="Win32"/>
- </Platforms>
- <Configurations>
- <Configuration
- Name="Debug|Win32"
- OutputDirectory=".\..\..\win32\bind"
- IntermediateDirectory=".\..\..\win32\objd\__XQTNAM__"
- ConfigurationType="__CONF__"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- AdditionalOptions="/DWNT"
- Optimization="0"
- PreprocessorDefinitions="WIN32;DEB;_DEBUG;_WINDOWS;WNT;CSFDB;"
- BasicRuntimeChecks="3"
- RuntimeLibrary="3"
- AssemblerListingLocation=".\..\..\win32\objd\__XQTNAM__/"
- ObjectFile=".\..\..\win32\objd\__XQTNAM__/"
- ProgramDataBaseFileName=".\..\..\win32\objd\__XQTNAM__/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"
- DebugInformationFormat="3"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="__TKDEP__"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- AdditionalLibraryDirectories="..\..\win32\libd"
- GenerateDebugInformation="TRUE"
- ProgramDatabaseFile=".\..\..\win32\bind/__XQTNAM__.pdb"
- SubSystem="1"
- ImportLibrary="..\..\win32\libd\__XQTNAM__.lib"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="_DEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\..\..\win32\bind/__XQTNAM__.tlb"
- HeaderFileName=""/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="_DEBUG"
- Culture="1033"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCXMLDataGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- <Tool
- Name="VCManagedWrapperGeneratorTool"/>
- <Tool
- Name="VCAuxiliaryManagedWrapperGeneratorTool"/>
- </Configuration>
- <Configuration
- Name="Release|Win32"
- OutputDirectory=".\..\..\win32\bin"
- IntermediateDirectory=".\..\..\win32\obj\__XQTNAM__"
- ConfigurationType="__CONF__"
- UseOfMFC="0"
- ATLMinimizesCRunTimeLibraryUsage="FALSE">
- <Tool
- Name="VCCLCompilerTool"
- AdditionalOptions="/DWNT"
- Optimization="2"
- InlineFunctionExpansion="1"
- PreprocessorDefinitions="WIN32;NDEBUG;No_Exception;_WINDOWS;WNT;CSFDB;"
- StringPooling="TRUE"
- RuntimeLibrary="2"
- EnableFunctionLevelLinking="TRUE"
- AssemblerListingLocation=".\..\..\win32\obj\__XQTNAM__/"
- ObjectFile=".\..\..\win32\obj\__XQTNAM__/"
- ProgramDataBaseFileName=".\..\..\win32\obj\__XQTNAM__/"
- WarningLevel="3"
- SuppressStartupBanner="TRUE"/>
- <Tool
- Name="VCCustomBuildTool"/>
- <Tool
- Name="VCLinkerTool"
- AdditionalDependencies="__TKDEP__"
- LinkIncremental="1"
- SuppressStartupBanner="TRUE"
- AdditionalLibraryDirectories="..\..\win32\lib"
- ProgramDatabaseFile=".\..\..\win32\bin/__XQTNAM__.pdb"
- SubSystem="1"
- ImportLibrary="..\..\win32\lib\__XQTNAM__.lib"
- TargetMachine="1"/>
- <Tool
- Name="VCMIDLTool"
- PreprocessorDefinitions="NDEBUG"
- MkTypLibCompatible="TRUE"
- SuppressStartupBanner="TRUE"
- TargetEnvironment="1"
- TypeLibraryName=".\..\..\win32\bin/__XQTNAM__.tlb"
- HeaderFileName=""/>
- <Tool
- Name="VCPostBuildEventTool"/>
- <Tool
- Name="VCPreBuildEventTool"/>
- <Tool
- Name="VCPreLinkEventTool"/>
- <Tool
- Name="VCResourceCompilerTool"
- PreprocessorDefinitions="NDEBUG"
- Culture="1033"/>
- <Tool
- Name="VCWebServiceProxyGeneratorTool"/>
- <Tool
- Name="VCXMLDataGeneratorTool"/>
- <Tool
- Name="VCWebDeploymentTool"/>
- <Tool
- Name="VCManagedWrapperGeneratorTool"/>
- <Tool
- Name="VCAuxiliaryManagedWrapperGeneratorTool"/>
- </Configuration>
- </Configurations>
- <References>
- </References>
- <Files>
- <Filter
- Name="Source Files"
- Filter="">
-__FILES__
- </Filter>
- </Files>
- <Globals>
- </Globals>
-</VisualStudioProject>
+++ /dev/null
-
-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) <Control-Button-1> {
- wokOUC:Tree:diff [winfo toplevel %W]
- }
- bind $IWOK_WINDOWS($w,OUC,hlist) <Control-Button-1> {
- 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
-}
+++ /dev/null
-;;; 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"\r
- "*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)))
-
-\f
-;;(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)))))))
-
-\f
-;; 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)
-)
projects / occt-wok.git / commitdiff
