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]
}
if [info exists dirtmp] {
foreach d $dirtmp {
- catch { wokUtils:FILES:removedir $d }
+ catch { wokUtils:FILES:rmdir $d }
}
}
return
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] {
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
}
# 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
}
#
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
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]
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
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]
puts [exec cat $dirtmp/checkout.cmd]
}
- unlink $chkout
+ wokUtils:FILES:delete $chkout
rmdir -nocomplain $dirtmp
return $statx
}
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]
}
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 { } {
}
}
if { $l == {} } {
- puts stderr "Error. No devunit for $tkloc"
+ ;#puts stderr "Warning. No devunit included in $tkloc"
}
return $l
}
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 {
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
}
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
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]
;# 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]
}
;#
;# 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
}
}
puts stderr "Error: $status"
}
if [file exists $adr] {
- catch {unlink $adr}
+ catch {wokUtils:FILES:delete $adr}
}
}
return
puts stderr "Error: $status"
}
if [file exists $adr] {
- catch {unlink $adr}
+ catch {wokUtils:FILES:delete $adr}
}
}
return
foreach u $lu {
puts -nonewline stderr "Decoding $u ..."
wokUtils:FILES:uudecode $u
- unlink $u
+ wokUtils:FILES:delete $u
puts stderr "Done"
}
return
puts stderr "Error: $errin"
}
if { $code != -1 } {
- unlink $name
+ wokUtils:FILES:delete $name
}
}
}
puts stderr "Error: $status"
}
if [file exists $adr] {
- catch {unlink $adr}
+ catch {wokUtils:FILES:delete $adr}
}
}
return
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 {
puts stderr "Error: $status"
}
if [file exists $adr] {
- catch {unlink $adr}
+ catch {wokUtils:FILES:delete $adr}
}
}
} else {
foreach u $lu {
puts -nonewline stderr "Decoding $u ..."
wokUtils:FILES:uudecode $u
- unlink $u
+ wokUtils:FILES:delete $u
puts stderr "Done"
}
return
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 {}
msgprint -c WOKVC -e "$file cannot be created ( $status )"
}
}
- catch {unlink $sfile}
+ catch {wokUtils:FILES:delete $sfile}
}
}
catch {
if [file exists $tmpdir] {
- unlink [glob -nocomplain $tmpdir/*]
+ wokUtils:FILES:delete [glob -nocomplain $tmpdir/*]
}
- unlink $tmpdir
+ wokUtils:FILES:delete $tmpdir
}
return
wokIntegre:Journal:Slice $jnltmp $n1 $n2 $command $userdata
}
}
- catch { unlink $jnltmp }
+ catch { wokUtils:FILES:delete $jnltmp }
}
return
}
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 {}
#;<
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
}
} 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 {}
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
}
}
}
+ bind $IWOK_WINDOWS($w,hlist) <Control-w> {
+ 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]
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
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] {
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] {
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)}
}
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
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)}
}
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.}
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"
}
}
wok_end_shell $format
- unlink $launched
+ wokUtils:FILES:delete $launched
return;
}
source $thefile
- unlink $thefile
+ wokUtils:FILES:delete $thefile
set thefile "/tmp/wokenv_[id process]_$format"
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} {
}
}
- unlink $thefile
+ wokUtils:FILES:delete $thefile
}
log_user 0;
# 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."
}
}
}
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
}
# 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 {
}
}
#
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" } {
#
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
}
}
#
proc wokUtils:FILES:dirtmp { tmpnam } {
if [file exist $tmpnam] {
- wokUtils:FILES:removedir $tmpnam
+ wokUtils:FILES:rmdir $tmpnam
}
- mkdir $tmpnam
+ wokUtils:FILES:mkdir $tmpnam
return
}
;#
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. " }
}
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.
;#
projects / occt-wok.git / commitdiff