From aea271a9419726d32289e07246263ec628e96f9e Mon Sep 17 00:00:00 2001 From: cas Date: Tue, 4 Jul 2000 14:38:33 +0000 Subject: [PATCH] No comments --- src/WOKTclLib/WOKVC.tcl | 327 +++++++++------------------------------ src/WOKTclLib/tclx.nt | 31 ---- src/WOKTclLib/wstore.tcl | 22 ++- src/WOKTclLib/wutils.tcl | 10 ++ 4 files changed, 99 insertions(+), 291 deletions(-) diff --git a/src/WOKTclLib/WOKVC.tcl b/src/WOKTclLib/WOKVC.tcl index fa4ad64..60d3946 100755 --- a/src/WOKTclLib/WOKVC.tcl +++ b/src/WOKTclLib/WOKVC.tcl @@ -74,6 +74,15 @@ proc wintegre { args } { return } + + set vc [file join [wokinfo -pAdmDir:. $fshop] VC.tcl] + if [file exists $vc] { + source $vc + } else { + msgprint -c WOKVC -e "Pas de fichier VC.tcl dans adm de ${fshop} ." + return -1 + } + if { [set refer [info exists tabarg(-ref)]] } { set vrsref $tabarg(-ref) } @@ -85,7 +94,7 @@ proc wintegre { args } { set wbtop $tabarg(-root) msgprint -c WOKVC -i "Using $wbtop as target workbench." } else { - set wbtop [wokIntegre:RefCopy:GetWB $fshop] + set wbtop [wokIntegre:RefCopy:GetWB] } if { [info exists tabarg(-all)] } { @@ -131,6 +140,11 @@ proc wintegre { args } { return -1 } + + + set ros [wokIntegre:RefCopy:OpenWB] + set los [wokIntegre:RefCopy:OpenUD] + if { "$BTYPE" == "NOBASE" } { wokIntegrenobase } else { @@ -143,77 +157,6 @@ proc wintegre { args } { return } #;> -# Traitement des bazes ClearCase -#;< -proc wokIntegreClearCase { } { - uplevel { - puts "Integre dans bases ClearCase" - foreach REPORT $LISTREPORT { - if { $VERBOSE } { msgprint -c WOKVC -i "Processing report in $REPORT" } - set comment "" - ;# - ;# Lecture du report - ;# - set mode normal - if { $refer } { set mode ref } - catch {unset table} - set stat [wokStore:Report:Process $mode $REPORT table info notes] - - foreach UD [lsort [array names table]] { - puts stdout [format "echo Processing unit : %s" $UD] - set root [wokIntegre:BASE:GetVOBName [Sinfo -f] $shop $wbtop $UD] - if { $root != {} } { - foreach ELM $table($UD) { - set F [lindex $ELM 1] - set name [file tail $F] - set sfl $root/$name - if [file exists $sfl] { - set cmdco "cleartool co -nda -nc $sfl" - if { [lindex [set resco [wokUtils:EASY:command $cmdco 1 0]] 0] == 1 } { - } else { - msgprint -c WOKVC -e "ClearCase checkout failed for $sfl" - } - set cmdci "cleartool ci -c $comment -from $F $sfl" - if { [lindex [set resci [wokUtils:EASY:command $cmdci 1 0]] 0] == 1 } { - } else { - msgprint -c WOKVC -e "ClearCase checkin failed for $sfl" - } - } else { - set cmdco "cleartool co -nc $root";# check out directory - if { [lindex [set resco [wokUtils:EASY:command $cmdco 1 0]] 0] == 1 } { - } else { - msgprint -c WOKVC -e "ClearCase checkout failed for $sfl" - } - wokUtils:FILES:copy $F $sfl ;# copy element dans la base - set cmdmk "cleartool mkelem -ci -c $comment $sfl" ;# creation elem - if { [lindex [set resmk [wokUtils:EASY:command $cmdmk 1 0]] 0] == 1 } { - } else { - msgprint -c WOKVC -e "ClearCase checkout failed for $sfl" - } - set cmdci "cleartool ci -c $comment $root" - } - } - } else { - msgprint -c WOKVC -e "The unit $UD has no entry in the VOB $wbtop" - } - } - } - } - return -} -#;> -# retourne le path de la vob associee a fact-shop-wb-UD. -#:< -proc wokIntegre:BASE:GetVOBName { fact shop wb UD } { - return /vobs/GRIV/k1dev/k1dev/V3d/src - set ud [lindex [split $UD .] 0] - if [wokinfo -x ${wb}:${ud}] { - return [wokinfo -p source:. ${wb}:${ud}] - } else { - return {} - } -} -#;> # Miscellaneous: Assemblage traitement avec base #;< proc wokIntegrebase { } { @@ -268,7 +211,7 @@ proc wokIntegrebase { } { ;# 1 bis. Tester [id user] peut ecrire dans le workbench qui sert de REFCOPY ;# if { $refcopy == 1 } { - set write_ok [wokIntegre:RefCopy:Writable $fshop table $wbtop] + set write_ok [wokIntegre:RefCopy:Writable $fshop table $wbtop $ros $los] if { $write_ok == -1 } { msgprint -c WOKVC -e "You cannot write or create units in the workbench $wbtop" wokIntegreCleanup $broot table [list $cmdid $jnlid] $dirtmp @@ -328,7 +271,7 @@ proc wokIntegrebase { } { if { $refcopy == 1 } { catch {unset table} wokIntegre:Journal:PickReport $jnltmp table notes $num - wokIntegre:RefCopy:GetPathes $fshop table $wbtop + wokIntegre:RefCopy:GetPathes $fshop table $wbtop $ros $los set dirtmpu /tmp/wintegrecreateunits[id process] catch { rmdir -nocomplain $dirtmpu @@ -339,7 +282,7 @@ proc wokIntegrebase { } { wokIntegre:RefCopy:FillRef $fshop table $chkid wokIntegre:BASE:EOF $chkid close $chkid - msgprint -c WOKVC -i "Updating units in workbench $wbtop" + msgprint -c WOKVC -i "Updating units in target workbench(es) $wbtop $ros" set statx [wokIntegre:BASE:Execute $VERBOSE $chkout] if { $statx != 1 } { msgprint -c WOKVC -e "during checkout(Get). The report has not been removed." @@ -382,13 +325,13 @@ proc wokIntegrenobase { } { return -1 } - set write_ok [wokIntegre:RefCopy:Writable $fshop table $wbtop] + set write_ok [wokIntegre:RefCopy:Writable $fshop table $wbtop $ros $los] if { $write_ok == -1 } { msgprint -c WOKVC -e "You cannot write or create units in the workbench $wbtop" wokIntegreCleanup $broot table [list $jnlid] $dirtmp return -1 } - set pathes_ok [wokIntegre:RefCopy:GetPathes $fshop table $wbtop] + set pathes_ok [wokIntegre:RefCopy:GetPathes $fshop table $wbtop $ros $los] if { $write_ok == -1 } { wokIntegreCleanup $broot table [list $jnlid] $dirtmp return -1 @@ -478,9 +421,11 @@ proc wokIntegre:BASE:GetType { fshop {dump 0} } { break } } - msgprint -c WOKVC -i "Repository root : [wokparam -e %VC_ROOT $fshop]" - msgprint -c WOKVC -i "Repository type : [wokparam -e %VC_TYPE $fshop]" - msgprint -c WOKVC -i "Attached to : [wokIntegre:RefCopy:GetWB $fshop]" + msgprint -c WOKVC -i "Repository root : [wokparam -e %VC_ROOT $fshop]" + msgprint -c WOKVC -i "Repository type : [wokparam -e %VC_TYPE $fshop]" + msgprint -c WOKVC -i "Default update done in : [wokIntegre:RefCopy:GetWB]" + msgprint -c WOKVC -i "OpenSource workbench : [wokIntegre:RefCopy:OpenWB]" + msgprint -c WOKVC -i "List units in there with : OS -u list" } return [wokparam -e %VC_TYPE $fshop] } else { @@ -697,19 +642,26 @@ proc wokIntegre:BASE:BTMPDelete { broot Unit } { #;> # Check owner et fait ucreate si necessaire des UDs de table # 1. ucreate -p workbench:NTD si owner OK -#;< -proc wokIntegre:RefCopy:Writable { fshop table workbench } { +# workbench est celui dans lequel on integre sauf si UD est dans +# la liste $los auquel cas l'integration se fait dans ros +#;< +proc wokIntegre:RefCopy:Writable { fshop table workbench ros los} { upvar $table TLOC + foreach UD [array names TLOC] { regexp {(.*)\.(.*)} $UD ignore name type - if { [lsearch [w_info -l ${fshop}:${workbench}] $name ] == -1 } { - ;# if workbench is writable .. - ;#msgprint -c WOKVC -i "Creating unit ${fshop}:${workbench}:${name}" - ucreate -$type ${fshop}:${workbench}:${name} + if { [lsearch $los $name] != -1 } { + set destwb $ros + } else { + set destwb $workbench + } + if { [lsearch [w_info -l ${fshop}:${destwb}] $name ] == -1 } { + ucreate -$type ${fshop}:${destwb}:${name} } - set dirsrc [wokinfo -p source:. ${fshop}:${workbench}:${name}] + set dirsrc [wokinfo -p source:. ${fshop}:${destwb}:${name}] + ;#puts " writable dirsrc = $dirsrc" if ![file writable $dirsrc] { - msgprint -c WOKVC -e "You cannot write in directory $dirsrc" + msgprint -c WOKVC -e "You cannot write in workbench $destwb ($dirsrc)" return -1 } } @@ -722,40 +674,27 @@ proc wokIntegre:RefCopy:Writable { fshop table workbench } { # Input: table(NTD.p) = { {toto.c 2.1} {titi.c 4.3} } # Output: table(NTD.p) = { /home/wb/qqchose/NTD/src {toto.c 2.1} {titi.c 4.3} } #;< -proc wokIntegre:RefCopy:GetPathes { fshop table workbench } { +proc wokIntegre:RefCopy:GetPathes { fshop table workbench ros los} { upvar $table TLOC + ;#puts "-------------AVANT getpathes ----------------" + ;#parray TLOC foreach UD [array names TLOC] { regexp {(.*)\.(.*)} $UD ignore name type - if { [lsearch [w_info -l ${fshop}:$workbench] $name ] != -1 } { + if { [lsearch $los $name] != -1 } { + set destwb $ros + } else { + set destwb $workbench + } + if { [lsearch [w_info -l ${fshop}:$destwb] $name ] != -1 } { set lsf $TLOC($UD) - set TLOC($UD) [linsert $lsf 0 [wokparam -e %${name}_Src ${fshop}:${workbench}:${name}]] + set TLOC($UD) [linsert $lsf 0 [wokparam -e %${name}_Src ${fshop}:${destwb}:${name}]] } else { - msgprint -c WOKVC -e "(GetPathes) Unit $name not found in $workbench" + msgprint -c WOKVC -e "(GetPathes) Unit $name not found in $destwb" return -1 } } - return 1 -} -#;> -# Modifie si c'est possible les protections des elements de table (liste) -# si ils appartiennent a -# Utilise par wget en reference -# Input: table(NTD.p) = { /home/wb/qqchose/NTD/src {toto.c 2.1} {titi.c 4.3} } -#;< -proc wokIntegre:RefCopy:SetWritable { table user } { - upvar $table TLOC - foreach UD [array names TLOC] { - set dirsrc [lindex $TLOC($UD) 0] - foreach e [lrange $TLOC($UD) 1 end] { - set file $dirsrc/[lindex $e 0] - if [file owned $file] { - chmod u+w $file - } else { - msgprint -c WOKVC -e "Protection of $file cannot be modified (File not found or not owner)." - return -1 - } - } - } + ;#puts "-------------APRES----------------" + ;#parray TLOC return 1 } #;> @@ -909,23 +848,6 @@ proc wokIntegre:RefCopy:FillUser { fshop table {force 0} {fileid stdout} {mask 6 } return } -#;> -# Retourne le nom du ou des workbench qu'il faut alimenter apres l'integration -# Valeur d'un param si il existe sinon workbench racine de l'ilot -# -#;< -proc wokIntegre:RefCopy:GetWB { fshop } { - if { [wokparam -t %VC_WBROOT $fshop] == 0 } { - foreach wb [sinfo -w $fshop] { - if [expr { ( [llength [w_info -A ${fshop}:${wb}]] > 1 ) ? 0 : 1 }] { - return $wb - } - } - return {} - } else { - return [wokparam -e %VC_WBROOT $fshop] - } -} # # ((((((((((((((((VERSION)))))))))))))))) # @@ -1133,11 +1055,6 @@ proc wget { args } { ;# name of source workbench from where the source file are to be copied. ;# only used in NOBASE case. ;# - if [info exists tabarg(-from)] { - set fromwb $tabarg(-from) - } else { - set fromwb [wokIntegre:RefCopy:GetWB $fshop] - } if [info exists tabarg(-ud)] { @@ -1170,6 +1087,22 @@ proc wget { args } { return -1 } + set vc [file join [wokinfo -pAdmDir:. $fshop] VC.tcl] + if [file exists $vc] { + source $vc + } else { + msgprint -c WOKVC -e "Pas de fichier VC.tcl dans adm de ${fshop} ." + return -1 + } + + + if [info exists tabarg(-from)] { + set fromwb $tabarg(-from) + } else { + set fromwb [wokIntegre:RefCopy:GetWB] + } + + if { "$BTYPE" == "ClearCase" } { wokGetClearCase return @@ -1257,15 +1190,14 @@ proc wokGetbase { } { } } - if { [wokIntegre:RefCopy:Writable $fshop table $workbench] == -1 } { + if { [wokIntegre:RefCopy:Writable $fshop table $workbench {} {}] == -1 } { return -1 } - wokIntegre:RefCopy:GetPathes $fshop table $workbench + wokIntegre:RefCopy:GetPathes $fshop table $workbench {} {} if { [llength [w_info -A ${fshop}:$workbench]] == 1 } { msgprint -c WOKVC -w "You are working in the reference area." - wokIntegre:RefCopy:SetWritable table [id user] - set forced 1 + return -1 } if { [wokUtils:FILES:dirtmp [set dirtmp /tmp/wintegrecreateunits[id process]]] == -1 } { @@ -1346,7 +1278,7 @@ proc wokGetnobase { } { regexp {(.*)\.(.*)} $UD ignore name type if { [lsearch [w_info -l $workbench] $name ] == -1 } { ;# if workbench is writable .. - msgprint -c WOKVC -i "Creating unit ${workbench}:${name}" + ;#msgprint -c WOKVC -i "Creating unit ${workbench}:${name}" ucreate -$type ${workbench}:${name} } set dirsrc [wokinfo -p source:. ${workbench}:${name}] @@ -1384,116 +1316,3 @@ proc wokGetnobase { } { } return } -# -# Base ClearCase -# -proc wokGetClearCase { } { - uplevel { - ;#puts "wget pour clearcase:" - ;# workbench racine de l'ilot ?? - foreach wb [sinfo -w $shop] { - if {[wokUtils:WB:IsRoot $wb]} { - set root $wb - break - } - } - - set listfileinbase [wokUtils:FILES:ls [wokinfo -p source:. ${root}:${ud}]] - - if [info exists listbase] { - set laff [wokUtils:LIST:GM $listfileinbase $param] - foreach f $laff { - puts $f - } - return - } - - if [info exists ID] { - msgprint -c WOKVC -w "Value $ID for option -r ignored in this context (NOBASE)." - return - } else { - if { $param == {} } { - foreach f $listfileinbase { - puts $f - } - return - } - if { [set RES [wokUtils:LIST:GM $listfileinbase $param]] == {} } { - msgprint -c WOKVC -e "No match for $param in unit $ud." - } - set locud [woklocate -u $ud] - if { $locud != {} } { - set table(${ud}.[uinfo -c $locud]) $RES - } else { - msgprint -c WOKVC -e "Unit $ud not found. Unknown type for creation." - return -1 - } - } - - foreach UD [array names table] { - regexp {(.*)\.(.*)} $UD ignore name type - if { [lsearch [w_info -l $workbench] $name ] == -1 } { - ;# if workbench is writable .. - msgprint -c WOKVC -i "Creating unit ${workbench}:${name}" - ucreate -$type ${workbench}:${name} - } - set dirsrc [wokinfo -p source:. ${workbench}:${name}] - if ![file writable $dirsrc] { - msgprint -c WOKVC -e "You cannot write in directory $dirsrc" - return -1 - } - - set fromsrc [wokIntegre:BASE:GetVOBName [Sinfo -f] $shop $wb ${name}] - set table($UD) [list $fromsrc $dirsrc $table($UD)] - } - - ;#parray table - ;# VOB ?? directory arrivee - ;#table(WOKTclLib.r) = - ;#/adv_23/WOK/k2dev/ref/src/WOKTclLib/. /adv_23/WOK/k2dev/iwok2/src/WOKTclLib/. upack.tcl - - foreach UD [array names table] { - set from [lindex $table($UD) 0] - set dest [lindex $table($UD) 1] - foreach file [lindex $table($UD) 2] { - if [file exists $dest/$file] { - if { $forced } { - if { [file writable $dest/$file] } { - frename $dest/$file $dest/${file}-sav - msgprint -c WOKVC -i "File $dest/$file renamed ${file}-sav" - wokUtils:FILES:copy $from/$file $dest/$file - chmod 0644 $dest/$file - } else { - msgprint -c WOKVC -e "File $dest/$file is not writable. Cannot be overwritten." - return -1 - } - } else { - msgprint -c WOKVC -e "File $dest/$file already exists. Not overwritten." - } - } else { - wokUtils:FILES:copy $from/$file $dest/$file - chmod 0644 $dest/$file - } - } - } - } - - return -} -############################################################################# -# -# W P U T -# _______ -# -############################################################################# -# -# Usage -# -proc wokPutUsage { } { - return -} - -proc wput { args } { - puts "No longer supported." - return -} diff --git a/src/WOKTclLib/tclx.nt b/src/WOKTclLib/tclx.nt index d775577..f0adbfa 100755 --- a/src/WOKTclLib/tclx.nt +++ b/src/WOKTclLib/tclx.nt @@ -13,8 +13,6 @@ # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-ArrayProcedures for_array_keys @@ -60,7 +58,6 @@ proc for_array_keys {varName arrayName codeFragment} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ #------------------------------------------------------------------------------ # @@ -320,8 +317,6 @@ proc frename {old new} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-convertlib convert_lib @@ -431,8 +426,6 @@ proc convert_lib {tclIndex packageLib {ignore {}}} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-developer_utils saveprocs edprocs @@ -486,8 +479,6 @@ proc edprocs {args} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-events mainloop @@ -516,8 +507,6 @@ proc mainloop {} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-forfile for_file @@ -556,8 +545,6 @@ proc for_file {var filename cmd} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-globrecur recursive_glob @@ -656,8 +643,6 @@ proc for_recursive_glob {var dirlist globlist cmd {depth 1}} { # being the merger of all "help" directories found along the $auto_path # variable. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-help help helpcd helppwd apropos @@ -987,8 +972,6 @@ set TCLXENV(help:curSubject) "/" # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-profrep profrep @@ -1137,8 +1120,6 @@ proc profrep {profDataVar sortKey {outFile {}} {userTitle {}}} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-directory_stack pushd popd dirs @@ -1201,8 +1182,6 @@ proc dirs {} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-set_functions union intersect intersect3 lrmdups @@ -1305,8 +1284,6 @@ proc intersect {list1 list2} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-showproc showproc @@ -1349,8 +1326,6 @@ proc showproc args { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-stringfile_functions read_file write_file @@ -1423,8 +1398,6 @@ proc write_file {fileName args} { # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # #@package: TclX-libraries searchpath auto_load_file @@ -1533,8 +1506,6 @@ proc auto_commands {{option {}}} { # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ #@package: TclX-fmath acos asin atan ceil cos cosh exp fabs floor log log10 \ sin sinh sqrt tan tanh fmod pow atan2 abs double int round @@ -1584,8 +1555,6 @@ proc round x {uplevel [list expr round($x)]} # software for any purpose. It is provided "as is" without express or # implied warranty. #------------------------------------------------------------------------------ -# $Id: tclx.nt,v 1.1 1998-09-09 18:21:14 kernel Exp $ -#------------------------------------------------------------------------------ # # For nroff man pages, the areas of text to extract are delimited with: # diff --git a/src/WOKTclLib/wstore.tcl b/src/WOKTclLib/wstore.tcl index 40e1f1e..6f1fc0e 100755 --- a/src/WOKTclLib/wstore.tcl +++ b/src/WOKTclLib/wstore.tcl @@ -874,17 +874,27 @@ proc wokStore:Report:Get { id fshop } { } ;# ;# Renvoie 1 si on peut faire store dans une queue associee au workbench. -;# Pour l'instant workbench racine +;# Pour l'instant renvoie 1 si wb est le workbench racine ;# -proc wokStore:Queue:Enabled { shop wb } { - if { "[wokIntegre:RefCopy:GetWB ${shop}]" == "$wb" } { - return 1 +proc wokStore:Queue:Enabled { fshop wb } { + set vc [file join [wokinfo -pAdmDir:. $fshop] VC.tcl] + if [file exists $vc] { + source $vc + if { "[info procs wokIntegre:RefCopy:GetWB]" != {} } { + if { "[wokIntegre:RefCopy:GetWB]" == "$wb" || "[wokIntegre:RefCopy:OpenWB]" == "$wb" } { + return 1 + } else { + return 0 + } + } else { + msgprint -c WOKVC -e "proc wokIntegre:RefCopy:GetWB is undefined (File $vc )." + return 0 + } } else { + msgprint -c WOKVC -i "File $vc not found. Assume wokIntegre:RefCopy:GetWB is root workbench." return 0 } } - - ;# ;# Fait ls d'une file qname. Si qname = {} ls de la file de l'ilot. ;# diff --git a/src/WOKTclLib/wutils.tcl b/src/WOKTclLib/wutils.tcl index 8db0289..67676f9 100755 --- a/src/WOKTclLib/wutils.tcl +++ b/src/WOKTclLib/wutils.tcl @@ -331,6 +331,16 @@ proc wokUtils:FILES:DirMapToProc { d TclFile ProcName } { } } # +# Compare contents of directory d with a previous state. +# (previous state in file $d/__PreviousState.tcl) +# If new = 1 then once directory d parsed (re-)writes +# the file $d/__PreviousState.tcl +# +proc wokUtils:FILES:MakeDirHistory { d tclfile procname } { + wokUtils:FILES:DirMapToProc $d $d/$tclfile $procname + +} +# # Same as above but also returns a ordonned list of directories names # Use it as follow # set treelist [wokUtils:FILES:DirToTree $dir] -- 2.39.5