From 1b94486e253f346d623dd938abac792c2500bf26 Mon Sep 17 00:00:00 2001 From: cas Date: Wed, 11 Jul 2001 18:22:11 +0000 Subject: [PATCH] No comments --- src/WOKTclLib/WOKVC.tcl | 30 +++--- src/WOKTclLib/osutils.tcl | 182 +++++++++++++++++++++++------------- src/WOKTclLib/upack.tcl | 16 ++-- src/WOKTclLib/wcheck.tcl | 10 +- src/WOKTclLib/wnews.tcl | 14 +-- src/WOKTclLib/wokCOO.tcl | 35 ++++++- src/WOKTclLib/wokQUE.tcl | 8 +- src/WOKTclLib/wokRPR.tcl | 6 +- src/WOKTclLib/wokStuff.tcl | 2 +- src/WOKTclLib/wokinterp.tcl | 12 +-- src/WOKTclLib/wutils.tcl | 182 +++++++++++++++++++++++------------- 11 files changed, 311 insertions(+), 186 deletions(-) diff --git a/src/WOKTclLib/WOKVC.tcl b/src/WOKTclLib/WOKVC.tcl index 922dcd0..f803513 100755 --- a/src/WOKTclLib/WOKVC.tcl +++ b/src/WOKTclLib/WOKVC.tcl @@ -222,7 +222,7 @@ proc wokIntegrebase { } { set dirtmpu /tmp/wintegrecreateunits[pid] catch { rmdir -nocomplain $dirtmpu - mkdir -path $dirtmpu + wokUtils:FILES:mkdir $dirtmpu } set chkout $dirtmpu/checkout.cmd set chkid [open $chkout w] @@ -283,7 +283,7 @@ proc wokIntegreCleanup { broot table listid dirtmp } { } if [info exists dirtmp] { foreach d $dirtmp { - catch { wokUtils:FILES:removedir $d } + catch { wokUtils:FILES:rmdir $d } } } return @@ -402,14 +402,14 @@ proc wokIntegre:BASE:InitRef { broot table vrs comment fileid } { proc wokIntegre:BASE:Fill { broot elmin {action move} } { set bdir $broot if ![file exists $bdir] { - mkdir -path $bdir - chmod 0777 $bdir + wokUtils:FILES:mkdir $bdir + wokUtils:FILES:chmod 0777 $bdir } foreach e $elmin { if { [file isfile $e] } { set bna [file tail $e] - catch { frename $e $bdir/$bna } + catch { wokUtils:FILES:rename $e $bdir/$bna } } elseif { [file isdirectory $e] } { set dl {} foreach f [wokUtils:EASY:readdir $e] { @@ -457,7 +457,7 @@ proc wokIntegre:BASE:LS { } { proc wokIntegre:BASE:BTMPCreate { broot Unit {create 0} } { if { $create } { wokIntegre:BASE:BTMPDelete $broot $Unit - mkdir -path $broot/$Unit/tmp + wokUtils:FILES:mkdir $broot/$Unit/tmp } return $broot/$Unit/tmp } @@ -467,13 +467,7 @@ proc wokIntegre:BASE:BTMPCreate { broot Unit {create 0} } { # Le directory courant ne doit pas etre unit/tmp #;< proc wokIntegre:BASE:BTMPDelete { broot Unit } { - set R $broot/$Unit/tmp - if [file exists $R] { - foreach f [wokUtils:EASY:readdir $R] { - unlink $R/$f - } - rmdir -nocomplain $R - } + catch { wokUtils:FILES:rmdir $broot/$Unit/tmp } return 1 } # @@ -532,7 +526,7 @@ proc wokIntegre:RefCopy:SetWritable { table user } { foreach e [lrange $TLOC($UD) 1 end] { set file $dirsrc/[lindex $e 0] if [file owned $file] { - chmod u+w $file + wokUtils:FILES:chmod u+w $file } else { msgprint -c WOKVC -e "Protection of $file cannot be modified (File not found or not owner)." return -1 @@ -562,7 +556,7 @@ proc wokIntegre:RefCopy:FillRef { table {fileid stdout} } { set file [lindex $elm 0] if { [string compare $vrs x.x] != 0 } { if [file writable $dirsrc/$file] { - frename $dirsrc/$file $dirsrc/${file}-sav + wokUtils:FILES:rename $dirsrc/$file $dirsrc/${file}-sav msgprint -c WOKVC -i "File $dirsrc/$file renamed ${file}-sav" } set Sfile $root/[wokIntegre:BASE:ftos $file $vrs] @@ -596,7 +590,7 @@ proc wokIntegre:RefCopy:FillUser { table {force 0} {fileid stdout} {mask 644} } if [file exists $dirsrc/$file] { if { $force } { if { [file writable $dirsrc/$file] } { - frename $dirsrc/$file $dirsrc/${file}-sav + wokUtils:FILES:rename $dirsrc/$file $dirsrc/${file}-sav msgprint -c WOKVC -i "File $dirsrc/$file renamed ${file}-sav" set Sfile $root/[wokIntegre:BASE:ftos $file $vrs] wokIntegre:BASE:GetFile $Sfile $vrs $fileid @@ -816,7 +810,7 @@ proc wokGetcopy { } { foreach e $RES { if { [file exists [file join $to $e]] } { msgprint -c WOKVC -w "Renamed [file join $to $e] [file join $to $e]-sav" - frename [file join $to $e] [file join $to $e]-sav + wokUtils:FILES:rename [file join $to $e] [file join $to $e]-sav } if { $VERBOSE } { msgprint -c WOKVC -i "Copying [file join $from $e] to [file join $to $e]" } wokUtils:FILES:copy [file join $from $e] [file join $to $e] @@ -896,7 +890,7 @@ proc wokGetbase { } { puts [exec cat $dirtmp/checkout.cmd] } - unlink $chkout + wokUtils:FILES:delete $chkout rmdir -nocomplain $dirtmp return $statx } diff --git a/src/WOKTclLib/osutils.tcl b/src/WOKTclLib/osutils.tcl index 2840180..1193d85 100755 --- a/src/WOKTclLib/osutils.tcl +++ b/src/WOKTclLib/osutils.tcl @@ -16,13 +16,17 @@ proc osutils:dsp:readtemplate { } { puts stderr "Info : readtemplate : Template for MS project from [set loc /adv_20/KAS/C40/ros/src/OS/template.dsp]" return [wokUtils:FILES:FileToString $loc] } +proc osutils:dsp:readtemplatex { } { + puts stderr "Info : readtemplate : Template for MS project from [set loc /adv_20/KAS/C40/ros/src/OS/template.dspx]" + return [wokUtils:FILES:FileToString $loc] +} proc osutils:am:readtemplate { } { - puts stderr "Info : readtemplate : Template for Makefile.am from [set loc /adv_21/KAS/C40/yan/src/WOKTclLib/template.mam]" + puts stderr "Info : readtemplate : Template for Makefile.am from [set loc /adv_20/KAS/C40/ros/src/WOKTclLib/template.mam]" return [wokUtils:FILES:FileToString $loc] } proc osutils:in:readtemplate { } { - puts stderr "Info : readtemplate : Template for Makefile.in from [set loc /adv_21/KAS/C40/yan/src/WOKTclLib/template.min]" + puts stderr "Info : readtemplate : Template for Makefile.in from [set loc /adv_20/KAS/C40/ros/src/WOKTclLib/template.min]" return [wokUtils:FILES:FileToString $loc] } @@ -98,12 +102,18 @@ proc osutils:dsw:footer { } { return $var } ;# -;# +;# An item for compiling a c++ class ;# proc osutils:dsp:fmtcpp { } { return {# ADD CPP /I ..\..\inc /I ..\..\drv\%s /I ..\..\src\%s /D "__%s_DLL"} } ;# +;# An item for compiling a c++ main +;# +proc osutils:dsp:fmtcppx { } { + return {# ADD CPP /I ..\..\inc /I ..\..\drv\%s /I ..\..\src\%s /D "__%s_DLL"} +} +;# ;# List extensions of files devoted to be eaten by cl.exe compiler. ;# proc osutils:dsp:compilable { } { @@ -209,7 +219,7 @@ proc osutils:tk:units { tkloc {typed 0} } { } } if { $l == {} } { - puts stderr "Error. No devunit for $tkloc" + ;#puts stderr "Warning. No devunit included in $tkloc" } return $l } @@ -240,15 +250,18 @@ proc osutils:tk:loadunit { loc map {local 0}} { return } ;# -;# Returns the list of all compilable files name in a toolkit, +;# Returns the list of all compilable files name in a toolkit, or devunit of any type ;# Call unit filter on units name to accept or reject a unit +;# Tfiles lists for each unit the type of file that can be compiled. ;# proc osutils:tk:files { tkloc {l_compilable {} } {justail 1} {unitfilter {}} } { set Tfiles(source,package) {source derivated privinclude pubinclude drvfile} set Tfiles(source,nocdlpack) {source pubinclude drvfile} set Tfiles(source,schema) {source derivated privinclude pubinclude drvfile} set Tfiles(source,toolkit) {} + set Tfiles(source,executable) {source pubinclude drvfile} set listloc [concat [osutils:tk:units [woklocate -u $tkloc]] [woklocate -u $tkloc]] + ;#puts " listloc = $listloc" if { $l_compilable == {} } { set l_comp [list .c .cxx .cpp] } else { @@ -312,64 +325,94 @@ proc osutils:tk:hascsf { EXTERNLIB } { return $lret } ;# -;# Create file tkloc.dsp in dir return the full path of the created file +;# Create file tkloc.dsp for a shareable library (dll). +;# in dir return the full path of the created file ;# -proc osutils:mkdsp { dir tkloc {tmplat {} } {fmtcpp {} } {doinsert 1} } { - set Tfiles(source,package) {source derivated privinclude pubinclude drvfile} - set Tfiles(source,nocdlpack) {source pubinclude drvfile} - set Tfiles(source,schema) {source derivated privinclude pubinclude drvfile} - set Tfiles(source,toolkit) {} +proc osutils:mkdsp { dir tkloc {tmplat {} } {fmtcpp {} } } { if { $tmplat == {} } {set tmplat [osutils:dsp:readtemplate]} if { $fmtcpp == {} } {set fmtcpp [osutils:dsp:fmtcpp]} set fp [open [set fdsp [file join $dir ${tkloc}.dsp]] w] fconfigure $fp -translation crlf set l_compilable [osutils:dsp:compilable] - if { $doinsert } { - regsub -all -- {__TKNAM__} $tmplat $tkloc temp0 - set tkused "" - foreach tkx [wokUtils:LIST:Purge [osutils:tk:close [woklocate -u $tkloc]]] { - append tkused "${tkx}.lib " - } - puts "$tkloc requires $tkused" - regsub -all -- {__TKDEP__} $temp0 $tkused temp1 - set files "" - lappend lret $fdsp - set listloc [concat [osutils:tk:units [woklocate -u $tkloc]] [woklocate -u $tkloc]] - set resultloc [osutils:justwnt $listloc] - foreach loc $resultloc { - set utyp [uinfo -t $loc] - if [array exists map] { unset map } - osutils:tk:loadunit $loc map - ;#puts " loc = $loc === > [array names map]" - set LType $Tfiles(source,${utyp}) - foreach typ [array names map] { - if { [lsearch $LType $typ] == -1 } { - unset map($typ) - } - } - set xlo [wokinfo -n $loc] - if [array exists written] { unset written } - foreach type [array names map] { - foreach f $map($type) { - if { [lsearch $l_compilable [file extension $f]] != -1 } { - if { ![info exists written([file tail $f])] } { - set written([file tail $f]) 1 - append files "# Begin Source File" "\n" - append files "SOURCE=..\\..\\" [wokUtils:EASY:bs1 [wokUtils:FILES:wtail $f 3]] "\n" - append files [format $fmtcpp $xlo $xlo $xlo] "\n" - append files "# End Source File" "\n" - } else { - puts "Warning : in dsp more than one occurences for [file tail $f]" - } - } - } + regsub -all -- {__TKNAM__} $tmplat $tkloc temp0 + set tkused "" + foreach tkx [wokUtils:LIST:Purge [osutils:tk:close [woklocate -u $tkloc]]] { + append tkused "${tkx}.lib " + } + puts "$tkloc requires $tkused" + regsub -all -- {__TKDEP__} $temp0 $tkused temp1 + set files "" + ;#set listloc [concat [osutils:tk:units [woklocate -u $tkloc]] [woklocate -u $tkloc]] + set listloc [osutils:tk:units [woklocate -u $tkloc]] + set resultloc [osutils:justwnt $listloc] + ;#puts "result = $resultloc" + ;#set lsrc [lsort [osutils:tk:files $tkloc osutils:am:compilable 1 osutils:justwnt]] + if [array exists written] { unset written } + foreach fxlo $resultloc { + set xlo [wokinfo -n $fxlo] + set lsrc [osutils:tk:files $xlo osutils:am:compilable 0] + foreach f $lsrc { + ;#puts " f = $f" + if { ![info exists written([file tail $f])] } { + set written([file tail $f]) 1 + append files "# Begin Source File" "\n" + append files "SOURCE=..\\..\\" [wokUtils:EASY:bs1 [wokUtils:FILES:wtail $f 3]] "\n" + append files [format $fmtcpp $xlo $xlo $xlo] "\n" + append files "# End Source File" "\n" + } else { + puts "Warning : in dsp more than one occurences for [file tail $f]" } } - regsub -all -- {__FILES__} $temp1 $files temp2 - puts $fp $temp2 - } else { - puts $fp $tmplat } + + regsub -all -- {__FILES__} $temp1 $files temp2 + puts $fp $temp2 + close $fp + return $fdsp +} +;# +;# Create file tkloc.dsp for a executable "console" application +;# in dir return the full path of the created file +;# +proc osutils:mkdspx { dir tkloc {tmplat {} } {fmtcpp {} } } { + if { $tmplat == {} } {set tmplat [osutils:dsp:readtemplatex]} + if { $fmtcpp == {} } {set fmtcpp [osutils:dsp:fmtcppx]} + set fp [open [set fdsp [file join $dir ${tkloc}.dsp]] w] + fconfigure $fp -translation crlf + set l_compilable [osutils:dsp:compilable] + regsub -all -- {__XQTNAM__} $tmplat $tkloc temp0 + set tkused "" + foreach tkx [wokUtils:LIST:Purge [osutils:tk:close [woklocate -u $tkloc]]] { + append tkused "${tkx}.lib " + } + puts "$tkloc requires $tkused" + regsub -all -- {__TKDEP__} $temp0 $tkused temp1 + set files "" + ;#set listloc [concat [osutils:tk:units [woklocate -u $tkloc]] [woklocate -u $tkloc]] + ;#set listloc [osutils:tk:units [woklocate -u $tkloc]] + ;#set resultloc [osutils:justwnt $listloc] + ;#puts "result = $resultloc" + ;#set lsrc [lsort [osutils:tk:files $tkloc osutils:am:compilable 1 osutils:justwnt]] + ;#if [array exists written] { unset written } + ;#foreach fxlo $resultloc { + ;#set tkloc [set xlo [wokinfo -n $fxlo]] + set lsrc [osutils:tk:files $tkloc osutils:am:compilable 0] + foreach f $lsrc { + ;#puts " f = $f" + if { ![info exists written([file tail $f])] } { + set written([file tail $f]) 1 + append files "# Begin Source File" "\n" + append files "SOURCE=..\\..\\" [wokUtils:EASY:bs1 [wokUtils:FILES:wtail $f 3]] "\n" + append files [format $fmtcpp $tkloc $tkloc $tkloc] "\n" + append files "# End Source File" "\n" + } else { + puts "Warning : in dsp more than one occurences for [file tail $f]" + } + } + ;#} + + regsub -all -- {__FILES__} $temp1 $files temp2 + puts $fp $temp2 close $fp return $fdsp } @@ -412,7 +455,11 @@ proc osutils:tk:mkam { dir tkloc } { regsub -all -- {__VPATH__} "$temp0" "$vpath" temp1 set inclu [osutils:am:__INCLUDES__ $lpkgs] regsub -all -- {__INCLUDES__} "$temp1" "$inclu" temp2 - set libadd [osutils:am:__LIBADD__ $close $final] + if { $close != {} } { + set libadd [osutils:am:__LIBADD__ $close $final] + } else { + set libadd "" + } regsub -all -- {__LIBADD__} "$temp2" "$libadd" temp3 set source [osutils:am:__SOURCES__ $lsrc] regsub -all -- {__SOURCES__} "$temp3" "$source" temp4 @@ -426,8 +473,13 @@ proc osutils:tk:mkam { dir tkloc } { set tmplat [osutils:in:readtemplate] regsub -all -- {__TKNAM__} "$tmplat" "$tkloc" temp0 - set dpncies [osutils:in:__DEPENDENCIES__ $close] + if { $close != {} } { + set dpncies [osutils:in:__DEPENDENCIES__ $close] + } else { + set dpncies "" + } regsub -all -- {__DEPENDENCIES__} "$temp0" "$dpncies" temp1 + set objects [osutils:in:__OBJECTS__ $lobj] regsub -all -- {__OBJECTS__} "$temp1" "$objects" temp2 set amdep [osutils:in:__AMPDEP__ $lobj] @@ -515,8 +567,8 @@ proc osutils:in:__OBJECTS__ { l } { ;# l is the list of objects files in toolkit. ;# proc osutils:in:__AMPDEP__ { l } { - set fmt1 "$(DEPDIR)/%s.Plo" - set fmt2 "@AMDEP_TRUE@\t$(DEPDIR)/%s.Plo" + set fmt1 "\$(DEPDIR)/%s.Plo" + set fmt2 "@AMDEP_TRUE@\t\$(DEPDIR)/%s.Plo" return [wokUtils:EASY:FmtFmtString1 $fmt1 $fmt2 $l] } ;# @@ -524,21 +576,23 @@ proc osutils:in:__AMPDEP__ { l } { ;# l is the list of objects files in toolkit. ;# proc osutils:in:__AMDEPTRUE__ { l } { - set fmt "@AMDEP_TRUE@@_am_include@ @_am_quote@$(DEPDIR)/%s.Plo@_am_quote@" + set fmt "@AMDEP_TRUE@@_am_include@ @_am_quote@\$(DEPDIR)/%s.Plo@_am_quote@" return [wokUtils:EASY:FmtSimple1 $fmt $l] } ;############################################################# ;# -proc TESTAM { } { - ;#exec rm -rf /adv_21/KAS/C40/yan/work/auto +proc TESTAM { {root home/AUTOCONF/src} } { + + ;#set root /adv_21/KAS/C40/yan/work/auto/src + wokcd KAS:C40:ros set ltk [w_info -T toolkit [wokcd]] - ;#set ltk TKDraw + ;#set ltk TKernel foreach tkloc $ltk { puts " toolkit: $tkloc ==> [woklocate -p ${tkloc}:source:EXTERNLIB KAS:C40:ros]" - exec mkdir -p /adv_21/KAS/C40/yan/work/auto/src/$tkloc - osutils:tk:mkam /adv_21/KAS/C40/yan/work/auto/src/$tkloc $tkloc + wokUtils:FILES:mkdir $root/$tkloc + osutils:tk:mkam $root/$tkloc $tkloc } } diff --git a/src/WOKTclLib/upack.tcl b/src/WOKTclLib/upack.tcl index daa427a..740ba12 100755 --- a/src/WOKTclLib/upack.tcl +++ b/src/WOKTclLib/upack.tcl @@ -115,7 +115,7 @@ proc upack { args } { puts stderr "Error: $status" } if [file exists $adr] { - catch {unlink $adr} + catch {wokUtils:FILES:delete $adr} } } return @@ -133,7 +133,7 @@ proc upack { args } { puts stderr "Error: $status" } if [file exists $adr] { - catch {unlink $adr} + catch {wokUtils:FILES:delete $adr} } } return @@ -226,7 +226,7 @@ proc upack:UnFold { fileid errlog errdir {typsel {}} verbose } { foreach u $lu { puts -nonewline stderr "Decoding $u ..." wokUtils:FILES:uudecode $u - unlink $u + wokUtils:FILES:delete $u puts stderr "Done" } return @@ -258,7 +258,7 @@ proc upack:Fold { List3 fileid {typsel {}} verbose } { puts stderr "Error: $errin" } if { $code != -1 } { - unlink $name + wokUtils:FILES:delete $name } } } @@ -454,7 +454,7 @@ proc wpack { args } { puts stderr "Error: $status" } if [file exists $adr] { - catch {unlink $adr} + catch {wokUtils:FILES:delete $adr} } } return @@ -501,7 +501,7 @@ proc wpack { args } { puts stderr "$status" } } elseif { [info exists table(-d)] } { - if { ![file exists $table(-d)] } { mkdir -path $table(-d) } + if { ![file exists $table(-d)] } { wokUtils:FILES:mkdir $table(-d) } wpack:Fold $Wadr $ulist $table(-d) [info exists table(-v)] msgprint -i "Archive files have been created in $table(-d)" } else { @@ -525,7 +525,7 @@ proc wpack { args } { puts stderr "Error: $status" } if [file exists $adr] { - catch {unlink $adr} + catch {wokUtils:FILES:delete $adr} } } } else { @@ -700,7 +700,7 @@ proc wpack:UnFold { fileid Wadr errlog errdir {typsel {}} verbose } { foreach u $lu { puts -nonewline stderr "Decoding $u ..." wokUtils:FILES:uudecode $u - unlink $u + wokUtils:FILES:delete $u puts stderr "Done" } return diff --git a/src/WOKTclLib/wcheck.tcl b/src/WOKTclLib/wcheck.tcl index 0bdd760..282aa3b 100755 --- a/src/WOKTclLib/wcheck.tcl +++ b/src/WOKTclLib/wcheck.tcl @@ -50,9 +50,9 @@ proc wcheck { args } { set tmpdir /tmp/wcheck[id process] if [file exists $tmpdir] { - unlink [glob -nocomplain $tmpdir/*] + wokUtils:FILES:delete [glob -nocomplain $tmpdir/*] } else { - mkdir -path $tmpdir + wokUtils:FILES:mkdir $tmpdir } set LFILE {} @@ -86,7 +86,7 @@ proc wcheck { args } { msgprint -c WOKVC -e "$file cannot be created ( $status )" } } - catch {unlink $sfile} + catch {wokUtils:FILES:delete $sfile} } } @@ -102,9 +102,9 @@ proc wcheck { args } { catch { if [file exists $tmpdir] { - unlink [glob -nocomplain $tmpdir/*] + wokUtils:FILES:delete [glob -nocomplain $tmpdir/*] } - unlink $tmpdir + wokUtils:FILES:delete $tmpdir } return diff --git a/src/WOKTclLib/wnews.tcl b/src/WOKTclLib/wnews.tcl index c65c877..e21220d 100755 --- a/src/WOKTclLib/wnews.tcl +++ b/src/WOKTclLib/wnews.tcl @@ -249,7 +249,7 @@ proc wokNewsExtract { } { wokIntegre:Journal:Slice $jnltmp $n1 $n2 $command $userdata } } - catch { unlink $jnltmp } + catch { wokUtils:FILES:delete $jnltmp } } return } @@ -558,10 +558,10 @@ proc wokIntegre:Journal:Purge { } { set num1 [lindex [lindex $lrep 0] 0] set num2 [lindex [lindex $lrep end] 0] set savjnl [file dirname $jnl]/${num1}-${num2}.jnl - frename $jnl $savjnl + wokUtils:FILES:rename $jnl $savjnl msgprint -c WOKVC -i "Creating file $jnl" wokUtils:FILES:ListToFile {} $jnl - chmod 0777 $jnl + wokUtils:FILES:chmod 0777 $jnl return $savjnl } else { return {} @@ -590,7 +590,7 @@ proc wokIntegre:Journal:List { } { #;< proc wokIntegre:Journal:Assemble { path {liste {}} } { if [file exists $path] { - if [catch { unlink $path } err] { + if [catch { wokUtils:FILES:delete $path } err] { msgprint -c WOKVC -e "Assemble error: $err" return } @@ -662,9 +662,9 @@ proc wokIntegre:Mark:GetTableName { journal {create 0} } { } else { if { $create } { msgprint -c WOKVC -i "Creating marks file in [file dirname $diradm]" - catch { mkdir -path [file dirname $diradm] } + catch { wokUtils:FILES:mkdir [file dirname $diradm] } wokUtils:FILES:ListToFile {} $diradm - chmod 0777 $diradm + wokUtils:FILES:chmod 0777 $diradm return $diradm } else { return {} @@ -845,7 +845,7 @@ proc wokIntegre:Scoop:Create { {texte {}} } { set diradm [file join [file dirname [wokIntegre:Journal:GetName]] scoop.jnl] if { $texte != {} } { wokUtils:FILES:copy $texte $diradm - chmod 0777 $diradm + wokUtils:FILES:chmod 0777 $diradm } return $diradm } diff --git a/src/WOKTclLib/wokCOO.tcl b/src/WOKTclLib/wokCOO.tcl index d6eec56..fcf4408 100755 --- a/src/WOKTclLib/wokCOO.tcl +++ b/src/WOKTclLib/wokCOO.tcl @@ -413,8 +413,36 @@ proc wokPrepare { {loc {}} {les_uds {}} } { } } + bind $IWOK_WINDOWS($w,hlist) { + wokUpdateObsoleteFile %W + } + + + return } +;# +;# +;# +proc wokUpdateObsoleteFile { hli } { + global IWOK_WINDOWS + set item [$hli info anchor] ; + set data [$hli info data $item] + ;#puts "item $item" + ;#puts "data $data" + set retval [wokDialBox .obsol[clock clicks] {Delete local copy} \ + "Your local copy of [lindex $item 1] should be updated." \ + warning 1 {Delete} {Update}] + if { $retval } { + wokUtils:FILES:copy [file join [lindex $item 3] [lindex $item 1]] [file join [lindex $item 2] [lindex $item 1]] + } else { + wokUtils:FILES:delete [file join [lindex $item 2] [lindex $item 1]] + } + return +} +;# +;# +;# proc wokGetDoublon { hli } { set item [$hli info anchor] ;#WOKTclLib^# Mkf.tcl //wok/src/WOKTclLib /adv_23/WOK/ef/src/WOKTclLib set data [$hli info data $item] @@ -700,20 +728,19 @@ proc wokrmEq { w } { set hli $IWOK_WINDOWS($w,hlist) $IWOK_WINDOWS($w,text) delete 1.0 end set lrm {} + set ldd {} foreach U [$hli info children] { foreach f [$hli info children $U] { set l [split [lindex [split $f ^] 1]] if { [string compare [lindex $l 0] =] == 0} { lappend lrm "rm [lindex $l 2]/[lindex $l 1]" + lappend ldd "[lindex $l 2]/[lindex $l 1]" } } } set but [wokDangerDialBox .wokrmeq {Remove same files} {Really do that ?} $lrm danger 0 {Apply} {Cancel}] if { $but == 0 } { - foreach f $lrm { - unlink [lindex $f 1] - $IWOK_WINDOWS($w,text) insert end "File [lindex $f 1] has been removed.\n" - } + wokUtils:FILES:delete $ldd wokHideEq $w } return diff --git a/src/WOKTclLib/wokQUE.tcl b/src/WOKTclLib/wokQUE.tcl index 507d7d6..23b7d17 100755 --- a/src/WOKTclLib/wokQUE.tcl +++ b/src/WOKTclLib/wokQUE.tcl @@ -131,7 +131,7 @@ proc wokReadStuffJournalOfcurwb { w } { update set jnltmp [wokUtils:FILES:tmpname jnltmp[pid].[wokinfo -n $IWOK_WINDOWS($w,curwb)]] if [file exists $jnltmp] { - unlink $jnltmp + wokUtils:FILES:delete $jnltmp } wokIntegre:Journal:Assemble $jnltmp if [file exists $jnltmp] { @@ -150,7 +150,7 @@ proc wokEditJnl { w } { update set jnltmp [wokUtils:FILES:tmpname jnltmp[pid].[wokinfo -n $IWOK_WINDOWS($w,curwb)]] if [file exists $jnltmp] { - unlink $jnltmp + wokUtils:FILES:delete $jnltmp } wokIntegre:Journal:Assemble $jnltmp if [file exists $jnltmp] { @@ -401,9 +401,7 @@ proc wokUpdateQueue { w } { proc wokWaffQueueExit { w } { global IWOK_WINDOWS destroy $w - foreach f [glob -nocomplain /tmp/jnltmp[pid].*] { - catch { unlink $f } - } + wokUtils:FILES:delete [glob -nocomplain /tmp/jnltmp[pid].*] if [info exists IWOK_WINDOWS($w,help)] { catch {destroy $IWOK_WINDOWS($w,help)} } diff --git a/src/WOKTclLib/wokRPR.tcl b/src/WOKTclLib/wokRPR.tcl index 41cce00..a88f2d4 100755 --- a/src/WOKTclLib/wokRPR.tcl +++ b/src/WOKTclLib/wokRPR.tcl @@ -595,7 +595,7 @@ proc wokRPRDeleteItem { w } { set item [lindex $lstent 1] set data [$hlist info data [$hlist info parent $entry]] set vrs [lindex $data 2] - catch { unlink $IWOK_WINDOWS($w,qroot)/$unit/[wokIntegre:BASE:ftos $item $vrs] } + catch { wokUtils:FILES:delete $IWOK_WINDOWS($w,qroot)/$unit/[wokIntegre:BASE:ftos $item $vrs] } } $hlist delete entry $entry $IWOK_WINDOWS($w,canvas) delete all @@ -651,9 +651,7 @@ proc wokRPRCheckItem { w } { proc wokRPRExit { w } { global IWOK_WINDOWS destroy $w - foreach f [glob -nocomplain /tmp/jnltmp[pid].*] { - catch { unlink $f } - } + wokUtils:FILES:delete [glob -nocomplain /tmp/jnltmp[pid].*] if [info exists IWOK_WINDOWS($w,help)] { catch {destroy $IWOK_WINDOWS($w,help)} } diff --git a/src/WOKTclLib/wokStuff.tcl b/src/WOKTclLib/wokStuff.tcl index fddb05b..9cb96de 100755 --- a/src/WOKTclLib/wokStuff.tcl +++ b/src/WOKTclLib/wokStuff.tcl @@ -193,7 +193,7 @@ proc wokDiffInText { text f1 f2 } { if { "$tcl_platform(platform)" == "unix" } { catch {exec diff $f1 $f2 > $wtmp} wokReadFile $text $wtmp - unlink $wtmp + wokUtils:FILES:delete $wtmp } elseif { "$tcl_platform(platform)" == "windows" } { $text delete 0.0 end $text insert end {Click on button "More diff" instead.} diff --git a/src/WOKTclLib/wokinterp.tcl b/src/WOKTclLib/wokinterp.tcl index a9bf584..298cc4e 100755 --- a/src/WOKTclLib/wokinterp.tcl +++ b/src/WOKTclLib/wokinterp.tcl @@ -163,11 +163,11 @@ proc woksh_csh {args} { puts $Launched "[lindex [wok_interp_command $format] 0]" close $Launched close $Template - chmod a+x $launched + wokUtils:FILES:chmod 0777 $launched set LAUNCH $launched } } - unlink $thefile + wokUtils:FILES:delete $thefile } msgprint -w -c "woksh_csh" "Emacs mode disabled : use exit to return to tcl" @@ -186,7 +186,7 @@ proc woksh_csh {args} { } } wok_end_shell $format - unlink $launched + wokUtils:FILES:delete $launched return; } @@ -241,7 +241,7 @@ proc woksh_emacs {args} { source $thefile - unlink $thefile + wokUtils:FILES:delete $thefile set thefile "/tmp/wokenv_[id process]_$format" @@ -264,7 +264,7 @@ proc woksh_emacs {args} { close $thefd log_user 0; exp_send -i $WOK_GLOBALS(wokinterp,$format,id) "[lindex [wok_source_cmd $format $thelongcmdfile] 0]\n" - unlink $thelongcmdfile + wokUtils:FILES:delete $thelongcmdfile } while { [string length $theline] > 100} { @@ -286,7 +286,7 @@ proc woksh_emacs {args} { } } - unlink $thefile + wokUtils:FILES:delete $thefile } log_user 0; diff --git a/src/WOKTclLib/wutils.tcl b/src/WOKTclLib/wutils.tcl index 326aefd..1280d11 100755 --- a/src/WOKTclLib/wutils.tcl +++ b/src/WOKTclLib/wutils.tcl @@ -624,31 +624,104 @@ proc wokUtils:FILES:AreSame { f1 f2 } { # Copy file # proc wokUtils:FILES:copy { fin fout } { - if { [catch { set in [ open $fin r ] } errin] == 0 } { - if { [catch { set out [ open $fout w ] } errout] == 0 } { - set nb [copyfile $in $out] - close $in - close $out - return $nb + global tcl_version + regsub -all {\.[^.]*} $tcl_version "" major + if { $major == 8 } { + file copy -force $fin $fout + } else { + if { "[info command copyfile]" == "copyfile" } { + if { [catch { set in [ open $fin r ] } errin] == 0 } { + if { [catch { set out [ open $fout w ] } errout] == 0 } { + set nb [copyfile $in $out] + close $in + close $out + return $nb + } else { + puts stderr "Error: $errout" + return -1 + } + } else { + puts stderr "Error: $errin" + return -1 + } } else { - puts stderr "Error: $errout" - return -1 + puts stderr "wokUtils:FILES:copy : Error unable to find a copy command." } + } +} +# +# Rename a file +# +proc wokUtils:FILES:rename { old new } { + global tcl_version + regsub -all {\.[^.]*} $tcl_version "" major + if { $major == 8 } { + file rename -force -- $old $new } else { - puts stderr "Error: $errin" - return -1 + if { "[info command frename]" == "frename" } { + frename $old $new + } else { + puts stderr "wokUtils:FILES:rename : Error unable to find a rename command." + } + } +} +# +# chmod a lfile ( chmod 0777 file : the best way to process..) +# +proc wokUtils:FILES:chmod { m lf } { + global tcl_version + regsub -all {\.[^.]*} $tcl_version "" major + if { $major == 8 } { + foreach f $lf { + file attributes $f -permissions $m + } + } else { + if { "[info command chmod]" == "chmod" } { + chmod $m $lf + } else { + puts stderr "wokUtils:FILES:chmod : Error unable to find a chmod command." + } + } +} + +proc wokUtils:FILES:mkdir { d } { + global tcl_version + regsub -all {\.[^.]*} $tcl_version "" major + if { $major == 8 } { + file mkdir $d + } else { + if ![file exists $d] { + if { "[info command mkdir]" == "mkdir" } { + mkdir -path $d + } else { + puts stderr "wokUtils:FILES:mkdir : Error unable to find a mkdir command." + } + } + } + if [file exists $d] { + return $d + } else { + return {} } } + # -# Delete file. Tcl 7.5 or later. +# Delete a list of files: Either Tcl 8.x or Tcl 7.x or later and Tclx. # -proc wokUtils:FILES:delete { f } { +proc wokUtils:FILES:delete { lf } { global tcl_version - if [file exists $f] { - if { "$tcl_version" == "7.5" } { - unlink $f + regsub -all {\.[^.]*} $tcl_version "" major + if { $major == 8 } { + foreach f $lf { + file delete -- $f + } + } else { + if { "[info command unlink]" == "unlink" } { + foreach f $lf { + unlink -nocomplain $f + } } else { - file delete $f + puts stderr "wokUtils:FILES:delete : Error unable to find a delete command." } } } @@ -718,11 +791,7 @@ proc wokUtils:FILES:FindFile { startDir namePat } { proc wokUtils:FILES:NatCopy { src dest {verbose 0} {YesOrNo wokUtils:EASY:NatCopy} } { global tcl_version if [file isdirectory $src] { - if { "$tcl_version" == "7.6" } { - file mkdir $dest - } else { - mkdir -path $dest - } + wokUtils:FILES:mkdir $dest foreach f [glob -nocomplain [file join $src *]] { wokUtils:FILES:NatCopy $f [file join $dest [file tail $f]] $verbose $YesOrNo } @@ -830,22 +899,16 @@ proc wokUtils:FILES:Encodable { file } { # remove a directory. One level. Very ugly procedure. Do not use. # Bricolage pour que ca marche sur NT. # -proc wokUtils:FILES:removedir { d } { +proc wokUtils:FILES:rmdir { d } { global env - global tcl_platform - if { "$tcl_platform(platform)" == "unix" } { - if { [file exists $d] } { - foreach f [wokUtils:EASY:readdir $d] { - unlink -nocomplain $d/$f - } - rmdir -nocomplain $d - } - } elseif { "$tcl_platform(platform)" == "windows" } { - if { [file exists $d] } { - foreach f [wokUtils:EASY:readdir $d] { - file delete $d/$f - } - file delete $d + global tcl_platform tcl_version + regsub -all {\.[^.]*} $tcl_version "" major + if { $major == 8 } { + file delete -force $d + } else { + if { "$tcl_platform(platform)" == "unix" } { + catch { exec rm -rf $d} + } else { } } @@ -856,7 +919,7 @@ proc wokUtils:FILES:removedir { d } { # proc wokUtils:FILES:tmpname { name } { global env - global tcl_platform + global tcl_platform tcl_version if { "$tcl_platform(platform)" == "unix" } { return [file join /tmp $name] } elseif { "$tcl_platform(platform)" == "windows" } { @@ -869,15 +932,24 @@ proc wokUtils:FILES:tmpname { name } { # proc wokUtils:FILES:Userid { file } { global env - global tcl_platform + global tcl_platform tcl_version + regsub -all {\.[^.]*} $tcl_version "" major if { "$tcl_platform(platform)" == "unix" } { - file stat $file myT - if ![ catch { id convert userid $myT(uid) } result ] { - return $result + if { $major == 8 } { + return [file attributes $file -owner] } else { - return unknown + if { "[info command id]" == "id" } { + file stat $file myT + if ![ catch { id convert userid $myT(uid) } result ] { + return $result + } else { + return unknown + } + } else { + return unknown + } } - } elseif { "$tcl_platform(platform)" == "windows" } { + } else { return unknown } } @@ -903,9 +975,9 @@ proc wokUtils:FILES:MoreDiff { } { # proc wokUtils:FILES:dirtmp { tmpnam } { if [file exist $tmpnam] { - wokUtils:FILES:removedir $tmpnam + wokUtils:FILES:rmdir $tmpnam } - mkdir $tmpnam + wokUtils:FILES:mkdir $tmpnam return } ;# @@ -923,7 +995,7 @@ proc wokUtils:FILES:recopy { dir dest {verbose 0} {FunCopy wokUtils:FILES:copy} set did [file join $dest $sd] if { ![file exists $did] } { if { $verbose } { puts stderr "Creating directory $did" } - mkdir -path $did + wokUtils:FILES:mkdir -path $did } else { if { $verbose } { puts stderr "Directory $did already exists. " } } @@ -2164,24 +2236,6 @@ proc wokUtils:WB:IsRoot { wb } { return [expr { ( [llength [w_info -A $wb]] > 1 ) ? 0 : 1 }] } ;# -;# Create directory. -;# -proc wokUtils:DIR:create { dir } { - global tcl_version - if { "$tcl_version" == "7.6" || "$tcl_version" == "8.0"} { - set command "file mkdir $dir" - } else { - set command "mkdir -path $dir" - } - catch { eval $command } status - if { "$status" == "" } { - return 1 - } else { - puts "$status" - return -1 - } -} -;# ;# lnames is a list of names, returns a map indexed with the lowered name and as value the original name ;# used to copy file from Windows to Unix system. ;# -- 2.39.5