From eb099d28c04170d0ae3618d051cffb6de135dabf Mon Sep 17 00:00:00 2001 From: cas Date: Fri, 13 Jul 2001 16:55:02 +0000 Subject: [PATCH] No comments --- src/WOKTclLib/MkBuild.tcl | 31 +++++----- src/WOKTclLib/wok.tcl | 7 +-- src/WOKTclLib/wokNAV.tcl | 87 ++++++++++++++++------------ src/WOKTclLib/wstore.tcl | 116 +++++++++++++++++++++++--------------- src/WOKTclLib/wutils.tcl | 51 +++++++++++++++++ 5 files changed, 193 insertions(+), 99 deletions(-) diff --git a/src/WOKTclLib/MkBuild.tcl b/src/WOKTclLib/MkBuild.tcl index e0d88e2..d0c6944 100755 --- a/src/WOKTclLib/MkBuild.tcl +++ b/src/WOKTclLib/MkBuild.tcl @@ -74,9 +74,9 @@ proc wokBuild { {fast 0} } { set arr [$w.l subwidget arrow] ; tixBalloon $arr.bal ; $arr.bal bind $arr -msg "Last spots" - button $w.mdtv -image [image create photo -file $env(WOK_LIBRARY)/opencascade.gif] -command wokSeeLayout - tixBalloon $w.mdtv.bal - $w.mdtv.bal bind $w.mdtv -msg "See Layout" + button $w.mdtv -image [image create photo -file $env(WOK_LIBRARY)/opencascade.gif] ;#command wokSeeLayout + ;#tixBalloon $w.mdtv.bal + ;#$w.mdtv.bal bind $w.mdtv -msg "See Layout" tixForm $dis -left $lastbut -bottom $top -top $w.mnu @@ -103,6 +103,7 @@ proc wokBuild { {fast 0} } { } wokCWD disable + wokSeeLayout $IWOK_GLOBALS(canvas) bind current { wokNAV:Tree:Focus [winfo toplevel %W] [lindex [%W gettags current] 0] @@ -218,28 +219,28 @@ proc wokButton { option {w nil} } { switch -glob -- $option { initialize { - keylset IWOK_GLOBALS(blist) prepare [list z wokPrepare {wprepare}] - keylset IWOK_GLOBALS(blist) wbuild [list w winbuild {umake}] - keylset IWOK_GLOBALS(blist) browser [list b wokbrowser {CDL Browser}] - keylset IWOK_GLOBALS(blist) params [list p wokPRMAff {Parameters}] + wokUtils:key:lset IWOK_GLOBALS(blist) prepare [list z wokPrepare {wprepare}] + wokUtils:key:lset IWOK_GLOBALS(blist) wbuild [list w winbuild {umake}] + wokUtils:key:lset IWOK_GLOBALS(blist) browser [list b wokbrowser {CDL Browser}] + wokUtils:key:lset IWOK_GLOBALS(blist) params [list p wokPRMAff {Parameters}] } create { set blist $IWOK_GLOBALS(blist) - foreach i [keylkeys blist] { - set v [keylget blist $i] + + foreach i [wokUtils:key:lkeys blist] { + set v [wokUtils:key:lget blist $i] set m [lindex $v 0] set f [lindex $v 1] lappend v [button $w.$m -height 32 -width 32 -image [tix getimage $i] -command $f] - keylset blist $i $v + wokUtils:key:lset blist $i $v set IWOK_GLOBALS(buttons,state,$i) {} } set prev {} set curr {} - - foreach i [keylkeys blist] { - set v [keylget blist $i] + foreach i [wokUtils:key:lkeys blist] { + set v [wokUtils:key:lget blist $i] set curr [lindex $v 0] if { $prev == {} } { tixForm $w.$curr -top $w.mnu @@ -263,14 +264,14 @@ proc wokButton { option {w nil} } { disable { foreach bt $w { - [lindex [keylget IWOK_GLOBALS(buttons) $bt] end] configure -state disabled + [lindex [wokUtils:key:lget IWOK_GLOBALS(buttons) $bt] end] configure -state disabled } } activate { foreach bt $w { - [lindex [keylget IWOK_GLOBALS(buttons) $bt] end] configure -state normal + [lindex [wokUtils:key:lget IWOK_GLOBALS(buttons) $bt] end] configure -state normal } } diff --git a/src/WOKTclLib/wok.tcl b/src/WOKTclLib/wok.tcl index 22d1cb2..d1e0f09 100755 --- a/src/WOKTclLib/wok.tcl +++ b/src/WOKTclLib/wok.tcl @@ -47,9 +47,6 @@ proc iwok { args } { set IWOK_GLOBALS(font) [tix option get fixed_font] set IWOK_GLOBALS(boldfont) [tix option get bold_font] - ;#tix addbitmapdir /adv_23/WOK/k3dev/ref/src/WOKTclLib ;# THUY EM - ;#tix addbitmapdir /adv_23/WOK/k3dev/iwok/src/WOKTclLib ;# THUY EM - ;# ucreate -P dans factory/workshop/ => erreur ?!!! set IWOK_GLOBALS(ucreate-P) [list {j jini} {p package} {s schema} {i interface} {C client} {e engine} {x executable} {n nocdlpack} {t toolkit} {r resource} {O documentation} {c ccl} {f frontal} {d delivery} {I idl} {S server} {m module}] @@ -64,8 +61,8 @@ proc iwok { args } { wm withdraw . toplevel $IWOK_GLOBALS(toplevel) wm title $IWOK_GLOBALS(toplevel) "WOK ( [id user] ) on host [id host]" - wm geometry $IWOK_GLOBALS(toplevel) $IWOK_GLOBALS(toplevel,geometry) - + ;#wm geometry $IWOK_GLOBALS(toplevel) $IWOK_GLOBALS(toplevel,geometry) + wm geometry $IWOK_GLOBALS(toplevel) 1200x80+10+30 ;#wokInitPalette black white orange blue wokInitPalette diff --git a/src/WOKTclLib/wokNAV.tcl b/src/WOKTclLib/wokNAV.tcl index 1ba6809..e7162b8 100755 --- a/src/WOKTclLib/wokNAV.tcl +++ b/src/WOKTclLib/wokNAV.tcl @@ -180,10 +180,12 @@ proc wokNAV:Tree:Updatefactory { w loc dir } { set image $IWOK_GLOBALS(factory,image) foreach name [lsort [Sinfo -F]] { - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}$name \ - -itemtype imagetext -text $name \ - -image $image \ - -data [list $name factory $name $image $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}$name] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}$name \ + -itemtype imagetext -text $name \ + -image $image \ + -data [list $name factory $name $image $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}$name open } wokNAV:tlist:Set $w $loc $dir @@ -202,17 +204,21 @@ proc wokNAV:Tree:Updateworkshop { w loc dir } { set image $IWOK_GLOBALS(workshop,image) set name [finfo -W $loc] - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^$name \ - -itemtype imagetext -text $name \ - -image [tix getimage warehouse] \ - -data [list ${loc}:${name} warehouse $name [tix getimage warehouse] $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^$name] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^$name \ + -itemtype imagetext -text $name \ + -image [tix getimage warehouse] \ + -data [list ${loc}:${name} warehouse $name [tix getimage warehouse] $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^$name open foreach name [lsort [finfo -s $loc]] { - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} \ - -itemtype imagetext -text $name \ - -image $image \ - -data [list ${loc}:${name} workshop $name $image $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^$name] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} \ + -itemtype imagetext -text $name \ + -image $image \ + -data [list ${loc}:${name} workshop $name $image $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open } wokNAV:tlist:Set $w $loc $dir @@ -235,10 +241,11 @@ proc wokNAV:Tree:Updateworkbench { w loc dir } { } else { set image $IWOK_GLOBALS(workbench,image) } - - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -text $name -itemtype imagetext \ - -image $image \ - -data [list ${loc}:${name} workbench $name $image $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${name}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -text $name -itemtype imagetext \ + -image $image \ + -data [list ${loc}:${name} workbench $name $image $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open } wokNAV:tlist:Set $w $loc $dir @@ -279,10 +286,11 @@ proc wokNAV:Tree:Updatedevunit { w loc dir } { set disp $IWOK_GLOBALS($type,disp) set fdate $IWOK_GLOBALS($type,fdate) set image $IWOK_GLOBALS($type,image) - - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ - -text $name -image $image \ - -data [list ${loc}:${name} devunit_$type $name $image $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${name}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ + -text $name -image $image \ + -data [list ${loc}:${name} devunit_$type $name $image $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open } wokNAV:tlist:Set $w $loc $dir @@ -323,18 +331,22 @@ proc wokNAV:Tree:Updatedevunitstuff { w loc dir } { if [info exists TLOC(source)] { set name source - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ - -text $name -image $IWOK_GLOBALS(devunitstuff,source) \ - -data [list ${loc}:${name} stuff_$name $name $IWOK_GLOBALS(devunitstuff,source) $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${name}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ + -text $name -image $IWOK_GLOBALS(devunitstuff,source) \ + -data [list ${loc}:${name} stuff_$name $name $IWOK_GLOBALS(devunitstuff,source) $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open set IWOK_WINDOWS($w,NAV,tree,uinfo,${loc}:${name},$name) $TLOC($name) } foreach name [array names TLOC] { if { "$name" != "source" } { - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ - -text $name -image $IWOK_GLOBALS(devunitstuff,cell) \ - -data [list ${loc}:${name} stuff_$name $name $IWOK_GLOBALS(devunitstuff,cell) $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${name}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ + -text $name -image $IWOK_GLOBALS(devunitstuff,cell) \ + -data [list ${loc}:${name} stuff_$name $name $IWOK_GLOBALS(devunitstuff,cell) $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open set IWOK_WINDOWS($w,NAV,tree,uinfo,${loc}:${name},$name) $TLOC($name) } @@ -354,9 +366,10 @@ proc wokNAV:Tree:Updatestufflist { w loc dir stuff_type } { foreach name [lsort -command wokSortPath $IWOK_WINDOWS($w,NAV,tree,uinfo,$loc,$type)] { set text [file tail $name] - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${text} -itemtype imagetext -text $text \ - -image $image \ - -data [list $loc trig_terminal $text $image $name] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${text}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${text} -itemtype imagetext -text $text \ + -image $image -data [list $loc trig_terminal $text $image $name] + } } wokNAV:tlist:Set $w ${loc} $dir return @@ -399,9 +412,11 @@ proc wokNAV:Tree:Updateparcel { w loc dir } { foreach unit [pinfo -a ${loc}] { set type [lindex $unit 0] set name [lindex $unit 1] - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ - -text $name -image [tix getimage $type] \ - -data [list ${loc}:${name} parcel_$type ${name} [tix getimage $type] $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${name}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ + -text $name -image [tix getimage $type] \ + -data [list ${loc}:${name} parcel_$type ${name} [tix getimage $type] $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open } wokNAV:tlist:Set $w $loc $dir @@ -436,9 +451,11 @@ proc wokNAV:Tree:Updateparcelstufflist { w loc dir stuff_type } { foreach name [array names TLOC] { set image $icell if { "$name" == "source" } { set image $isource } - $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ - -text $name -image $image \ - -data [list ${loc}:${name} parcelstuff_$name $name $image $fdate $disp] + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${name}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${name} -itemtype imagetext \ + -text $name -image $image \ + -data [list ${loc}:${name} parcelstuff_$name $name $image $fdate $disp] + } $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open set IWOK_WINDOWS($w,NAV,tree,uinfo,${loc}:${name},$name) $TLOC($name) } diff --git a/src/WOKTclLib/wstore.tcl b/src/WOKTclLib/wstore.tcl index cc57ce2..eb7cb08 100755 --- a/src/WOKTclLib/wstore.tcl +++ b/src/WOKTclLib/wstore.tcl @@ -8,6 +8,7 @@ # Usage # proc wokStoreUsage { } { + global env puts stderr \ { Usage : wstore is used to enqueue a report file, to get @@ -15,9 +16,9 @@ proc wokStoreUsage { } { (To update a workbench directly from a report see a the end of this help) >wstore file : without option adds a report in the report's queue - from (created by wprepare). + from . Queue name is deduced from the name of the father - workbench found in . + workbench written in . (created by wprepare). To list all pending reports name and ID in a queue use the following command: > wstore -wb name -ls @@ -25,7 +26,6 @@ proc wokStoreUsage { } { In the following syntaxes the option -wb is used to specify a workbench name. (Use a full workbench path for the workbench name. Default is the current wb. is a report ID (see above) - option -ls >wstore [-rm|-cat] [-wb name] [ID] @@ -53,6 +53,9 @@ proc wokStoreUsage { } { (Default behavior: Creates a a subdirectory adm in directory created using -base option) -welcome: If a report list new development units, by default store will refuse. If you want wstore be quiet create the queue with -welcome option. + -trigger to specify the full path of a tcl file defining a tcl proc triggered after a + report has been enqueued. An example for such a file can be found in + $env(WOK_LIBRARY)/wstore_trigger.example. To list all queues and their associated parameters: @@ -85,7 +88,10 @@ proc wstore { args } { set tblreq(-wb) value_required:string set tblreq(-create) {} - set tblreq(-queue) value_required:string + + set tblreq(-queue) value_required:string + set tblreq(-trigger) value_required:string + set tblreq(-base) value_required:string set tblreq(-type) value_required:string set tblreq(-journal) value_required:string @@ -126,6 +132,10 @@ proc wstore { args } { if [info exists tabarg(-queue)] { set queue $tabarg(-queue) } + set trig {} + if [info exists tabarg(-trigger)] { + set trig $tabarg(-trigger) + } set type SCCS if [info exists tabarg(-type)] { set type $tabarg(-type) @@ -156,7 +166,7 @@ proc wstore { args } { set journal [file join $commonbase adm wintegre.jnl] } wokStore:Report:Configure set \ - [wokStore:Report:FileAdm $curwb] $curwb $queue $base $type $counter $journal $welcome + [wokStore:Report:FileAdm $curwb] $curwb $queue $trig $base $type $counter $journal $welcome if { $verbose } { msgprint -c WOKVC -i "Reports queue created under $queue " msgprint -c WOKVC -i "Repository ($type) created under $base " @@ -233,6 +243,7 @@ proc wstore { args } { msgprint -c WOKVC -i "Repository ([wokIntegre:BASE:GetType]) under [wokIntegre:BASE:GetRootName]" msgprint -c WOKVC -i "Integration counter in : [wokIntegre:Number:GetName]" msgprint -c WOKVC -i "Integration journal in : [wokIntegre:Journal:GetName]" + msgprint -c WOKVC -i "Trigger : [wokStore:Trigger:GetName]" return } @@ -329,6 +340,9 @@ proc wstore { args } { msgprint -c WOKVC -i "Storing report in queue of workbench ${shop}:$wbpere" set frigo [file join [wokStore:Report:GetRootName] ${entry}] wokStore:Report:Add $ID table $banner $notes $frigo + if { [set trig [wokStore:Trigger:Exists]] != {} } { + wokStore:Trigger:Invoke $trig $frigo + } return } else { msgprint -c WOKVC -e "Report name $TID should not contains a comma." @@ -360,17 +374,17 @@ proc wokStore:Report:SetQName { wb {alert 0} } { if { $alert == 1 } { msgprint -c WOKVC -e "File VCDEF.tcl not found in [file dirname $vc] of workbench $wb." } - wokStore:Report:Configure unset {} {} {} {} {} {} {} {} + wokStore:Report:Configure unset {} {} {} {} {} {} {} {} {} return {} } } else { msgprint -c WOKVC -e "Entity $wb is not a workbench." - wokStore:Report:Configure unset {} {} {} {} {} {} {} {} + wokStore:Report:Configure unset {} {} {} {} {} {} {} {} {} return {} } } else { msgprint -c WOKVC -e "Entity $wb does not exists." - wokStore:Report:Configure unset {} {} {} {} {} {} {} {} + wokStore:Report:Configure unset {} {} {} {} {} {} {} {} {} return {} } } @@ -389,9 +403,10 @@ proc wokStore:Queue:Exists { wb } { ;# ;# Ecrit dans diradm le fichier VCDEF.tcl contenant les definitions de la queue. ;# -proc wokStore:Report:Configure { option fileadm wb queue base type counter journal welcome } { +proc wokStore:Report:Configure { option fileadm wb queue trignam base type counter journal welcome } { set proc_defined_in_VC [list \ wokStore:Report:GetRootName \ + wokStore:Trigger:GetName \ wokIntegre:BASE:GetRootName \ wokIntegre:BASE:GetType \ wokIntegre:RefCopy:GetWB \ @@ -403,9 +418,10 @@ proc wokStore:Report:Configure { option fileadm wb queue base type counter journ switch -- $option { set { - wokStore:mkdir $queue ;# the hook for the queue + wokUtils:FILES:mkdir $queue ;# the hook for the queue eval "proc wokStore:Report:GetRootName { } { return $queue }" - wokStore:mkdir $base ;# the hook for the base + eval "proc wokStore:Trigger:GetName { } { return $trignam }" + wokUtils:FILES:mkdir $base ;# the hook for the base eval "proc wokIntegre:BASE:GetRootName { } { return $base }" ;# the type of the base eval "proc wokIntegre:BASE:GetType { } { return $type }" @@ -418,7 +434,7 @@ proc wokStore:Report:Configure { option fileadm wb queue base type counter journ ;# create integration counter ONLY if it does not exists. if { ![file exists [wokIntegre:Number:GetName]] } { msgprint -c WOKVC -i "Creating file [wokIntegre:Number:GetName]" - wokStore:mkdir [file dirname [wokIntegre:Number:GetName]] + wokUtils:FILES:mkdir [file dirname [wokIntegre:Number:GetName]] wokUtils:FILES:touch [wokIntegre:Number:GetName] 1 } @@ -427,7 +443,7 @@ proc wokStore:Report:Configure { option fileadm wb queue base type counter journ ;# create journal file ONLY if it does not exists. if { ![file exists [wokIntegre:Journal:GetName]] } { msgprint -c WOKVC -i "Creating file [wokIntegre:Journal:GetName]" - wokStore:mkdir [file dirname [wokIntegre:Journal:GetName]] + wokUtils:FILES:mkdir [file dirname [wokIntegre:Journal:GetName]] } ;# eval "proc wokIntegre:Version:Get { } { return 1 }" @@ -514,13 +530,13 @@ proc wokStore:Report:Add { ID intable banner notes frigo } { upvar $intable table set writact $banner - wokStore:mkdir $frigo - chmod 0777 $frigo + wokUtils:FILES:mkdir $frigo + wokUtils:FILES:chmod 0777 $frigo set LST [lsort [array names table]] foreach e $LST { ;#msgprint -c WOKVC -i [format "Processing unit : %s" $e] - wokStore:mkdir $frigo/$e - chmod 0777 $frigo/$e + wokUtils:FILES:mkdir $frigo/$e + wokUtils:FILES:chmod 0777 $frigo/$e lappend writact "* $e" foreach l $table($e) { set str [wokUtils:LIST:Trim $l] @@ -534,7 +550,7 @@ proc wokStore:Report:Add { ID intable banner notes frigo } { } + { if { [wokUtils:FILES:copy $orig/$file $frigo/$e/$file] != -1 } { - chmod 0777 $frigo/$e/$file + wokUtils:FILES:chmod 0777 $frigo/$e/$file lappend writact "+ $frigo/$e/$file" } else { return -1 @@ -545,7 +561,7 @@ proc wokStore:Report:Add { ID intable banner notes frigo } { } # { if { [wokUtils:FILES:copy $orig/$file $frigo/$e/$file] != -1 } { - chmod 0777 $frigo/$e/$file + wokUtils:FILES:chmod 0777 $frigo/$e/$file lappend writact "# $frigo/$e/$file" } else { return -1 @@ -565,7 +581,7 @@ proc wokStore:Report:Add { ID intable banner notes frigo } { wokUtils:FILES:copy $ID $frigo/report-orig wokUtils:FILES:ListToFile $writact $frigo/report-work wokUtils:FILES:ListToFile $notes $frigo/report-notes - chmod 0777 [list $frigo/report-orig $frigo/report-work $frigo/report-notes] + wokUtils:FILES:chmod 0777 [list $frigo/report-orig $frigo/report-work $frigo/report-notes] return 1 } #;> @@ -585,10 +601,10 @@ proc wokStore:Report:Del { LISTREPORT } { proc wokStore:Report:RmEntry { fullentry } { foreach itm [glob -nocomplain $fullentry/*] { if [file isdirectory $itm] { - wokUtils:FILES:removedir $itm + wokUtils:FILES:rmdir $itm } } - wokUtils:FILES:removedir $fullentry + wokUtils:FILES:rmdir $fullentry return } @@ -694,7 +710,7 @@ proc wokStore:Report:GetUniqueName { name } { #;< proc wokStore:Report:GetPrettyName { Uniquename } { set l [split $Uniquename ,] - return [list [lindex $l 1] [clock format [lindex $l 0]] ] + return [list [lindex $l 1] [fmtclock [lindex $l 0]] ] } #;> @@ -829,26 +845,6 @@ proc wokStore:Report:Get { id } { return $l } ;# -;# -proc wokStore:mkdir { d } { - global tcl_version - if ![file exists $d] { - if { "$tcl_version" == "7.5" } { - mkdir -path $d - } else { - file mkdir $d - } - if [file exists $d] { - return $d - } else { - return {} - } - } else { - return $d - } -} -;# -;# proc wokPrepare:Report:Copy { intable wbpere wbfils {verbose 0} } { upvar $intable table @@ -898,7 +894,7 @@ proc wokPrepare:Report:Copy { intable wbpere wbfils {verbose 0} } { # { if { [lsearch $localfiles $path] != -1 } { msgprint -c WOKVC -i " Updating $file in unit ${wbpere}:${udname}" - lappend writact "chmod 0644 $frigo/$file" + lappend writact "wokUtils:FILES:chmod 0644 $frigo/$file" lappend writact "wokUtils:FILES:copy $path $frigo/$file" } } @@ -952,6 +948,7 @@ proc wokStore:queue:ls { lwb } { msgprint -c WOKVC -i "Repository ([wokIntegre:BASE:GetType]) under [wokIntegre:BASE:GetRootName]" msgprint -c WOKVC -i "Integration counter in : [wokIntegre:Number:GetName]" msgprint -c WOKVC -i "Integration journal in : [wokIntegre:Journal:GetName]" + msgprint -c WOKVC -i "Trigger : [wokStore:Trigger:GetName]" puts "" } } @@ -965,3 +962,34 @@ proc wokStore:queue:ls { lwb } { ;# ;# Workbench KAS:C40:ros ;#wstore -create -wb :KAS:TEST:ros -base /adv_20/KAS/C40/SCCS/BASES -type SCCS -queue /adv_20/KAS/C40/SCCS/adm/C40/FRIGO -counter /adv_20/KAS/C40/SCCS/adm/C40/report.num -journal /adv_20/KAS/C40/SCCS/adm/C40/wintegre.jnl +#;> +# Check if file trigger exists +# +#;< +proc wokStore:Trigger:Exists { } { + set trignam [wokStore:Trigger:GetName] + if { $trignam != {} } { + if { [file exists $trignam] } { + return $trignam + } else { + return {} + } + } else { + return {} + } +} +#;> +# Invoke a trigger +#;< +proc wokStore:Trigger:Invoke { trignam report_path } { + uplevel #0 source $trignam + ;#msgprint -c WOKVC -i "Invoking file $trignam." + if { [catch { wstore_trigger $report_path } trigval ] == 0 } { + ;#msgprint -c WOKVC -i "Trigger $trignam successfully completed" + return $trigval + } else { + msgprint -c WOKVC -e "Error in trigger: $trigval" + return {} + } + return +} diff --git a/src/WOKTclLib/wutils.tcl b/src/WOKTclLib/wutils.tcl index 1280d11..08fc72e 100755 --- a/src/WOKTclLib/wutils.tcl +++ b/src/WOKTclLib/wutils.tcl @@ -2372,4 +2372,55 @@ proc wokUtils:EASY:FmtFmtString2 { fmt1 fmt2 l {yes_for_last 0} {edit_last {}} } } return $str } +;# +;# keys.. provided by Tclx +;# +proc wokUtils:key:lset { listvar key value } { + upvar $listvar VLOC + set lret {} + if [info exists VLOC] { + set l2 {} + foreach x $VLOC { + lappend l2 [lindex $x 0] + lappend l2 [lindex $x 1] + } + array set MM $l2 + set MM($key) $value + foreach f [array names MM] { + lappend lret [list $f $MM($f)] + } + } else { + lappend lret [list $key $value] + } + set VLOC $lret + return +} +proc wokUtils:key:lkeys { listvar } { + upvar $listvar VLOC + set lret {} + foreach x $VLOC { + lappend lret [lindex $x 0] + } + return $lret +} +proc wokUtils:key:lget { listvar indx } { + upvar $listvar VLOC + foreach x $VLOC { + if { [string compare [lindex $x 0] $indx] == 0 } { + return [lindex $x 1] + } + } + return {} +} +proc wokUtils:key:ldel { listvar indx } { + upvar $listvar VLOC + set lret {} + foreach x $VLOC { + if { [string compare [lindex $x 0] $indx] != 0 } { + lappend lret $x + } + } + set VLOC $lret + return +} -- 2.39.5