No comments

diff --git a/src/WOKTclLib/WOKVC.tcl b/src/WOKTclLib/WOKVC.tcl
index fa4ad6445301a4c07b72762206f90fe6c8abe032..60d3946231adab1af2de8f883016b8b0ca1fc82b 100755 (executable)
--- 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 <user>
-#   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 d775577fc8758766aa59679fcdfa1b701b042739..f0adbfafe88845bca8a71794b69b049104f95362 100755 (executable)
--- 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 40e1f1e12199fda11884a315d34c31e707c8ac7d..6f1fc0e289daa5f87429603eaab0e6ddd2627ad6 100755 (executable)
--- 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 8db0289c3c53cec8b7aff070b575dc55d4f28bcd..67676f9ae374a0231ff770bdc8db04c31745cbf0 100755 (executable)
--- 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]