From: kernel Date: Wed, 9 Sep 1998 18:22:16 +0000 (+0000) Subject: Initial revision X-Git-Tag: V6_7_1~344 X-Git-Url: http://git.dev.opencascade.org/gitweb/?a=commitdiff_plain;h=d76381e95f99fcc8711d527d98796d0ce0125172;p=occt-wok.git Initial revision --- diff --git a/src/WOKTclLib/BrowserOMT.tcl b/src/WOKTclLib/BrowserOMT.tcl new file mode 100755 index 0000000..d7ec908 --- /dev/null +++ b/src/WOKTclLib/BrowserOMT.tcl @@ -0,0 +1,752 @@ +proc BrowserOMTDestroyWin {win} { + global Browser_Menu Browser_packinfo BrowserOMT_clarray BrowserOMT_maxy + + set swin [$win.swin subwidget window] + $swin.can delete all + destroy $win + $Browser_Menu.windows.options delete $Browser_packinfo(womt) +} + +# display a graph from class in a +# toplevel window named $win.womt +# +# win : a window +# classe : a class full name +# +proc BrowserOMTInitWindow {win classe disp} { + global Browser_Menu Browser_packinfo BrowserOMT_clarray BrowserOMT_maxy + + if {$classe != "this"} { + set BrowserOMT_clarray(root) $classe + } else { + set classe $BrowserOMT_clarray(root) + } + + if {[winfo exist $win.womt] == 0} { + toplevel $win.womt + $Browser_Menu.windows.options add command -label "Graphic" -command "raise $win.womt" + set Browser_packinfo(womt) [$Browser_Menu.windows.options index last] + wm title $win.womt "Graph" + wm geometry $win.womt 600x600+100+100 + + tixScrolledWindow $win.womt.swin + + button $win.womt.menubar -state disabled -relief raise + menubutton $win.womt.menubar.menu1 -menu $win.womt.menubar.menu1.options -text "File" + menu $win.womt.menubar.menu1.options + $win.womt.menubar.menu1.options add command -label "PostScript" -command "BrowserOMTPostScript $win.womt" + $win.womt.menubar.menu1.options add command -label "Close" -command "BrowserOMTDestroyWin $win.womt" + + tixForm $win.womt.menubar -top 2 -left 0 -right -0 + tixForm $win.womt.menubar.menu1 -left 0 -top 0 + tixForm $win.womt.swin -left 0 -top $win.womt.menubar -right -0 -bottom -0 + + set swin [$win.womt.swin subwidget window] + canvas $swin.can + pack $swin.can + } + + set swin [$win.womt.swin subwidget window] + $swin.can delete all + + wm title $win.womt "Graph : $classe" + + set BrowserOMT_maxy {} + lappend BrowserOMT_maxy 5.0 + lappend BrowserOMT_maxy 5.0 + $swin.can configure -width 100.0 -height 100.0 + BrowserOMTDrawBox $swin.can $classe [lindex $BrowserOMT_maxy 0] [lindex $BrowserOMT_maxy 1] $classe + BrowserOMTSetupCanva $swin.can + + BrowserOMTInitScrollBar $win.womt.swin + + unset BrowserOMT_clarray + unset BrowserOMT_maxy + set BrowserOMT_clarray(root) $classe +} + +proc BrowserOMTSetupCanva {c} { + global BrowserOMT_maxy + + set mx [expr {[lindex $BrowserOMT_maxy 0] + 10.0}] + set my [lindex $BrowserOMT_maxy 1] + + if {$mx > $my} { + set r [expr {$my / $mx}] + + if {$r < 0.65} { + set my [expr {$mx * 0.65}] + } + } elseif {$my > $mx} { + set r [expr {$mx / $my}] + + if {$r < 0.65} { + set mx [expr {$my * 0.65}] + } + } + $c configure -height $my -width $mx +# puts "$mx $my" +} + +proc BrowserOMTPostScript {win} { + global BrowserOMT_printer BrowserOMT_printerok BrowserOMT_printerrotate + + set BrowserOMT_printerrotate 0 + + toplevel $win.printer + label $win.printer.label -text "Printer name :" + entry $win.printer.entry -width 20 -relief sunken -bd 2 -textvariable BrowserOMT_printer + button $win.printer.ok -text "Ok" + button $win.printer.cancel -text "Cancel" + checkbutton $win.printer.rotate -text "Rotate" -variable BrowserOMT_printerrotate + tixForm $win.printer.label -top 4 -left 4 + tixForm $win.printer.entry -top 4 -left $win.printer.label -right -4 + tixForm $win.printer.rotate -top $win.printer.entry -left $win.printer.ok -right $win.printer.cancel + tixForm $win.printer.ok -top $win.printer.entry -bottom -0 -left 0 + tixForm $win.printer.cancel -top $win.printer.entry -bottom -0 -right -0 + + set BrowserOMT_printerok -1 + + bind $win.printer.entry { + focus -force [winfo toplevel %W].ok + } + bind $win.printer.ok { + set BrowserOMT_printerok 1 + } + bind $win.printer.ok { + set BrowserOMT_printerok 1 + } + bind $win.printer.cancel { + set BrowserOMT_printerok 0 + } + tixBusy $win on + tkwait variable BrowserOMT_printerok + tixBusy $win off + + if {$BrowserOMT_printerok == 1} { + set swin [$win.swin subwidget window] + $swin.can postscript -file "/tmp/can.ps" -rotate $BrowserOMT_printerrotate -pageheight 28.5c -pagewidth 18.5c + catch {exec lpr -P$BrowserOMT_printer /tmp/can.ps} + } + + destroy $win.printer +} + +proc BrowserOMTToggleArrow {win type} { + set swin [$win.swin subwidget window] + + if {$type == "I"} { + set color [$swin.can itemcget I -fill] + + if {$color == ""} { + $swin.can itemconfigure I -fill grey40 + } else { + $swin.can itemconfigure I -fill "" + } + } else { + set color [$swin.can itemcget C -fill] + + if {$color == ""} { + $swin.can itemconfigure C -fill black + } else { + $swin.can itemconfigure C -fill "" + } + } +} + +proc BrowserOMTGetMax {lmax l} { + set res {} + + if {[lindex $lmax 0] < [lindex $l 0]} { + lappend res [lindex $l 0] + } else { + lappend res [lindex $lmax 0] + } + + if {[lindex $lmax 1] < [lindex $l 1]} { + lappend res [lindex $l 1] + } else { + lappend res [lindex $lmax 1] + } + + return $res +} + +proc BrowserOMTDrawBox {where classe x y tag} { + global BrowserOMT_clarray BrowserOMT_maxy + + set error [catch {msclinfo -t $classe}] + + if {$error != 0} return + + set incomplete [msclinfo -e $classe] + + if {[info exist BrowserOMT_clarray($tag)]} return + + set fnt "-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1" + set x1 $x + set y1 $y + set x2 $x + set y2 $y + set inherits {} + set hasinh 0 + set backcolor "yellow" + set thisbackcolor "yellow" + + if {$incomplete == 0} { + if {$BrowserOMT_clarray(root) == $classe} { + set inherits [msclinfo -i $classe] + set hasinh [llength $inherits] + } + set backcolor "black" + set thisbackcolor "black" + } + + if {$hasinh} { + set l {} + lappend l $x + lappend l $y + set BrowserOMT_maxy [BrowserOMTGetMax $BrowserOMT_maxy $l] + BrowserOMTSetupCanva $where + + set p [lindex $inherits 0] + set rwidth [BrowserOMTDrawClass $where $p $x $y $p 0] + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + set xinh [expr {([lindex $BrowserOMT_clarray($p) 2] + [lindex $BrowserOMT_clarray($p) 0]) / 2.0}] + set yinh [lindex $BrowserOMT_clarray($p) 3] + } + + if {![info exist BrowserOMT_clarray($tag)]} { + set thisclass 0 + + if {$BrowserOMT_clarray(root) == $classe} { + set thisclass 1 + } + set rwidth [BrowserOMTDrawClass $where $classe $x1 [expr {$y2 + 40}] $tag $thisclass] + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + set l {} + lappend l [expr {$x2 - 10.0}] + lappend l [expr {$y2 + 40.0}] + set BrowserOMT_maxy [BrowserOMTGetMax $BrowserOMT_maxy $l] + BrowserOMTSetupCanva $where + + if {$hasinh} { + set xinh [expr {$xinh - 10.0}] + set xout [expr {($x1 + $x2) / 2.0 - 10.0}] + set yout $y1 + set xmid $xout + set ymid [expr {$yinh + 20.0}] + $where create line $xout $yout $xmid $ymid $xinh $ymid $xinh $yinh -arrow last -fill black -tags I -joinstyle round -width 0.1c + } + + # + # RETURN if the class is incomplete + # + if {$incomplete != 0} { + return + } + + if {$BrowserOMT_clarray(root) == $classe} { + set typeClass [msclinfo -t $classe] + + foreach p [msclinfo -C $classe] { + set name [lindex $p 0] + set error [catch {msclinfo -t $name}] + + if {$error == 0} { + if {$name != $classe} { + set rwidth [BrowserOMTDrawBox $where $name $x2 [lindex $BrowserOMT_maxy 1] $name] + lappend l [lindex $rwidth 2] + lappend l [lindex $rwidth 3] + set BrowserOMT_maxy [BrowserOMTGetMax $BrowserOMT_maxy $l] + BrowserOMTSetupCanva $where + + set error [catch {msclinfo -t $name}] + + if {$error == 0} { + set xout [expr {($x1 + $x2) / 2.0}] + set yin [expr {([lindex $BrowserOMT_clarray($name) 3] + [lindex $BrowserOMT_clarray($name) 1]) / 2.0}] + if {$yin < $y2} { + set yout $y1 + } else { + set yout $y2 + } + if {$xout > [lindex $BrowserOMT_clarray($name) 0]} { + set xin [lindex $BrowserOMT_clarray($name) 2] + } else { + set xin [lindex $BrowserOMT_clarray($name) 0] + } + set xmid $xout + set ymid $yin + $where create line $xout $yout $xmid $ymid $xin $yin -tags C -width 0.1c + $where create oval [expr {$xout - 5}] $yout [expr {$xout + 5}] [expr {$yout + 10}] -outline $thisbackcolor -fill black + if {[msclinfo -e $name] == 0} { + if {[msclinfo -P $name] || [msclinfo -T $name]} { + $where create rectangle [expr {$xin - 10}] [expr {$yin -5}] [expr {$xin}] [expr {$yin + 5}] -outline $thisbackcolor -fill white + } else { + $where create rectangle [expr {$xin - 10}] [expr {$yin -5}] [expr {$xin}] [expr {$yin + 5}] -outline $thisbackcolor -fill black + } + } + } + } else { + $where create line $x1 $y1 $x1 [expr {$y1 - 15.0}] [expr {$x1 + 15.0}] [expr {$y1 - 15.0}] [expr {$x1 + 15.0}] $y1 -tags C -width 0.1c + $where create oval $x1 $y1 [expr {$x1 + 10}] [expr {$y1 + 10}] -outline $thisbackcolor -fill black + } + } + } + set usex [expr {[lindex $BrowserOMT_maxy 0] + 70}] + set usey $y + set genclass "" + if {$typeClass == "instclass"} { + set genclass [msinstinfo -g $classe] + } + foreach p [msclinfo -u $classe] { + set error [catch {msclinfo -t $p}] + + if {$error == 0 && ($genclass != $p)} { + + if {$p != $classe} { + if {[info exist BrowserOMT_clarray($p)] == 0} { + set usey [expr {$usey + 50}] + set rwidth [BrowserOMTDrawClass $where $p $usex $usey $p 0] + set usey [lindex $rwidth 3] + set l {} + lappend l [lindex $rwidth 2] + lappend l [lindex $rwidth 3] + set BrowserOMT_maxy [BrowserOMTGetMax $BrowserOMT_maxy $l] + BrowserOMTSetupCanva $where + + set error [catch {msclinfo -t $p}] + + if {$error == 0} { + set xout $x2 + set yout [expr {($y1 + $y2) / 2.0}] + set yin [expr {([lindex $BrowserOMT_clarray($p) 3] + [lindex $BrowserOMT_clarray($p) 1]) / 2.0}] + set xin [lindex $BrowserOMT_clarray($p) 0] + set xmid [expr {$usex - 30}] + + set ymid $yout + set xmid1 $xmid + set ymid1 $yin + $where create line $xout $yout $xmid $ymid $xmid1 $ymid1 $xin $yin -tags C -width 0.1c -fill black + $where create oval $xout [expr {$yout - 5}] [expr {$xout + 10}] [expr {$yout + 5}] -outline $thisbackcolor -fill white + } + } + } + } + } + } + } +} + + +proc BrowserOMTInitScrollBar {w} { + set hsb [$w subwidget hsb] + set vsb [$w subwidget vsb] + set hcmd [lindex [$hsb configure -command] 4] + set vcmd [lindex [$vsb configure -command] 4] + eval $hcmd moveto 0 + eval $vcmd moveto 0 + return +} + +proc BrowserOMTDrawStandardClass {where classe x y tag istheclass} { + global BrowserOMT_clarray BrowserOMT_maxy + + set incomplete [msclinfo -e $classe] + set txt "" + set fnt "-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1" + set inherits {} + set hasinh 0 + set backcolor "yellow" + set thisbackcolor "yellow" + set nestedclass "" + + if {$incomplete == 0} { + set backcolor "black" + set thisbackcolor "black" + if {[msclinfo -n $classe]} { + set nestedclass [msclinfo -N $classe] + set nestedclass "($nestedclass) " + } + } + + if {$BrowserOMT_clarray(root) == $classe} { + set txt "< $classe $nestedclass>\n\n" + } else { + set txt "$classe $nestedclass\n\n" + } + + if {$incomplete == 0} { + if {$istheclass} { + set len [expr {[string length $classe] + 2}] + foreach p [msclinfo -m $classe] { + set mth [string range $p $len [string length $p]] + set txt "$txt $mth\n" + } + set txt "$txt\n" + } + } + + $where create text $x $y -text $txt -anchor nw -tags grotas -font $fnt -justify left + set rwidth [$where bbox grotas] + set BrowserOMT_clarray($tag) $rwidth + $where delete grotas + + set linex2 [lindex $rwidth 2] + set liney2 [lindex $rwidth 3] + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + + if {$incomplete == 0} { + if {$istheclass} { + set len [expr {[string length $classe] + 2}] + set txt "$txt\n" + foreach p [msclinfo -C $classe] { + set txt "$txt $p\n" + } + set txt "$txt\n" + } + $where create text $x $y -text $txt -anchor nw -tags grotas -font $fnt -justify left + set rwidth [$where bbox grotas] + set BrowserOMT_clarray($tag) $rwidth + $where delete grotas + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + } + + $where delete $tag + + if {$BrowserOMT_clarray(root) == $classe} { + $where create rectangle $x1 $y1 $x2 $y2 -outline $thisbackcolor -fill white + $where create rectangle $x1 $y1 $x2 [expr {$y1+20.0}] -outline $thisbackcolor -fill grey + $where create line $x1 $liney2 $linex2 $liney2 -fill black + } else { + $where create rectangle $x1 $y1 $x2 $y2 -outline $backcolor -fill white + $where create rectangle $x1 $y1 $x2 [expr {$y1+20.0}] -outline $backcolor -fill grey + } + + set tagtext [$where create text $x1 [expr {$y1 + 5.0}] -text $txt -anchor nw -tags $tag -font $fnt -justify left] + + $where bind $tagtext { + global Browser_win + set t [%W find withtag current] + + if {$t != ""} { + set name [lindex [%W gettags $t] 0] + BrowserOMTInitWindow $Browser_win $name 0 + } + } + + $where bind $tagtext { + %W itemconfigure current -fill red + } + + $where bind $tagtext { + %W itemconfigure current -fill black + } + + set posx [expr {$x1 + 10}] + set posy [expr {$y2 - 10}] + BrowserOMTAddStuff $where $classe $posx $posy $tag + + return $rwidth +} + +proc BrowserOMTDrawGenericClass {where classe x y tag istheclass} { + global BrowserOMT_clarray BrowserOMT_maxy + + set incomplete [msclinfo -e $classe] + set txt "" + set fnt "-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1" + set inherits {} + set hasinh 0 + set backcolor "yellow" + set thisbackcolor "yellow" + set nestedclass "" + + if {$incomplete == 0} { + set backcolor "black" + set thisbackcolor "black" + if {[msclinfo -n $classe]} { + set nestedclass [msclinfo -N $classe] + set nestedclass "($nestedclass) " + } + } + + if {$BrowserOMT_clarray(root) == $classe} { + set txt "< $classe $nestedclass> : Generic\n\n" + } else { + set txt "$classe $nestedclass: Generic\n\n" + } + + if {$incomplete == 0} { + set genType [msgeninfo -g $classe] + set len [llength $genType] + set txt "$txt <" + for {set i 0} {$i < $len} {incr i} { + if {$i != 0} { + set txt "$txt,[lindex $genType $i]" + } else { + set txt "$txt [lindex $genType $i]" + } + } + set txt "$txt >\n\n" + + if {$istheclass} { + set len [expr {[string length $classe] + 2}] + foreach p [msclinfo -m $classe] { + set mth [string range $p $len [string length $p]] + set txt "$txt $mth\n" + } + set txt "$txt\n" + } + } + + $where create text $x $y -text $txt -anchor nw -tags grotas -font $fnt -justify left + set rwidth [$where bbox grotas] + set BrowserOMT_clarray($tag) $rwidth + $where delete grotas + + set linex2 [lindex $rwidth 2] + set liney2 [lindex $rwidth 3] + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + + if {$incomplete == 0} { + if {$istheclass} { + set len [expr {[string length $classe] + 2}] + set txt "$txt\n" + foreach p [msclinfo -C $classe] { + set txt "$txt $p\n" + } + set txt "$txt\n" + } + $where create text $x $y -text $txt -anchor nw -tags grotas -font $fnt -justify left + set rwidth [$where bbox grotas] + set BrowserOMT_clarray($tag) $rwidth + $where delete grotas + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + } + + $where delete $tag + + if {$BrowserOMT_clarray(root) == $classe} { + $where create rectangle $x1 $y1 $x2 $y2 -outline $thisbackcolor -fill white + $where create rectangle $x1 $y1 $x2 [expr {$y1+20.0}] -outline $thisbackcolor -fill grey + $where create line $x1 $liney2 $linex2 $liney2 -fill black + } else { + $where create rectangle $x1 $y1 $x2 $y2 -outline $backcolor -fill white + $where create rectangle $x1 $y1 $x2 [expr {$y1+20.0}] -outline $backcolor -fill grey + } + + set tagtext [$where create text $x1 [expr {$y1 + 5.0}] -text $txt -anchor nw -tags $tag -font $fnt -justify left] + + $where bind $tagtext { + global Browser_win + set t [%W find withtag current] + + if {$t != ""} { + set name [lindex [%W gettags $t] 0] + BrowserOMTInitWindow $Browser_win $name 0 + } + } + + $where bind $tagtext { + %W itemconfigure current -fill red + } + + $where bind $tagtext { + %W itemconfigure current -fill black + } + + set posx [expr {$x1 + 10}] + set posy [expr {$y2 - 10}] + BrowserOMTAddStuff $where $classe $posx $posy $tag + + return $rwidth +} + +proc BrowserOMTDrawInstClass {where classe x y tag istheclass} { + global BrowserOMT_clarray BrowserOMT_maxy + + set incomplete [msclinfo -e $classe] + set txt "" + set fnt "-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1" + set inherits {} + set hasinh 0 + set backcolor "yellow" + set thisbackcolor "yellow" + set nestedclass "" + + if {$incomplete == 0} { + set backcolor "black" + set thisbackcolor "black" + if {[msclinfo -n $classe]} { + set nestedclass [msclinfo -N $classe] + set nestedclass "($nestedclass) " + } + } + + set genclass [msinstinfo -g $classe] + if {$BrowserOMT_clarray(root) == $classe} { + set txt "< $classe $nestedclass> : Instantiates\n\n" + } else { + set txt "$classe $nestedclass: Instantiates\n\n" + } + + if {$incomplete == 0} { + set genType [msgeninfo -g $genclass] + set instType [msinstinfo -s $classe] + set len [llength $genType] + + set txt "$txt $genclass <" + for {set i 0} {$i < $len} {incr i} { + if {$i != 0} { + set txt "$txt,[lindex $instType $i]" + } else { + set txt "$txt [lindex $instType $i]" + } + } + set txt "$txt >\n\n" + + if {$istheclass} { + set len [expr {[string length $classe] + 2}] + foreach p [msclinfo -m $classe] { + set mth [string range $p $len [string length $p]] + set txt "$txt $mth\n" + } + set txt "$txt\n" + } + } + + $where create text $x $y -text $txt -anchor nw -tags grotas -font $fnt -justify left + set rwidth [$where bbox grotas] + set BrowserOMT_clarray($tag) $rwidth + $where delete grotas + + set linex2 [lindex $rwidth 2] + set liney2 [lindex $rwidth 3] + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + + if {$incomplete == 0} { + if {$istheclass} { + set len [expr {[string length $classe] + 2}] + set txt "$txt\n" + foreach p [msclinfo -C $classe] { + set txt "$txt $p\n" + } + set txt "$txt\n" + } + $where create text $x $y -text $txt -anchor nw -tags grotas -font $fnt -justify left + set rwidth [$where bbox grotas] + set BrowserOMT_clarray($tag) $rwidth + $where delete grotas + set x1 [lindex $rwidth 0] + set y1 [lindex $rwidth 1] + set x2 [lindex $rwidth 2] + set y2 [lindex $rwidth 3] + } + + $where delete $tag + + if {$BrowserOMT_clarray(root) == $classe} { + $where create rectangle $x1 $y1 $x2 $y2 -outline $thisbackcolor -fill white + $where create rectangle $x1 $y1 $x2 [expr {$y1+20.0}] -outline $thisbackcolor -fill grey + $where create line $x1 $liney2 $linex2 $liney2 -fill black + } else { + $where create rectangle $x1 $y1 $x2 $y2 -outline $backcolor -fill white + $where create rectangle $x1 $y1 $x2 [expr {$y1+20.0}] -outline $backcolor -fill grey + } + + set tagtext [$where create text $x1 [expr {$y1 + 5.0}] -text $txt -anchor nw -tags $tag -font $fnt -justify left] + + $where bind $tagtext { + global Browser_win + set t [%W find withtag current] + + if {$t != ""} { + set name [lindex [%W gettags $t] 0] + BrowserOMTInitWindow $Browser_win $name 0 + } + } + + $where bind $tagtext { + %W itemconfigure current -fill red + } + + $where bind $tagtext { + %W itemconfigure current -fill black + } + set posx [expr {$x1 + 10}] + set posy [expr {$y2 - 10}] + BrowserOMTAddStuff $where $classe $posx $posy $tag + + return $rwidth +} + +proc BrowserOMTAddStuff {where classe x y tag} { + set posx $x + set posy $y + + if {[msclinfo -p $classe]} { + set btm [tix getimage private] + $where create image $posx $posy -image $btm -tags $tag + set posx [expr {$posx + 16}] + } + + if {[msclinfo -d $classe]} { + set btm [tix getimage abstract] + $where create image $posx $posy -image $btm -tags $tag + set posx [expr {$posx + 16}] + } + + if {[msclinfo -P $classe]} { + set btm [tix getimage persistent] + $where create image $posx $posy -image $btm -tags $tag + set posx [expr {$posx + 16}] + } elseif {[msclinfo -S $classe]} { + set btm [tix getimage storable] + $where create image $posx $posy -image $btm -tags $tag + set posx [expr {$posx + 16}] + } elseif {[msclinfo -T $classe]} { + set btm [tix getimage transient] + $where create image $posx $posy -image $btm -tags $tag + set posx [expr {$posx + 16}] + } +} + +proc BrowserOMTDrawClass {where classe x y tag istheclass} { + set Classtype [msclinfo -t $classe] + set rwidth {} + + if {$Classtype == "stdclass"} { + set rwidth [BrowserOMTDrawStandardClass $where $classe $x $y $tag $istheclass] + } elseif {$Classtype == "genclass"} { + set rwidth [BrowserOMTDrawGenericClass $where $classe $x $y $tag $istheclass] + } elseif {$Classtype == "instclass"} { + set rwidth [BrowserOMTDrawInstClass $where $classe $x $y $tag $istheclass] + } else { + puts "Unknown type $Classtype for $classe" + } + + return $rwidth +} diff --git a/src/WOKTclLib/MatraDatavision.xpm b/src/WOKTclLib/MatraDatavision.xpm new file mode 100755 index 0000000..4834785 --- /dev/null +++ b/src/WOKTclLib/MatraDatavision.xpm @@ -0,0 +1,53 @@ +/* XPM */ +static char *MatraDatavision[] = { +/* width height num_colors chars_per_pixel */ +" 110 40 6 1", +/* colors */ +". c #ffffff", +"# c #000000", +"a c #999999", +"b c #c7c7c7", +"c c #0000ff", +"d c #20b2aa", +/* pixels */ +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc.c.c..dcccccccccccc", +"cccc.ccccccccccc.ccccccccc.ccccccc.............ccc.......dccccccccccccc.cccccccccccccccccd.c.c..c..dcccccccccc", +"cccc..ccccccccc..ccccccccd.dcccccc.............ccc........dcccccccccccd.dcccccccccccccccd.c.c..c..c.dccccccccc", +"cccc...ccccccc...cccccccc...cccccc.............ccc...cc....ccccccccccc...ccccccccccccccd.c.c..c..c..ddcccccccc", +"cccc....ccccc....cccccccd...dcccccccccc...cccccccc...ccd...ccccccccccd...dccccccccccccd.cccd.c..c..c..cccccccc", +"cccc.....ccc.....ccccccc.....cccccccccc...cccccccc...cccd..cccccccccc.....cccccccccccd.c.ccccd.c..c...dccccccc", +"cccc......c......ccccccc.....cccccccccc...cccccccc...ccd...cccccccccc.....ccccccccccc.c.c.cccccd.c....cccccccc", +"cccc.............ccccccd.....dccccccccc...cccccccc...cc...dcccccccccd.....dcccccccccdc.c...dccccccd..c.ccccccc", +"cccc...c.....c...cccccc...d...ccccccccc...cccccccc........cccccccccc...d...cccccccccc.c..c..dcccccccc..ccccccc", +"cccc...cc...cc...cccccd...c...dcccccccc...cccccccc......dccccccccccd...d...dccccccccdc..c..dccccccccd..ccccccc", +"cccc...ccc.ccc...ccccc...dcd...cccccccc...cccccccc......ccccccccccc...dcd...ccccccccc..c..ccccccc.c....ccccccc", +"cccc...ccccccc...ccccc...ccc...cccccccc...cccccccc...d...cccccccccc...ccc...ccccccccc.c..cccccd..c.....ccccccc", +"cccc...ccccccc...ccccd.........dccccccc...cccccccc...cd..dccccccccd.........dccccccccc..cccd....c.....dccccccc", +"cccc...ccccccc...cccc...........ccccccc...cccccccc...cc...dccccccc...........ccccccccc.c..c....c......cccccccc", +"cccc...ccccccc...cccd...ccccc...dcccccc...cccccccc...ccd...ccccccd...dcccd...dccccccccc..c....c......dcccccccc", +"cccc...ccccccc...ccc...dcccccd...cccccc...cccccccc...cccd...ccccc...dcccccd...ccccccccccd....c......dccccccccc", +"cccc...ccccccc...ccc...ccccccc...cccccc...cccccccc...cccc....cccc...ccccccc...ccccccccccc...c......dcccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccd.....dcccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc", +"..............................................................................................................", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb####bbbbbbb#bbbb#####bbbb#bbbb#bbbbb#bb#bbb###bbb#bbb####bbb##bbb#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb#bbb#bbbbba#abbbbb#bbbbba#abbb#bbbbb#bb#bb#bbb#bb#bb#bbbb#bb#aabb#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb#bbbb#bbbb#b#bbbbb#bbbbb#b#bbbaabbbaabb#bb#bbbbbb#bb#bbbb#bb#b#bb#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb#bbbb#bbbaabaabbbb#bbbbaabaabbb#bbb#bbb#bbb###bbb#bb#bbbb#bb#baab#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb#bbbb#bbb#bbb#bbbb#bbbb#bbb#bbb#bbb#bbb#bbbbbb#bb#bb#bbbb#bb#bb#b#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb#bbbb#bba#####abbb#bbba#####abbaabaabbb#bbbbbb#bb#bb#bbbb#bb#bb#b#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb#bbb#bbb#bbbbb#bbb#bbb#bbbbb#bbb#b#bbbb#bb#bbb#bb#bb#bbbb#bb#bbaa#bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbb####bbbb#bbbbb#bbb#bbb#bbbbb#bbbb#bbbbb#bbb###bbb#bbb####bbb#bbb##bbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +}; diff --git a/src/WOKTclLib/MkBuild.tcl b/src/WOKTclLib/MkBuild.tcl new file mode 100755 index 0000000..bfd48b2 --- /dev/null +++ b/src/WOKTclLib/MkBuild.tcl @@ -0,0 +1,1521 @@ +proc wokBuild { {fast 0} } { + + global IWOK_WINDOWS + global IWOK_GLOBALS + set w $IWOK_GLOBALS(toplevel) + set top [frame $w.thu -bd 1 -relief raised] + + # Paned Window + # + set p [tixPanedWindow $top.p -orient horizontal] + pack $p -expand yes -fill both -padx 4 -pady 4 + + set p1 [$p add pane1 -expand 1] ; $p1 config -relief flat ; set IWOK_GLOBALS(tree,name) $p1 + set p2 [$p add pane2 -expand 4] ; $p2 config -relief flat ; set IWOK_GLOBALS(canvas,name) $p2 + + # Tree + # + set tree [tixTree $p1.tree -options {hlist.separator "^" hlist.selectMode single }] + + $tree config -opencmd [list wokNAV:Tree:Open $w] -browsecmd [list wokNAV:Tree:Browse $w] + + # ScrolledWindow + # + set scr [tixScrolledWindow $p2.st] + + pack $p1.tree -expand yes -fill both -padx 4 -pady 4 + pack $p2.st -expand yes -fill both -padx 4 -pady 4 + + set IWOK_WINDOWS($w,NAV,tree) $tree + set IWOK_WINDOWS($w,NAV,hlist) [$tree subwidget hlist] + set IWOK_WINDOWS($w,NAV,scrolled) $scr + set IWOK_WINDOWS($w,NAV,window) [$p2.st subwidget window] + + set IWOK_GLOBALS(canvas) [canvas $IWOK_WINDOWS($w,NAV,window).c] + $IWOK_GLOBALS(canvas) configure -width $IWOK_GLOBALS(canvas,width) -height $IWOK_GLOBALS(canvas,height) + + wokButton initialize + + button $w.mnu -state disabled -relief raised + menubutton $w.mnu.fil -menu $w.mnu.fil.menu0 -text "File" + menu $w.mnu.fil.menu0 + $w.mnu.fil.menu0 add command -label "Exit" -command wokKillAll + + menubutton $w.mnu.but -menu $w.mnu.but.menu1 -text "Windows" + $w.mnu.but configure -state disabled + menu $w.mnu.but.menu1 + $w.mnu.but.menu1 add command -label "Hide all" -command wokHideAll + $w.mnu.but.menu1 add command -label "Show all" -command wokShowAll + $w.mnu.but.menu1 add separator + + menubutton $w.mnu.hlp -menu $w.mnu.hlp.menu -text "Help" + menu $w.mnu.hlp.menu + $w.mnu.hlp.menu add command -label "Help" -command [list wokMainHelp $w] + + tixForm $w.mnu -left 0 -right -0 -top 0 + tixForm $w.mnu.fil -left 0 -top 0 + tixForm $w.mnu.but -left $w.mnu.fil + tixForm $w.mnu.hlp -right -0 -top 0 + + set lastbut [wokButton create $w] + wokButton balloon + + set dis [wokDSP:Init $w] + set mov [wokMOV:Init $w] + + tixComboBox $w.l \ + -variable IWOK_GLOBALS(CWD) \ + -command wokSetLoc -label "Contents of:" \ + -editable true -labelside left \ + -history 1 -prunehistory 1 -histlimit 20 + set IWOK_GLOBALS(label) $w.l + [set IWOK_GLOBALS(label,entry) [$IWOK_GLOBALS(label) subwidget entry]] configure -relief sunken + + set arr [$w.l subwidget arrow] ; tixBalloon $arr.bal ; $arr.bal bind $arr -msg "Last spots" + + button $w.mdtv -image [tix getimage MatraDatavision] -command wokSeeLayout + tixBalloon $w.mdtv.bal + $w.mdtv.bal bind $w.mdtv -msg "See Layout" + + tixForm $dis -left $lastbut -bottom $top -top $w.mnu + + tixForm $mov -left $dis -bottom $top -top $w.mnu + + tixForm $IWOK_GLOBALS(label) -left $mov -bottom $top -top $w.mnu -right $w.mdtv + tixForm $w.mdtv -right -0 -bottom $top -top $w.mnu + tixForm $top -top $lastbut -left 0 -right -0 -bottom -0 + + set poph [wokPOP:hlist create $w] ; wokPOP:hlist initialize ; $poph bind $IWOK_WINDOWS($w,NAV,hlist) + set popc [wokPOP:canvas create $w] ; wokPOP:canvas initialize ; $popc bind $IWOK_GLOBALS(canvas) + ;# + ;# Go from current location. + + wokNAV:Tree:UpdateSession $IWOK_GLOBALS(toplevel) [id user] + if { $fast == 0 } { + tixBusy $IWOK_GLOBALS(toplevel) on + update + wokMOV:Alonzi $IWOK_GLOBALS(toplevel) [wokcd] + wokMOV:wokcd + tixBusy $IWOK_GLOBALS(toplevel) off + } else { + wokButton session + } + + wokCWD disable + + $IWOK_GLOBALS(canvas) bind current { + wokNAV:Tree:Focus [winfo toplevel %W] [lindex [%W gettags current] 0] + } + + $IWOK_GLOBALS(canvas) bind current { + eval "proc wokPOP:canvas:GetInfo { } { return \"[%W gettags current]\" }" + } + +} + + +proc wokSetTypeDisplayed { str } { + global IWOK_GLOBALS + set IWOK_GLOBALS(canvas,TypeDisplayed) $str + return +} + +proc wokGetTypeDisplayed { } { + global IWOK_GLOBALS + if [info exists IWOK_GLOBALS(canvas,TypeDisplayed)] { + return $IWOK_GLOBALS(canvas,TypeDisplayed) + } else { + return {} + } +} + +proc wokSeeLayout { } { + global IWOK_GLOBALS + if { $IWOK_GLOBALS(layout) == 0 } { + set IWOK_GLOBALS(layout) 1 + if { $IWOK_GLOBALS(layout,update) == 1 } { + wokUpdateLayout $IWOK_GLOBALS(CWD) + set IWOK_GLOBALS(layout,update) 0 + } + wm geometry $IWOK_GLOBALS(toplevel) $IWOK_GLOBALS(toplevel,opened) + raise $IWOK_GLOBALS(toplevel) + } else { + set IWOK_GLOBALS(layout) 0 + wm geometry $IWOK_GLOBALS(toplevel) $IWOK_GLOBALS(toplevel,closed) + } + return +} + +proc wokSetLoc { loc } { + global IWOK_GLOBALS + tixBusy $IWOK_GLOBALS(toplevel) on + wokCWD updatehistory $loc + if { $IWOK_GLOBALS(layout) == 1 } { + set IWOK_GLOBALS(layout,update) 0 + wokUpdateLayout $loc + } else { + set IWOK_GLOBALS(layout,update) 1 + wokButton [wokNAV:tlist:Type $IWOK_GLOBALS(toplevel) $loc] + } + tixBusy $IWOK_GLOBALS(toplevel) off + return +} + +proc wokUpdateLayout { loc } { + global IWOK_GLOBALS + set w $IWOK_GLOBALS(toplevel) + wokNAV:Tree:Show $w [wokNAV:tlist:Get $IWOK_GLOBALS(toplevel) $loc] + set type [wokNAV:tlist:Type $w $loc] + wokUpdateCanvas $w $loc + wokButton $type + raise $IWOK_GLOBALS(toplevel) + return +} +# +# Retourne la liste des elements affiches dans le canvas. +# +proc wokListLayout { {option location} } { + global IWOK_GLOBALS + set canv $IWOK_GLOBALS(canvas) + set ll {} + foreach i [$canv find all] { + set x [$canv gettags $i] + if { "$option" == "location" } { + if { [lsearch $ll [lindex $x 1]] == -1 } { + lappend ll [lindex $x 1] + } + } elseif { "$option" == "anchor" } { + if { [lsearch $ll [lindex $x 0]] == -1 } { + lappend ll [lindex $x 0] + } + } elseif { "$option" == "type" } { + if { [lsearch $ll [lindex $x 2]] == -1 } { + lappend ll [lindex $x 2] + } + } elseif { "$option" == "names" } { + if { [lsearch $ll [lindex $x 3]] == -1 } { + lappend ll [lindex $x 3] + } + } + } + return $ll +} +;# +;# Configure/cree les boutons +;# +;# Pour savoir si la fenetre browser est la: +;# set val [wokButton getw browser] +;# if $val != {} { val = list des toplevels allumes par le bouton } +;# Pour avoir la liste des toplevels allumes par les boutons: +;# set lst [wokButton listw] +;# Pour remettre a zero l'etat du bouton browser: +;# wokButton resetw browser +;# +proc wokButton { option {w nil} } { + global IWOK_GLOBALS + + 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}] + } + + create { + set blist $IWOK_GLOBALS(blist) + foreach i [keylkeys blist] { + set v [keylget 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 + set IWOK_GLOBALS(buttons,state,$i) {} + } + + set prev {} + set curr {} + + foreach i [keylkeys blist] { + set v [keylget blist $i] + set curr [lindex $v 0] + if { $prev == {} } { + tixForm $w.$curr -top $w.mnu + } else { + tixForm $w.$curr -left $w.$prev -top $w.mnu + } + set prev $curr + } + + set IWOK_GLOBALS(buttons) $blist + return $w.$curr + } + + balloon { + foreach b $IWOK_GLOBALS(buttons) { + set x [lindex $b 1] + tixBalloon [lindex $x end].bal + [lindex $x end].bal bind [lindex $x end] -msg "[lindex $x 2]" + } + } + + disable { + foreach bt $w { + [lindex [keylget IWOK_GLOBALS(buttons) $bt] end] configure -state disabled + } + + } + + activate { + foreach bt $w { + [lindex [keylget IWOK_GLOBALS(buttons) $bt] end] configure -state normal + } + } + + + setw { + lappend IWOK_GLOBALS(buttons,state,[lindex $w 0]) [lindex $w 1] + wokUpdateWindowMenu [lindex $w 1] + } + + delw { + set ltpl $IWOK_GLOBALS(buttons,state,[lindex $w 0]) + set tpl [lindex $w 1] + set i [lsearch $ltpl $tpl] + if { $i != -1 } { + set IWOK_GLOBALS(buttons,state,[lindex $w 0]) [lreplace $ltpl $i $i] + wokRemoveWindowMenu $tpl + } + } + + resetw { + set IWOK_GLOBALS(buttons,state,[lindex $w 0]) {} + } + + + getw { + return $IWOK_GLOBALS(buttons,state,[lindex $w 0]) + } + + listw { + set ll {} + foreach bb [array names IWOK_GLOBALS buttons,state,*] { + lappend ll [list [lindex [split $bb ,] 2] $IWOK_GLOBALS($bb)] + } + return $ll + } + + session { + wokButton disable {params prepare wbuild browser} + } + + factory { + wokButton disable {prepare wbuild browser} + wokButton activate params + } + + workshop { + wokButton disable {prepare wbuild browser} + wokButton activate params + } + + workbench { + wokButton activate {prepare wbuild browser params} + } + + devunit_* { + wokButton activate {prepare wbuild browser params} + } + + devunitstuff { + wokButton activate {prepare browser wbuild params} + } + + } + return +} + +proc wokReaff { } { + global IWOK_GLOBALS + if { "[set cwd [wokCWD read]]" != ":" } { + if { [set dad [wokNAV:Tlist:Dad $IWOK_GLOBALS(toplevel) $cwd]] != {} } { + wokCWD write $dad + } + } + return +} + +proc wokReaffCanvas { } { + global IWOK_GLOBALS + wokUpdateCanvas $IWOK_GLOBALS(toplevel) [wokCWD read] + return +} + + +proc wokUpdateWindowMenu {wl} { + global IWOK_GLOBALS + if {![info exist IWOK_GLOBALS(menuwin,$wl)]} { + set wroot $IWOK_GLOBALS(toplevel) + set t "[wm title $wl]" + $wroot.mnu.but.menu1 add command -label $t -command "wokRaise $wl" + set ind [$wroot.mnu.but.menu1 index last] + set IWOK_GLOBALS(menuwin,$wl) $ind + $wroot.mnu.but configure -state active + } + return +} + +proc wokRemoveWindowMenu {wl} { + global IWOK_GLOBALS + set wroot $IWOK_GLOBALS(toplevel) + if {[info exist IWOK_GLOBALS(menuwin,$wl)]} { + $wroot.mnu.but.menu1 delete $IWOK_GLOBALS(menuwin,$wl) + unset IWOK_GLOBALS(menuwin,$wl) + if { [$wroot.mnu.but.menu1 index last] == 0 } { + $wroot.mnu.but configure -state disabled + } + } + return +} + +proc wokRaise { w } { + catch { + wm deiconify $w + raise $w + } + return +} + +proc wokHideAll { } { + foreach ws [wokButton listw] { + foreach tpl [lindex $ws 1] { + catch { + lower $tpl + } + } + } +} +proc wokShowAll { } { + foreach ws [wokButton listw] { + wokRaise [lindex $ws 1] + } +} +proc wokMainHelp { w } { + global IWOK_GLOBALS + global IWOK_WINDOWS + global env + + set IWOK_WINDOWS($w,help) [set wh .wokMainHelp] + if {[info exist IWOK_GLOBALS(windows)]} { + if {[lsearch $IWOK_GLOBALS(windows) $wh ] == -1} { + lappend IWOK_GLOBALS(windows) $wh + } + } + + set whelp [wokHelp $wh "About iwok"] + set texte [lindex $whelp 0] ; set label [lindex $whelp 1] + wokReadFile $texte $env(WOK_LIBRARY)/wokMainHelp.hlp + wokFAM $texte <.*> { $texte tag add big first last } + $texte tag configure big -background Bisque3 -foreground black -borderwidth 2 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-* -relief raised + update + $texte configure -state disabled + return +} +;# +;# Lit/ecrit/decode le contenu de Location. lire: [list fact shop wb unit] +;# +proc wokCWD { option args } { + global IWOK_GLOBALS + switch -- $option { + + read { + return $IWOK_GLOBALS(CWD) + } + + + split { + set l {} + set str [wokCWD read] + if [wokinfo -x $str] { + set fact [wokinfo -f $str] + set shop [ lindex [split [wokinfo -s $str] :] end] + set wb [ lindex [split [wokinfo -w $str] :] end] + set unit [ lindex [split [wokinfo -u $str] :] end] + set l [list $fact $shop $wb $unit] + } + return $l + } + + readnocell { + set ll [llength [set lc [split $IWOK_GLOBALS(CWD) :]]] + if { $ll != 5 } { + return $IWOK_GLOBALS(CWD) + } else { + return [join [lrange $lc 0 [expr $ll - 2]] :] + } + } + + write { + set IWOK_GLOBALS(CWD) $args + return + } + + writenocallback { + $IWOK_GLOBALS(label) configure -disablecallback true + set IWOK_GLOBALS(CWD) $args + $IWOK_GLOBALS(label) configure -disablecallback false + } + + updatehistory { + $IWOK_GLOBALS(label,entry) configure -state normal + $IWOK_GLOBALS(label) appendhistory $args + $IWOK_GLOBALS(label,entry) configure -state disabled + } + + deletefromhistory { + set entry $args + set lstb [$IWOK_GLOBALS(label) subwidget listbox] + set inx [lsearch [$lstb get 0 end] $entry] + if { $inx != -1 } { + $lstb delete $inx + } + } + + disable { + $IWOK_GLOBALS(label,entry) configure -state disabled + } + + } + +} +;# (((((((((((((((((( P O P U P C A N V A S )))))))))))))))))))) +;# +;# +;#^WOK^k3dev^iwok^WOKTclLib^admfile WOK:k3dev:iwok:WOKTclLib:admfile stuff_admfile admfile image35 +;# wokGetdevunitstuffdate {18 18 600 18 10 1.2} current +;# +proc wokPOP:canvas:cmd { action } { + set data [wokPOP:canvas:Selection] + set dir [lindex $data 0] + set loc [lindex $data 1] + set typ [lindex $data 2] + switch -- $action { + wokcd { + wokMOV:wokcd $loc + } + + Add { + wokCreate $dir $loc + } + + Delete { + wokDelete $dir $loc + } + + Build { + set lud {} + set ltyp [split $typ _] + if { "[lindex $ltyp 0]" == "devunit" } { set lud [list [lindex $ltyp 1] [wokinfo -n $loc]] } + winbuild $loc $lud + } + + Prepare { + set lud {} + set ltyp [split $typ _] + if { "[lindex $ltyp 0]" == "devunit" } { set lud [list [lindex $ltyp 1] [wokinfo -n $loc]] } + wokPrepare $loc $lud + } + + Properties { + wokProperties $dir $loc $typ + } + + } + return +} +;# +;# retourne 1 si il faut filtrer des UDS ou activer le pop +;# +proc wokPOP:DoSelect { } { + if { [wokinfo -x [wokCWD read]] } { + if { "[wokinfo -t [wokCWD read]]" == "workbench" } { + return 1 + } else { + return 0 + } + } else { + return 0 + } +} +proc wokPOP:canvas { option {w nil} } { + global IWOK_GLOBALS + + switch -glob -- $option { + + initialize { + $IWOK_GLOBALS(popc,mnu) add comm -lab [wokUtils:EASY:OneHead wokcd 30] \ + -command [list wokPOP:canvas:cmd wokcd] + $IWOK_GLOBALS(popc,mnu) add separator + $IWOK_GLOBALS(popc,mnu) add casc -lab Select -menu $IWOK_GLOBALS(popc,mnu).selud + wokPOP:canvas initselud [menu $IWOK_GLOBALS(popc,mnu).selud -font $IWOK_GLOBALS(font)] + wokPOP:canvas initselext [menu $IWOK_GLOBALS(popc,mnu).selext -font $IWOK_GLOBALS(font)] + set IWOK_GLOBALS(popc,Selected) All + $IWOK_GLOBALS(popc,mnu) add separator + $IWOK_GLOBALS(popc,mnu) add comm -lab [wokUtils:EASY:OneHead Add 30] \ + -command [list wokPOP:canvas:cmd Add] + $IWOK_GLOBALS(popc,mnu) add comm -lab [wokUtils:EASY:OneHead Delete 30] \ + -command [list wokPOP:canvas:cmd Delete] + $IWOK_GLOBALS(popc,mnu) add separator + $IWOK_GLOBALS(popc,mnu) add comm -lab [wokUtils:EASY:OneHead Build 30] \ + -command [list wokPOP:canvas:cmd Build] + $IWOK_GLOBALS(popc,mnu) add comm -lab [wokUtils:EASY:OneHead Prepare 30] \ + -comm [list wokPOP:canvas:cmd Prepare] + $IWOK_GLOBALS(popc,mnu) add separator + $IWOK_GLOBALS(popc,mnu) add comm -lab [wokUtils:EASY:OneHead Properties 30] \ + -comm [list wokPOP:canvas:cmd Properties] + } + + create { + set IWOK_GLOBALS(popc) [tixPopupMenu $w.popc -postcmd [list wokPOP:canvas:PostCommand $w]] + set IWOK_GLOBALS(popc,mnu) [$IWOK_GLOBALS(popc) subwidget menu] + $IWOK_GLOBALS(popc,mnu) configure -font $IWOK_GLOBALS(font) + $IWOK_GLOBALS(popc) subwidget menubutton configure -font $IWOK_GLOBALS(font) + return $w.popc + } + + initselud { + set llitm [linsert $IWOK_GLOBALS(ucreate-P) 0 [list All All]] + foreach t $llitm { + set xt [lindex $t 1] + $w add radio -lab $xt -vari IWOK_GLOBALS(popc,Selected) -comm wokReaffCanvas + } + } + + initselext { + set llitm [linsert $IWOK_GLOBALS(ucreate-P) 0 [list All All]] + foreach t $llitm { + set xt [lindex $t 1] + if [info exists IWOK_GLOBALS(EXT,$xt,ext)] { + foreach e $IWOK_GLOBALS(EXT,$xt,ext) { + ;#puts "$w add radio -lab $e -comm " + } + } + } + } + + disable { + foreach e $w { + $IWOK_GLOBALS(popc,mnu) entryconfigure ${e}* -state disabled + } + } + + activate { + foreach e $w { + $IWOK_GLOBALS(popc,mnu) entryconfigure ${e}* -state active + } + } + + activeselect { + set last [$IWOK_GLOBALS(popc,mnu) index last] + for {set i 0} {$i <= $last} {incr i} { + if { "[$IWOK_GLOBALS(popc,mnu) type $i]" != "separator" } { + $IWOK_GLOBALS(popc,mnu) entryconfigure $i -state disabled + } + } + + if { [wokPOP:DoSelect] } {wokPOP:canvas activate Select} + } + + factory { + wokPOP:canvas activate {wokcd Add Delete Properties} + wokPOP:canvas disable {Select Build Prepare} + } + + workshop { + wokPOP:canvas activate {wokcd Add Delete Properties} + wokPOP:canvas disable {Select Build Prepare} + } + + warehouse { + wokPOP:canvas activate {wokcd Properties} + wokPOP:canvas disable {Select Add Delete Build Prepare} + } + + parcel { + wokPOP:canvas activate {wokcd Properties} + wokPOP:canvas disable {Select Add Delete Build Prepare } + } + + workbench { + wokPOP:canvas activate {wokcd Add Delete Build Prepare Properties} + wokPOP:canvas disable {Select} + } + + session { + wokPOP:canvas activate {} + wokPOP:canvas disable {Select wokcd Build Prepare Add Delete Properties} + } + + stuff_* { + wokPOP:canvas activate {wokcd} + wokPOP:canvas disable {Select Add Delete Build Prepare Properties} + } + + parcel_* { + wokPOP:canvas activate {Delete} + wokPOP:canvas disable {Add Delete wokcd Select Build Prepare Properties} + } + + parcelstuff_* { + wokPOP:canvas activate {} + wokPOP:canvas disable {wokcd Add Delete Select Build Prepare Properties} + } + + devunit_* { + wokPOP:canvas activate {wokcd Delete Properties Select Build Prepare} + wokPOP:canvas disable {Add } + } + + trig_Repository { + wokPOP:canvas activate {} + wokPOP:canvas disable {wokcd Select Build Prepare Add Delete Properties} + } + + trig_terminal { + wokPOP:canvas activate {Properties} + wokPOP:canvas disable {wokcd Add Delete Select Build Prepare} + } + + trig_Queue { + wokPOP:canvas activate {Properties} + wokPOP:canvas disable {wokcd Select Build Prepare Add Delete } + } + + } +} +;# +;# Appelee avant l affichage du Popup sur la canvas . Recupere la selection +;# front = coord x du separateur de la paned window +;# taily = coord y du coin hg du canvas (aussi donc de la canvas) +;# $x < $front vrai on est a gauche donc dans la canvas etc.. +;# En fonction du type met les menus specifiques. +;# +;# DANS le CANVAS: +;# Mb3 sur un element: ouvrir (fait le double click / sauf si c est un terminal) +;# apercu rapide +;# supprimer/renommer/reconstruire/preparer +;# proprietes +;# +proc wokPOP:canvas:PostCommand { w x y } { + global IWOK_GLOBALS + global IWOK_WINDOWS + + if { "[info procs wokPOP:canvas:GetInfo]" != "" } { + set seltag [wokPOP:canvas:GetInfo] + set mtx [lindex $seltag 1] + set option [lindex $seltag 2] + rename wokPOP:canvas:GetInfo {} + } else { + set seltag {} + set mtx {Display} + set option activeselect + } + eval "proc wokPOP:canvas:Selection {} { return \"$seltag\" }" + set len [string length [lindex $seltag 1]] + if { $len <= 30 } { + $IWOK_GLOBALS(popc) subwidget menubutton configure -text [lindex $seltag 1] + } else { + $IWOK_GLOBALS(popc) subwidget menubutton configure -text [string range [lindex $seltag 1] 0 28].. + } + update + wokPOP:canvas $option + return 1 +} + +;# (((((((((((((((((( P O P U P H L I S T )))))))))))))))))))) +;# +;# +;# +proc wokPOP:hlist:cmd { action } { + set data [wokPOP:hlist:Selection] ;#WOK:k3dev:cle workbench cle image33 wokGetworkbenchdate {18 18 ...} + set dir [lindex $data 0] + set loc [lindex $data 1] + set typ [lindex $data 2] + switch -- $action { + wokcd { + wokMOV:wokcd $loc + } + + Add { + wokCreate $dir $loc + } + + Delete { + wokDelete $dir $loc + } + + Build { + set lud {} + set ltyp [split $typ _] + if { "[lindex $ltyp 0]" == "devunit" } { set lud [list [lindex $ltyp 1] [wokinfo -n $loc]] } + winbuild $loc $lud + } + + Prepare { + set lud {} + set ltyp [split $typ _] + if { "[lindex $ltyp 0]" == "devunit" } { set lud [list [lindex $ltyp 1] [wokinfo -n $loc]] } + wokPrepare $loc $lud + } + + Properties { + wokProperties $dir $loc $typ + } + + } + return +} + +proc wokPOP:hlist { option {w nil} } { + global IWOK_GLOBALS + + switch -glob -- $option { + + initialize { + + $IWOK_GLOBALS(poph,mnu) add comm -lab [wokUtils:EASY:OneHead wokcd 30] \ + -comm [list wokPOP:hlist:cmd wokcd] + $IWOK_GLOBALS(poph,mnu) add separator + $IWOK_GLOBALS(poph,mnu) add comm -lab [wokUtils:EASY:OneHead Add 30] \ + -comm [list wokPOP:hlist:cmd Add] + $IWOK_GLOBALS(poph,mnu) add comm -lab [wokUtils:EASY:OneHead Delete 30] \ + -comm [list wokPOP:hlist:cmd Delete] + $IWOK_GLOBALS(poph,mnu) add separator + $IWOK_GLOBALS(poph,mnu) add comm -lab [wokUtils:EASY:OneHead Build 30] \ + -comm [list wokPOP:hlist:cmd Build] + $IWOK_GLOBALS(poph,mnu) add comm -lab [wokUtils:EASY:OneHead Prepare 30] \ + -comm [list wokPOP:hlist:cmd Prepare] + $IWOK_GLOBALS(poph,mnu) add separator + $IWOK_GLOBALS(poph,mnu) add comm -lab [wokUtils:EASY:OneHead Properties 30] \ + -comm [list wokPOP:hlist:cmd Properties] + } + + adjust { + } + + create { + set IWOK_GLOBALS(poph) [tixPopupMenu $w.poph -postcmd [list wokPOP:hlist:PostCommand $w]] + set IWOK_GLOBALS(poph,mnu) [$IWOK_GLOBALS(poph) subwidget menu] + $IWOK_GLOBALS(poph,mnu) configure -font $IWOK_GLOBALS(font) + $IWOK_GLOBALS(poph) subwidget menubutton configure -font $IWOK_GLOBALS(font) + return $w.poph + } + + disable { + foreach e $w { + $IWOK_GLOBALS(poph,mnu) entryconfigure ${e}* -state disabled + } + } + + activate { + foreach e $w { + $IWOK_GLOBALS(poph,mnu) entryconfigure ${e}* -state active + } + } + + factory { + wokPOP:hlist activate {wokcd Add Delete Properties} + wokPOP:hlist disable {Build Prepare} + } + + workshop { + wokPOP:hlist activate {wokcd Add Delete Properties} + wokPOP:hlist disable {Build Prepare} + } + + warehouse { + wokPOP:hlist activate {wokcd Properties } + wokPOP:hlist disable {Build Add Delete Prepare } + } + + parcel { + wokPOP:hlist activate {wokcd Properties } + wokPOP:hlist disable {Add Delete Build Prepare } + } + + workbench { + wokPOP:hlist activate {wokcd Add Delete Build Prepare Properties} + wokPOP:hlist disable {} + } + + session { + wokPOP:hlist activate {Properties} + wokPOP:hlist disable {wokcd Build Prepare Add Delete} + } + + stuff_* { + wokPOP:hlist activate {wokcd} + wokPOP:hlist disable {Build Add Delete Prepare Properties} + } + + parcel_* { + wokPOP:hlist activate {} + wokPOP:hlist disable {wokcd Add Delete Build Prepare Properties} + } + + parcelstuff_* { + wokPOP:hlist activate {} + wokPOP:hlist disable {wokcd Add Delete Build Prepare Properties} + } + + devunit_* { + wokPOP:hlist activate {wokcd Delete Properties Build Prepare} + wokPOP:hlist disable { Add } + } + + trig_Repository { + wokPOP:hlist activate {} + wokPOP:hlist disable {wokcd Add Delete Build Prepare Properties} + } + + trig_terminal { + wokPOP:hlist activate {Properties} + wokPOP:hlist disable {wokcd Add Delete Build Prepare} + } + + trig_Queue { + wokPOP:hlist activate {Properties} + wokPOP:hlist disable {wokcd Add Delete Build Prepare} + } + } +} +;# +;# appelee avant le Post +;# +proc wokPOP:hlist:PostCommand { w x y } { + global IWOK_GLOBALS + global IWOK_WINDOWS + $IWOK_WINDOWS($w,NAV,hlist) anchor clear + $IWOK_WINDOWS($w,NAV,hlist) selection clear + set Y [expr $y - [winfo rooty $IWOK_GLOBALS(tree,name)]] + set hlist $IWOK_WINDOWS($w,NAV,hlist) + set nearest [$hlist nearest $Y] + set seltag [$hlist info data [$hlist nearest $Y]] + eval "proc wokPOP:hlist:Selection {} { return \"$nearest $seltag\" }" + + set len [string length [lindex $seltag 0]] + if { $len <= 30 } { + $IWOK_GLOBALS(poph) subwidget menubutton configure -text [lindex $seltag 0] + } else { + $IWOK_GLOBALS(popc) subwidget menubutton configure -text [string range [lindex $seltag 0] 0 28].. + } + update + wokPOP:hlist [lindex $seltag 1] + return 1 +} + + +;# (((((((((((((((((( D I S P L A Y )))))))))))))))))))) +;# +;# Selectionne dans l les uds du type selectionne. (IWOK_GLOBALS(popc,Selected) = package..) +;# +;# faudrait voir a speeder qunad il ne s'agit pas d'UD. +;# il faut initialiser IWOK_GLOBALS(popc,Selected) a All +proc wokSelType { l } { + global IWOK_GLOBALS + if { ![wokPOP:DoSelect] } { return $l } + if { "$IWOK_GLOBALS(popc,Selected)" == "All" } { return $l } + set ll {} + foreach x $l { + set rtyp [lindex [split [lindex $x 2] _] 1] + if { "$IWOK_GLOBALS(popc,Selected)" == "$rtyp" } { + lappend ll $x + } + } + return $ll +} +;# +;# affiche les items dans le canvas. +;# +proc wokUpdateCanvas { w loc } { + set l [wokSelType [wokNAV:tlist:GetData $w $loc]] + set disp [wokNAV:tlist:Display $w $loc] + set func [wokDSP:Func] + set fdate [wokNAV:tlist:date $w $loc] + if [wokDSP:IsLong] { + if [wokDSP:IsLast] { + set ll [$fdate $l 1] + } else { + set ll [$fdate $l 0] + } + } else { + set ll $l + } + $func $disp $ll + + return +} +;# +proc wokDSP:Display { button toggle } { + global IWOK_GLOBALS + if { $toggle == 1 } { + set IWOK_GLOBALS(canvas,func) $IWOK_GLOBALS(canvas,func,$button) + wokUpdateCanvas $IWOK_GLOBALS(toplevel) [wokCWD read] + } + return +} +proc wokDSP:Init { w } { + global IWOK_GLOBALS + + set ww [frame $w.myf] + tixSelect $ww.dis -allowzero false -radio true -command wokDSP:Display \ + -label "" \ + -variable IWOK_GLOBALS(canvas,format) \ + -options { + label.width 0 + label.padx 0 + label.anchor n + } + + set msg(byrow) "Rows" ;set IWOK_GLOBALS(canvas,func,byrow) wokUpdatePage_xy;# X- X- + set msg(bycol) "Columns" ;set IWOK_GLOBALS(canvas,func,bycol) wokUpdatePage_tt;# X- + set msg(bylong) "Date/Size" ;set IWOK_GLOBALS(canvas,func,bylong) wokUpdatePage_cy;# X- - + set msg(bylast) "Last modified first" ;set IWOK_GLOBALS(canvas,func,bylast) wokUpdatePage_cy;# Y- - + + + foreach bix [array names msg] { + $ww.dis add $bix -image [tix getimage $bix] + set bux [$ww.dis subwidget $bix] + tixBalloon ${bux}.bal + ${bux}.bal bind ${bux} -msg $msg($bix) + } + + pack $ww.dis -expand yes -fill both -padx 8 -pady 8 + + $ww.dis configure -disablecallback true ;# sinon boum CWD pas encore allouee + set IWOK_GLOBALS(canvas,format) byrow + set IWOK_GLOBALS(canvas,func) wokUpdatePage_xy + $ww.dis configure -disablecallback false + + return $ww +} +# +# +# +proc wokDSP:Func { } { + global IWOK_GLOBALS + return $IWOK_GLOBALS(canvas,func) +} +# +# retourne 1 si on doit calculer la date des items a afficher. +# +proc wokDSP:IsLong { } { + global IWOK_GLOBALS + if { "$IWOK_GLOBALS(canvas,format)" == "bylong" || "$IWOK_GLOBALS(canvas,format)" == "bylast" } { + return 1 + } else { + return 0 + } +} +# +# retourne 1 si on doit ordonner par rapport a mtime +# +proc wokDSP:IsLast { } { + global IWOK_GLOBALS + if { "$IWOK_GLOBALS(canvas,format)" == "bylast" } { + return 1 + } else { + return 0 + } +} +# +# colle les scrollbars de w au debut de la w +# +proc wokUSB { w } { + set hsb [$w subwidget hsb] + set vsb [$w subwidget vsb] + set hcmd [lindex [$hsb configure -command] 4] + set vcmd [lindex [$vsb configure -command] 4] + eval $hcmd moveto 0 + eval $vcmd moveto 0 + return +} +# +# ajuste la taille du canvas x et y en "screen units" i.e. celle retournee par coord ou bbox +# +proc wokSetCanvasSize { x y } { + global IWOK_GLOBALS + set Mx $IWOK_GLOBALS(canvas,width) + set My $IWOK_GLOBALS(canvas,height) + $IWOK_GLOBALS(canvas) configure \ + -width [expr { ($x <= $Mx) ? $Mx : $x }] \ + -height [expr { ($y <= $My) ? $My : $y }] + return +} +;# +;# items en ligne +;# +proc wokUpdatePage_xy { param itemlist } { + global IWOK_GLOBALS + global IWOK_WINDOWS + set w $IWOK_GLOBALS(toplevel) + + set fscr $IWOK_WINDOWS($w,NAV,scrolled) + + set can $IWOK_GLOBALS(canvas) + wokUSB $fscr + + $can delete all + + set X [lindex $param 0] + set Y [lindex $param 1] + set WDTH [lindex $param 2] + set DY [lindex $param 3] + set DT [lindex $param 4] + set COEF [lindex $param 5] + + set mdx 0 + set lele {} + ;#^WOK^k3dev^iwok WOK:k3dev:iwok workbench iwok image17 + + foreach E $itemlist { + set name [lindex $E 3] + set btm [lindex $E 4] + set ima [$can create image 0 0 -image $btm -tag $E] + set itx [$can create text 0 0 -anchor w -text $name \ + -fill $IWOK_GLOBALS(toplevel,fg) -font $IWOK_GLOBALS(font) -tag $E] + $can bind $ima {catch { %W configure -cursor {hand2 red white}}} + $can bind $ima {catch { %W configure -cursor {}}} + $can bind $itx {catch { %W configure -cursor {hand2 red white}}} + $can bind $itx {catch { %W configure -cursor {}}} + lappend lele [list $ima $itx] + set retl [$can bbox $itx] + set d [expr [lindex $retl 2] - [lindex $retl 0]] + set mdx [expr { ($d > $mdx) ? $d : $mdx }] + } + + set supx 0 ; set supy 0 ; set mdx [expr { int ( $COEF * $mdx ) } ] + + set INIX $X + foreach e $lele { + set ima [lindex $e 0] + set itx [lindex $e 1] + $can coords $ima $X $Y + $can coords $itx [expr $X+$DT] $Y + set NX [incr X $mdx] + if { $NX > $WDTH } { + set X $INIX + set Y [incr Y $DY] + } else { + set X $NX + } + set retl [wokMaxbbox [$can bbox $ima] [$can bbox $itx]] + set x2 [lindex $retl 0] + set y2 [lindex $retl 1] + + set supx [expr { ($x2 > $supx) ? $x2 : $supx }] + set supy [expr { ($y2 > $supy) ? $y2 : $supy }] + } + + wokSetCanvasSize $supx $supy + pack $can + return + +} +;# +;# item sur une seule colonne: x constant +;# +proc wokUpdatePage_cy { param itemlist } { + global IWOK_WINDOWS + global IWOK_GLOBALS + set w $IWOK_GLOBALS(toplevel) + set fscr $IWOK_WINDOWS($w,NAV,scrolled) + set can $IWOK_GLOBALS(canvas) + wokUSB $fscr + + $can delete all + + set X [lindex $param 0] + set Y [lindex $param 1] + set WDTH [lindex $param 2] + set DY [lindex $param 3] + set DT [lindex $param 4] + set COEF [lindex $param 5] + + + set supx 0 ; set supy 0 ; + + foreach E $itemlist { + set name [lindex $E 3] + set btm [lindex $E 4] + set ima [$can create image $X $Y -image $btm -tag $E] + set itx [$can create text [expr $X+$DT] $Y -anchor w -fill $IWOK_GLOBALS(toplevel,fg) \ + -text $name -font $IWOK_GLOBALS(font) -tag $E ] + $can bind $ima {catch { %W configure -cursor {hand2 red white}}} + $can bind $ima {catch { %W configure -cursor {}}} + $can bind $itx {catch { %W configure -cursor {hand2 red white}}} + $can bind $itx {catch { %W configure -cursor {}}} + set Y [incr Y $DY] + set retl [wokMaxbbox [$can bbox $ima] [$can bbox $itx]] + set x2 [lindex $retl 0] + set y2 [lindex $retl 1] + set supx [expr { ($x2 > $supx) ? $x2 : $supx }] + set supy [expr { ($y2 > $supy) ? $y2 : $supy }] + } + + wokSetCanvasSize $supx $supy + pack $can + return + +} + +;# +;# item ordonne sur une seule colonne +;# +proc wokUpdatePage_tt { param itemlist } { + global IWOK_WINDOWS + global IWOK_GLOBALS + set w $IWOK_GLOBALS(toplevel) + set fscr $IWOK_WINDOWS($w,NAV,scrolled) + set can $IWOK_GLOBALS(canvas) + wokUSB $fscr + + $can delete all + + set X [lindex $param 0] + set Y [lindex $param 1] + set WDTH [lindex $param 2] + set DY [lindex $param 3] + set DT [lindex $param 4] + set COEF [lindex $param 5] + + set supx 0 ; set supy 0 ; set mdx 0 + + set nblm 0 + + set TA [lindex [lindex $itemlist end] 2] + + set nlig 28 + switch -glob -- $TA { + trig_terminal { set nlig 36 } + devunit_* { set nlig 21 } + } + set nb 38 ; set nbm2 36 + foreach E $itemlist { + set ina [lindex $E 3] + set len [string length $ina] + if { $len <= $nb } { + set name $ina + } else { + set name [string range $ina 0 $nbm2].. + } + set btm [lindex $E 4] + set ima [$can create image $X $Y -image $btm -tag $E] + set itx [$can create text [expr $X+$DT] $Y -anchor w -fill $IWOK_GLOBALS(toplevel,fg) \ + -text $name -font $IWOK_GLOBALS(font) -tag $E ] + $can bind $ima {catch { %W configure -cursor {hand2 red white}}} + $can bind $ima {catch { %W configure -cursor {}}} + $can bind $itx {catch { %W configure -cursor {hand2 red white}}} + $can bind $itx {catch { %W configure -cursor {}}} + incr nblm + if { $nblm > $nlig } { + set nblm 0 + set X [expr $X + int ( $COEF * $mdx )] + set Y [lindex $param 1] + set mdx 0 + } else { + set Y [incr Y $DY] + set bx1 [$can bbox $ima] + set lx1 [expr [lindex $bx1 2] - [lindex $bx1 0]] + set bx2 [$can bbox $itx] + set lx2 [expr [lindex $bx2 2] - [lindex $bx2 0]] + set d [expr $lx1 + $lx2] + set mdx [expr { ($d > $mdx) ? $d : $mdx }] + } + set x2 [lindex $bx2 2] + set y2 [lindex $bx1 2] + set supx [expr { ($x2 > $supx) ? $x2 : $supx }] + set supy [expr { ($y2 > $supy) ? $y2 : $supy }] + } + + wokSetCanvasSize $supx $supy + pack $can + return + +} + + + +# +# retourne le max de 2 bbox +# +proc wokMaxbbox { l1 l2 } { + return [list [max [lindex $l1 2] [lindex $l2 2]] [max [lindex $l1 3] [lindex $l2 3]]] +} + +# +# ((((((((((( D A T E ))))))))))) ll = ;#^WOK^k3dev^iwok WOK:k3dev:iwok workbench iwok imag17 .. +# +proc wokGetsessiondate { ll last } { + return $ll +} + +proc wokGetfactorydate { ll last } { + return $ll +} + +proc wokGetworkshopdate { ll last } { + return $ll +} + +proc wokGetworkbenchdate { ll last } { + return $ll + set lt [woktutu4 $ll] + if { $last == 1 } { + set lr [lsort -decreasing -command wok5Sort $lt] + } else { + set lr $lt + } + set l {} + set nb 28 + set fm 32 + foreach e $lr { + set len [string length [lindex $e 3]] + if { $len <= [expr $nb + 2 ]} { + set str [lindex $e 3] + } else { + set str [string range [lindex $e 3] 0 $nb].. + } + set x [split [lindex $e 5] ,] + set dat [string range [fmtclock [lindex $x 0]] 4 18] + set siz [lindex $x 1] + lappend l [lreplace $e 3 3 [format "%-${fm}s %9s %14s" $str $siz $dat]] + } + return $l +} +;# +;# retourne pour chaque Ud la date du fichier le plus recent et la somme des sizes de sources +;# +proc woktutu4 { ll } { + set l {} + foreach e $ll { + set st [wokUtils:FILES:StatDir [wokinfo -p source:. [lindex $e 1]]] + lappend l [lreplace $e 5 5 [lindex $st 0],[lindex $st 1]] + } + return $l +} + +proc wokGetdevunitdate { ll last } { + return $ll + set lt [woktutu6 $ll] + if { $last == 1 } { + set lr [lsort -decreasing -command wok5Sort $lt] + } else { + set lr $lt + } + set l {} + set nb 28 + set fm 32 + foreach e $lr { + set len [string length [lindex $e 3]] + if { $len <= [expr $nb + 2 ]} { + set str [lindex $e 3] + } else { + set str [string range [lindex $e 3] 0 $nb].. + } + set x [split [lindex $e 5] ,] + set dat [string range [fmtclock [lindex $x 0]] 4 18] + set siz [lindex $x 1] + lappend l [lreplace $e 3 3 [format "%-${fm}s %9s %14s" $str $siz $dat]] + } + return $l +} + +proc woktutu6 { ll } { + set l {} + foreach e $ll { + set L [llength [set lc [split [lindex $e 1] :]]] + set actloc [join [lrange $lc 0 [expr $L - 2]] :] + set st [wokUtils:FILES:StatDir [wokinfo -p [lindex $lc end]:. $actloc]] + lappend l [lreplace $e 5 5 [lindex $st 0],[lindex $st 1]] + } + return $l +} + + +proc wokGetparceldate { ll last } { + return $ll +} +proc wokGetparcelunitdate { ll last } { + return $ll +} +proc wokGetparcelunitstuffdate { ll last } { + return [wokGetdevunitstuffdate $ll $last] +} +;# +;# ll est triee par ordre alphab; +;# +proc wokGetdevunitstuffdate { ll last } { + set lt [woktutu5 $ll] + if { $last == 1 } { + set lr [lsort -decreasing -command wok5Sort $lt] + } else { + set lr $lt + } + set l {} + set nb 28 + set fm 32 + foreach e $lr { + set len [string length [lindex $e 3]] + if { $len <= [expr $nb + 2 ]} { + set str [lindex $e 3] + } else { + set str [string range [lindex $e 3] 0 $nb].. + } + set x [split [lindex $e 5] ,] + set dat [string range [fmtclock [lindex $x 0]] 4 18] + set siz [lindex $x 1] + lappend l [lreplace $e 3 3 [format "%-${fm}s %9s %14s" $str $siz $dat]] + } + return $l +} + +proc wok5Sort { a b } { + return [expr [lindex [split [lindex $a 5] ,] 0] - [lindex [split [lindex $b 5] ,] 0] ] +} +# +# remplace le path par la date sous forme comparable +# +proc woktutu5 { ll } { + set l {} + foreach e $ll { + catch {unset m} + file lstat [lindex $e 5] m + lappend l [lreplace $e 5 5 $m(mtime),$m(size)] + } + return $l +} +# +# Boutons up et Layout +# +proc wokMOV:Init { w } { + set ww [frame $w.mov] + tixButtonBox $ww.mov -orientation horizontal -relief flat -padx 0 -pady 0 + + $ww.mov add back -image [tix getimage back] -command wokReaff + $ww.mov add wcd -image [tix getimage wokcd] -command wokMOV:wokcd + + set bck [$ww.mov subwidget back] ; tixBalloon $bck.bal ; $bck.bal bind $bck -msg "Go up" + set wcd [$ww.mov subwidget wcd] ; tixBalloon $wcd.bal ; $wcd.bal bind $wcd -msg "wokcd" + + pack $ww.mov -expand yes -fill both -padx 6 -pady 6 + return $ww +} +# +# WOK:k3dev:iwok:WOKTclLib => fait wokcd +# WOK:k3dev:iwok:WOKTclLib:xxx => fait wokcd WOK:k3dev:iwok:WOKTclLib et cd /... +# Pour l'instant c'est ici que sont configures les boutons. +# +proc wokMOV:wokcd { {here {}} } { + if { $here == {} } { + set location [wokCWD read] + } else { + set location $here + } + set ll [llength [set lc [split $location :]]] + if { $ll != 5 } { + catch { wokcd [set actloc [join $lc :]] } + } else { + catch { + wokcd [set actloc [join [lrange $lc 0 [expr $ll - 2]] :]] + cd [wokinfo -p [lindex $lc end]:. $actloc] + } + } + + return +} +# +# Maintenant il y : en tete de l'adresse.... +# +proc wokMOV:Range { adr } { + if { "[string index $adr 0]" == ":" } { + return [string range $adr 1 end] + } else { + return $adr + } +} +# +# +# +proc wokMOV:Alonzi { tpl wokcd } { + + if { [set f [wokMOV:Range [wokinfo -f $wokcd]] ] != {} } { + wokNAV:Tree:Updateworkshop $tpl ${f} ^${f} + set loc ${f} + set dir ^${f} + } else { + return + } + + if { [set s [wokMOV:Range [wokinfo -s $wokcd]] ] != {} } { + set S [wokinfo -n $s] + wokNAV:Tree:Updateworkbench $tpl ${f}:$S ^${f}^$S + set loc ${f}:$S + set dir ^${f}^$S + } else { + wokNAV:Tree:SeeMe $tpl $loc $dir + return + } + + if { [set w [wokMOV:Range [wokinfo -w $wokcd]] ] != {} } { + set W [wokinfo -n $w] + wokNAV:Tree:Updatedevunit $tpl ${f}:$S:$W ^${f}^$S^$W + set loc ${f}:$S:$W + set dir ^${f}^$S^$W + } else { + wokNAV:Tree:SeeMe $tpl $loc $dir + return + } + + if { [set u [wokMOV:Range [wokinfo -u $wokcd]] ] != {} } { + set U [wokinfo -n $u] + wokNAV:Tree:Updatedevunitstuff $tpl ${f}:$S:$W:$U ^${f}^$S^$W^$U + set loc ${f}:$S:$W:$U + set dir ^${f}^$S^$W^$U + } else { + wokNAV:Tree:SeeMe $tpl $loc $dir + return + } + + wokNAV:Tree:SeeMe $tpl $loc $dir + return +} +;# +;# fait find parce que ca non plus ca existe pas +;# +proc wokFind { location } { + if ![wokinfo -x $location] return + if {"[wokinfo -t $location]" == "devunit" } { + return $location + } elseif {"[wokinfo -t $location]" == "workbench" } { + set l {} + foreach e [w_info -l $location] { + set l [concat $l ${location}:$e] + } + return [concat $l $location] + } elseif {"[wokinfo -t $location]" == "workshop" } { + set l {} + foreach e [sinfo -w $location] { + set l [concat $l [wokFind ${location}:$e]] + } + return [concat $l $location] + } elseif {"[wokinfo -t $location]" == "factory" } { + set l {} + foreach e [finfo -s $location] { + set l [concat $l [wokFind ${location}:$e]] + } + return [concat $l $location] + } +} diff --git a/src/WOKTclLib/VC.example b/src/WOKTclLib/VC.example new file mode 100755 index 0000000..7c3a5a5 --- /dev/null +++ b/src/WOKTclLib/VC.example @@ -0,0 +1,22 @@ +-- +-- This file defines the location and type of a WOK sources repository. +-- It must be placed in the directory "Adm" of the concerned workshop , +-- or in the directory "Adm" of the factory if you want to share the same repository between +-- all the workshops. +-- Note that this option is provided only for compatibility with previous version 5 of WOK. +-- Attaching one repository per workshop is strongly recommended. +-- +-- The following is a example. You must supply values according to your context +-- +-- VC_ROOT is a directory name. The repository will be created in that directory. +-- VC_TYPE is the type of the repository. +-- +@ifnotdefined ( %VC_EDL) then +@set %VC_EDL = ""; + +@set %VC_ROOT = "/dev/null"; + +@set %VC_TYPE = "SCCS"; + +@endif; + diff --git a/src/WOKTclLib/WCOMPATIBLE.tcl b/src/WOKTclLib/WCOMPATIBLE.tcl new file mode 100755 index 0000000..f61fe81 --- /dev/null +++ b/src/WOKTclLib/WCOMPATIBLE.tcl @@ -0,0 +1,80 @@ + + +proc wcd { args } { + if { [llength $args] !=0 } { + wokcd -PSrc $args + } else { + puts stdout {Usage: wcd } + foreach u [w_info -l] { + puts $u + } + } + return + +} + +proc wsrc {{entity ""}} { + if { $entity != "" } { wokcd -Tsource $entity } {wokcd -Tsource} +} + +proc wdrv {{entity ""}} { + if { $entity != "" } { wokcd -Tderivated $entity } {wokcd -Tderivated} +} + +proc wlib {{entity ""}} { + if { $entity != "" } { wokcd -Tlibrary $entity } {wokcd -Tlibrary} +} + +proc wbin {{entity ""}} { + if { $entity != "" } { wokcd -Texecutable $entity } {wokcd -Texecutable} +} +proc wobj {{entity ""}} { + if { $entity != "" } { wokcd -Tobject $entity } {wokcd -Tobject} +} +proc winc {{entity ""}} { + if { $entity != "" } { wokcd -Tpubinclude $entity } {wokcd -Tpubinclude} +} +proc wadm {{entity ""}} { + if { $entity != "" } { wokcd -Tadmfile $entity } {wokcd -Tadmfile} +} + + +proc wls { args } { + set f [lsearch -regexp $args {-[pniCtexscfOrd]} ] + if { $f != -1 } { + set ft [lindex [split [lindex $args $f] -] 1] + set lx {} + set len [string length $ft] + foreach cc [ucreate -P] { + set SLONG([lindex $cc 0]) [lindex $cc 1] + } + + for {set i 0} {$i < $len} {incr i 1} { + set x [string index $ft $i] + if [info exists SLONG($x)] { + lappend lx $SLONG($x) + } + } + + foreach ud [lsort [w_info -a]] { + if { [lsearch $lx [lindex $ud 0]] != -1 } { + puts [lindex $ud 1] + } + } + } else { + set l [lsearch -regexp $args {-l}] + if { $l == -1 } { + set retargs $args + set act {w_info -l} + } else { + set retargs [lreplace $args $l $l] + set act {w_info -a} + } + foreach ff [lsort [eval $act $retargs]] { + puts $ff + } + } +} + + + diff --git a/src/WOKTclLib/WOKVC.ClearCase b/src/WOKTclLib/WOKVC.ClearCase new file mode 100755 index 0000000..c004f7c --- /dev/null +++ b/src/WOKTclLib/WOKVC.ClearCase @@ -0,0 +1,102 @@ +# +# Interface ClearCase. +# +proc wokIntegre:BASE:ftos { file vrs } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:stof { file vrs } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:IsElm { file } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:InitFile { infile vrs cmt Sfile {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:ReInitFile { Sfile vrs cmt infile {fileid stdout} } { + return {} +} +#; +# +#;< +proc wokIntegre:BASE:UpdateFile { Sfile vrs cmt infile {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:DeleteFile { infile {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:GetFile { Sfile invrs {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:List { Bname vrs } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:EOF { {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:Execute { VERBOSE command {fileid stdout} } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:diff { sfile v1 v2 } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:cat { sfile {v last} } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:vrs { sfile } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:check { sfile } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:tree { infile fils} { + return {} +} +#;> +# +#;< +proc wokIntegre:Version:Check { shop ver } { + return {} +} diff --git a/src/WOKTclLib/WOKVC.NOBASE b/src/WOKTclLib/WOKVC.NOBASE new file mode 100755 index 0000000..c92e225 --- /dev/null +++ b/src/WOKTclLib/WOKVC.NOBASE @@ -0,0 +1,113 @@ +# +# Interface NOBASE +# +proc wokIntegre:BASE:ftos { file vrs } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:stof { file vrs } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:IsElm { file } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:InitFile { infile vrs cmt Sfile {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:ReInitFile { Sfile vrs cmt infile {fileid stdout} } { + return {} +} +#; +# +#;< +proc wokIntegre:BASE:UpdateFile { Sfile vrs cmt infile {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:DeleteFile { infile {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:GetFile { Sfile invrs {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:List { fshop Bname vrs } { + set Bname [lindex [split $Bname .] 0] + foreach wb [sinfo -w $fshop] { + if [expr { ( [llength [w_info -A ${fshop}:${wb}]] > 1 ) ? 0 : 1 }] { + set root $wb + break + } + } + set listfile {} + if [wokinfo -x ${fshop}:${root}:${Bname}] { + set listfile [wokUtils:FILES:ls [wokinfo -p source:. ${fshop}:${root}:${Bname}]] + } + return $listfile +} +#;> +# +#;< +proc wokIntegre:BASE:EOF { {fileid stdout} } { + return {} +} +#;> +# +#;< +proc wokIntegre:BASE:Execute { VERBOSE command {fileid stdout} } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:diff { sfile v1 v2 } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:cat { sfile {v last} } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:vrs { sfile } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:check { sfile } { + return {} +} +;#;> +;# +;#;< +proc wokIntegre:BASE:tree { infile fils} { + return {} +} +#;> +# +#;< +proc wokIntegre:Version:Check { shop ver } { + return {} +} diff --git a/src/WOKTclLib/WOKVC.RCS b/src/WOKTclLib/WOKVC.RCS new file mode 100755 index 0000000..4a764c5 --- /dev/null +++ b/src/WOKTclLib/WOKVC.RCS @@ -0,0 +1,349 @@ +# +# Interface RCS. +# +#;> +# retourne le nom du fichier de travail +# si vrs = x numero de lignee (appele par InitFile et Cie) +# prefixe le nom avec x +# si vrs = x.y version exacte (appele par FillRef et FillUSer au moment de wget) +# prefixe le nom avec x. C' est le nom du fichier de travail contenant la version x.y +# si vrs last:x derniere version enregistree de la lignee x (appele par wget) +# prefixe le nom avec x +#;< +proc wokIntegre:BASE:ftos { file vrs } { + if { [string first : $vrs] == -1 } { + set l [lindex [split $vrs .] 0] + return ${l},${file},v + } else { + return [lindex [split $vrs :] 1],${file},v + } +} +#;> +# retourne le nom du fichier a partir du nom du fichier de travail (basename) +#;< +proc wokIntegre:BASE:stof { file vrs } { + return [lindex [split $file ,] 1] +} + +#;> +# retourne 1 si file est un element d'une base +#;< +proc wokIntegre:BASE:IsElm { file } { + return [regexp {(.*),v$} $file all f] +} +#;> +# Ecrit dans fileid la sequence d'init d'un fichier RCS. +# Le directory courant est une base temporaire +# infile: Full path du fichier a enregistrer +# vrs : version +# cmt : commentaire +# Sfile : Full path du Sfile (base) qui sera cree +#;< +proc wokIntegre:BASE:InitFile { infile vrs cmt Sfile {fileid stdout} } { + ;#puts stderr "Appel a InitFile [file tail $infile] vrs = $vrs " + set bna [file tail $infile] + set bnas [file tail $Sfile] + set pfx ${vrs},${bna} + puts $fileid [format "echo Init for file %s" $bna ] + puts $fileid [format "echo Init > /tmp/%s" $bna.desc] + puts $fileid [format "rcs -q -i -U -t/tmp/%s %s" $bna.desc $pfx] + puts $fileid [format "cp -p %s ./%s" $infile $pfx] + puts $fileid [format "ci -u -f -r%s -m%s %s %s" $vrs $cmt $pfx $bnas] + puts $fileid [format "rm -f /tmp/%s " $bna.desc] + return +} +#;> +# Ecrit dans fileid la sequence d'init d'un fichier deja existant dans la base. +# Pour RCS la sequence est la meme que UpdateFile. +#;< +proc wokIntegre:BASE:ReInitFile { Sfile vrs cmt infile {fileid stdout} } { + ;#puts stderr "Appel a UpdateFile [file tail $Sfile] vrs = $vrs " + set bna [file tail $infile] + set bnas [file tail $Sfile] + set pfx ${vrs},${bna} + puts $fileid [format "echo Updating file %s" [file tail $infile]] + puts $fileid [format "cp %s ." $Sfile] + puts $fileid [format "co ./%s" $bnas] + puts $fileid [format "cp -p %s ./%s" $infile $pfx] + puts $fileid [format "ci -f -m%s %s %s" $cmt $pfx $bnas] + return +} +#; +# Ecrit dans fileid la sequence d'update d'un fichier deja existant dans la base +# Le repertoire courant est une base temporaire. +# Note: ci a detruit le fichier d'entree. +#;< +proc wokIntegre:BASE:UpdateFile { Sfile vrs cmt infile {fileid stdout} } { + ;#puts stderr "Appel a UpdateFile [file tail $Sfile] vrs = $vrs " + set bna [file tail $infile] + set bnas [file tail $Sfile] + set pfx ${vrs},${bna} + puts $fileid [format "echo Updating file %s" [file tail $infile]] + puts $fileid [format "cp %s ." $Sfile] + puts $fileid [format "co ./%s" $bnas] + puts $fileid [format "cp -p %s ./%s" $infile $pfx] + puts $fileid [format "ci -f -m%s %s %s" $cmt $pfx $bnas] + return +} +#;> +# Ecrit dans fileid la sequence correspondante a un fichier qui disparait (-) +#;< +proc wokIntegre:BASE:DeleteFile { infile {fileid stdout} } { + puts $fileid [format "echo Deleted file %s" $infile] + return +} +#;> +# Ecrit dans fileid la sequence pour recuperer un fichier (sans edit.) +# +# Si invrs = num => recup de la version num ( version exacte ) +# Si invrs = last:num => derniere version dans la lignee num +# Si invrs = last => derniere version enregistree +#;< +proc wokIntegre:BASE:GetFile { Sfile invrs {fileid stdout} } { + ;#puts "GET: invrs = $invrs ----- Sfile = $Sfile " + puts $fileid [format "echo Checkout file %s" $Sfile] + set lx [split [file tail $Sfile] ,] + set wfil [lindex $lx 0],[lindex $lx 1] + set file [lindex $lx 1] + if { [regexp {(.*):(.*)} $invrs ignore key vrs] } { + if { [string compare $key last] == 0 } { + puts $fileid [format "co -u %s" $Sfile] + } else { + msgprint -c WOKVC -e "Getfile bad version syntax $invrs" + } + } else { + if { [string compare $invrs last] == 0 } { + puts $fileid [format "co -u %s" $Sfile] + } else { + puts $fileid [format "co -u -r%s %s" $invrs $Sfile] + } + } + puts $fileid [format "mv $wfil $file"] + puts $fileid [format "chmod 644 $file"] + return +} +;#/home/wb/kl/KERNEL/SCCS//BASES/TSTPACK.p/4,f_UGSuppliers.c,v --> 4,f_UGSuppliers.c +;#revision 4.4 (unlocked) +;#done + +#;> +# retourne la liste des sfile dans une base +#;< +proc wokIntegre:BASE:List { fshop Bname vrs } { + set diradm [glob -nocomplain [wokIntegre:BASE:GetRootName $fshop]/${Bname}.?] + if [file exists $diradm] { + set l {} + foreach Sfile [readdir $diradm] { + set x [split $Sfile ,] + if { [lindex $x 0] == $vrs } { + lappend l [lindex $x 1] + } + } + return $l + } else { + return {} + } +} + +#;> +# Ecrit dans fileid la fin d'un envoi. Permet a BASE:Execute de retourner un status +#;< +proc wokIntegre:BASE:EOF { {fileid stdout} } { + puts $fileid "echo Successfull completion" + puts $fileid "exit 0" + return +} +#;> +# Execute les commandes RCS command dans un Bourne Shell +# 1. Ecrit sur fileid quand certains pattern sont reconnus. +# Retourne 1 si tout est OK. (Pattern De BASE::EOF bien recu) +# debugger: +# exp_internal 1 : patterns sur stderr ( ca suffit en general) +# exp_internal -f file 0 : stdout et patterns dans file +# exp_internal -f file 1 : stdout et patterns dans file + pattern sur stderr +#;< +proc wokIntegre:BASE:Execute { VERBOSE command {fileid stdout} } { + spawn -noecho sh $command + set LOCID $spawn_id + log_user 0 + exp_internal $VERBOSE + set return_status 0 + set timeout 84 + expect { + + -i $LOCID -indices -re "^Updating file (\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n" { + if { $expect_out(4,string) == "done" && $expect_out(4,string) == "done" } { + set file $expect_out(1,string) + if [regexp {new revision: (.*);.*} $expect_out(6,string) all ver] { + set straff [format " Modified : %s %s" $file $ver] + msgprint -c WOKVC -i $straff + puts $fileid $straff + } + exp_continue + } else { + puts stderr $expect_out(buffer) + close + return $return_status + } + } + + -i $LOCID -indices -re "^Checkout file (\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n" { + if { $expect_out(4,string) == "done" } { + set vrs [lindex [split $expect_out(3,string)] 1] + set nam [lindex [split [file tail $expect_out(1,string)] ,] 1 ] + msgprint -c WOKVC -i "Checking out file $nam ( $vrs )" + exp_continue + } else { + puts stderr $expect_out(buffer) + close + return $return_status + } + } + + + -i $LOCID -indices -re "^Init for file (\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n" { + if { $expect_out(4,string) == "done" } { + set file $expect_out(1,string) + regsub {initial revision: } $expect_out(3,string) "" ver + set straff [format " Added : %s %s" $file $ver] + puts $fileid $straff + msgprint -c WOKVC -i $straff + exp_continue + } else { + puts stderr $expect_out(buffer) + close + return $return_status + } + } + + + -i $LOCID -indices -re "^Processing unit : (\[^\r]*)\r\n" { + set ud $expect_out(1,string) + puts $fileid [format "\n %s (Updated) : \n----" $ud] + msgprint -c WOKVC -i [format " %s (Updated) : \n----" $ud] + exp_continue + } + + + -i $LOCID -indices -re "^Deleted file (\[^\r]*)\r\n" { + set file $expect_out(1,string) + set straff [format " Deleted : %s x.x" $file] + puts $fileid $straff + msgprint -c WOKVC -i $straff + exp_continue + } + + + -i $LOCID "Successfull completion\r\n" { + set return_status 1 + exp_continue + } + + -i $LOCID eof { + if { $VERBOSE } { + puts stdout "Received eof" + } + return $return_status + } + + -i $LOCID timeout { + msgprint -c WOKVC -e "Timeout excedeed ($timeout) from spawned process." + } + + } + return $return_status +} +;# +;# (((((((((((((((pour le desktop: ici on fait exec et c'est une catastroffe ))))))))))))))) +;#;> +;# retourne une string contenant le diff de Sfile dans les versions v1 et v2 +;#;< +proc wokIntegre:BASE:diff { sfile v1 v2 } { + return [exec rcsdiff -r$v1 -r$v2 -q $sfile] +} +;#;> +;# retourne une string contenant le contenu de la version v de sfile. +;#;< +proc wokIntegre:BASE:cat { sfile {v last} } { + if { $v == "last" } { + return [exec co -p -q $sfile] + } else { + return [exec co -p$v -q $sfile] + } +} +;#;> +;# retourne une string contenant le nom de la derniere version de sfile. +;#;< +proc wokIntegre:BASE:vrs { sfile } { + return [lindex [lindex [split [exec rlog -h $sfile] \n] 3] 1] +} +;#;> +;# Check for corruption +;#;< +proc wokIntegre:BASE:check { sfile } { + return +} +;#;> +;# fabrique de quoi afficher l'arbre des versions. +;#;< +proc wokIntegre:BASE:tree { infile fils} { + upvar $fils FILS + set sep ---------------------------- + set lst [split [exec rlog $infile] \n] + set i 1 + set ll [llength $lst] + set listlab {} + while { $i < $ll } { + set x [lindex $lst $i] + if { "$x" == "$sep" } { + incr i + lappend listlab [lindex [split [lindex $lst $i]] 1] + incr i + set itm [lindex $lst $i] + incr i + set cmt [lindex $lst $i] + } + incr i + } + + set i 0 + foreach e $listlab { + set w {} + lappend w [list $e [expr $i + 1]] + set FILS($i) $w + incr i + } + + set lab [lindex [lindex $listlab 0] 0] + return [list $lab 1] +} +# +# ((((((((((((((((VERSION)))))))))))))))) +# +#;> +# Verifie que l'on peu plugger shop avec le numero ver retourne ver si OK +#;< +proc wokIntegre:Version:Check { fshop ver } { + set f [wokIntegre:Version:GetTableName $fshop 1] + set l [wokUtils:FILES:FileToList $f] + set str [wokinfo -n [wokinfo -s $fshop]] + foreach e $l { + if { [lindex $e 0] == $str } { + if { [lindex $e 1] != $ver } { + msgprint -c WOKVC -e "The shop $str is already registered with number [lindex $e 1]" + return {} + } else { + return $ver + } + } + } + + foreach e $l { + set n [lindex $e 1] + if {$ver == $n } { + msgprint -c WOKVC -e "The version $ver is already assigned to the shop [lindex $e 0]" + return {} + } + } + return $ver +} diff --git a/src/WOKTclLib/WOKVC.SCCS b/src/WOKTclLib/WOKVC.SCCS new file mode 100755 index 0000000..79c8f2e --- /dev/null +++ b/src/WOKTclLib/WOKVC.SCCS @@ -0,0 +1,310 @@ +# +# Interface SCCS avec historique unique pour tout l'atelier. (Mode WOK-5-x) +# +#;> +# retourne le nom du fichier de travail (basename) +#;< +proc wokIntegre:BASE:ftos { file vrs } { + return s.$file +} +#;> +# retourne le nom du fichier a partir du nom du fichier de travail (basename) +#;< +proc wokIntegre:BASE:stof { file vrs } { + if [regexp {^s\.(.*)$} $file all f] { + return $f + } else { + return $file + } +} +#;> +# retourne 1 si +#;< +proc wokIntegre:BASE:IsElm { file } { + return [regexp {^s\.(.*)$} $file all f] +} +#;> +# Ecrit dans fileid la sequence d'init d'un fichier SCCS. +# infile: Full path du fichier a enregistrer +# vrs : version +# cmt : commentaire +# Sfile : Full path du Sfile (base) qui sera cree +#;< +proc wokIntegre:BASE:InitFile { infile vrs cmt Sfile {fileid stdout} } { + ;#puts stderr "Appel a InitFile [file tail $infile] vrs = $vrs " + puts $fileid [format "admin -i%s -r%s -y%s %s 2> /dev/null" $infile $vrs $cmt $Sfile] + puts $fileid [format "echo Init for file %s `prs -d:I: %s`" [file tail $infile] $Sfile] + return +} +#;> +# Ecrit dans fileid la sequence d'init d'un fichier deja existant dans la base (new version) +#;< +proc wokIntegre:BASE:ReInitFile { Sfile vrs cmt infile {fileid stdout} } { + ;#puts stderr "Appel a ReInitFile [file tail $Sfile] vrs = $vrs " + set bnas [file tail $Sfile] + regsub {^s[.]} $bnas "" bna + puts $fileid [format "echo Updating file %s" [file tail $infile]] + puts $fileid [format "cp %s ." $Sfile] + puts $fileid [format "get -e -r%s ./%s" $vrs $bnas] + puts $fileid [format "rm -f ./%s" $bna] + puts $fileid [format "cp -p %s ." $infile] + puts $fileid [format "delta -s -y%s ./%s" $cmt $bnas] + return +} +#; +# Ecrit dans fileid la sequence d'update d'un fichier deja existant dans la base +#;< +proc wokIntegre:BASE:UpdateFile { Sfile vrs cmt infile {fileid stdout} } { + ;#puts stderr "Appel a UpdateFile [file tail $Sfile] vrs = $vrs " + set bnas [file tail $Sfile] + regsub {^s[.]} $bnas "" bna + puts $fileid [format "echo Updating file %s" [file tail $infile]] + puts $fileid [format "cp %s ." $Sfile] + puts $fileid [format "v=`prs -r%s -d:I: %s`" $vrs $Sfile] + puts $fileid [format "get -e -r\$v ./%s" $bnas] + puts $fileid [format "rm -f ./%s" $bna] + puts $fileid [format "cp -p %s ." $infile] + puts $fileid [format "delta -s -y%s ./%s" $cmt $bnas] + return +} +#;> +# Ecrit dans fileid la sequence correspondante a un fichier qui disparait (-) +#;< +proc wokIntegre:BASE:DeleteFile { infile {fileid stdout} } { + puts $fileid [format "echo Deleted file %s" $infile] + return +} +#;> +# Ecrit dans fileid la sequence pour recuperer un fichier (sans edit.) +# +# Si invrs = num => recup de la version num ( version exacte ) +# Si invrs = last:num => derniere version dans la lignee num +# Si invrs = last => derniere version enregistree +#;< +proc wokIntegre:BASE:GetFile { Sfile invrs {fileid stdout} } { + puts $fileid [format "echo Checkout file %s" $Sfile] + if { [regexp {(.*):(.*)} $invrs ignore key vrs] } { + if { [string compare $key last] == 0 } { + puts $fileid [format "v=`prs -r%s -d:I: %s`" $vrs $Sfile] + puts $fileid [format "sccs get -s -r\$v %s" $Sfile] + } else { + msgprint -c WOKVC -e "Getfile bad version syntax $invrs" + } + } else { + if { [string compare $invrs last] == 0 } { + puts $fileid [format "sccs get -s %s" $Sfile] + } else { + puts $fileid [format "sccs get -s -r%s %s" $invrs $Sfile] + } + } + return +} +#;> +# retourne la liste des sfile dans une base +#;< +proc wokIntegre:BASE:List { fshop Bname vrs } { + set diradm [glob -nocomplain [wokIntegre:BASE:GetRootName $fshop]/${Bname}.?] + if [file exists $diradm] { + set l {} + foreach Sfile [lsort [readdir $diradm]] { + set s [string range $Sfile 0 1] + if { $s == "s." } { + lappend l [string range $Sfile 2 end] + } + } + return $l + } else { + return {} + } +} +#;> +# Ecrit dans fileid la fin d'un envoi. Permet a BASE:Execute de retourner un status +#;< +proc wokIntegre:BASE:EOF { {fileid stdout} } { + puts $fileid "echo Successfull completion" + puts $fileid "exit 0" + return +} +#;> +# Execute les commandes SCCS command dans un Bourne Shell +# 1. Ecrit sur fileid quand certains pattern sont reconnus. +# Retourne 1 si tout est OK. (Pattern De BASE::EOF bien recu) +# debugger: +# exp_internal 1 : patterns sur stderr ( ca suffit en general) +# exp_internal -f file 0 : stdout et patterns dans file +# exp_internal -f file 1 : stdout et patterns dans file + pattern sur stderr +#;< +proc wokIntegre:BASE:Execute { VERBOSE command {fileid stdout} } { + spawn -noecho sh $command + set LOCID $spawn_id + log_user 0 + exp_internal $VERBOSE + set return_status 0 + set timeout 84 + expect { + + -i $LOCID -indices -re "^Updating file (\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n(\[^\r]*)\r\n" { + set file $expect_out(1,string) + regsub {new delta } $expect_out(3,string) "" ver + set straff [format " Modified : %s %s" $file $ver] + msgprint -c WOKVC -i $straff + puts $fileid $straff + exp_continue + } + + -i $LOCID -indices -re "^Checkout file (\[^\r]*)\r\n" { + if { $VERBOSE } { + msgprint -c WOKVC -i "Checking out from file $expect_out(1,string)" + } + exp_continue + } + + + -i $LOCID -indices -re "^Init for file (\[^\r]*) (\[^\r]*)\r\n" { + set file $expect_out(1,string) + set ver $expect_out(2,string) + set straff [format " Added : %s %s" $file $ver] + puts $fileid $straff + msgprint -c WOKVC -i $straff + exp_continue + } + + + -i $LOCID -indices -re "^Processing unit : (\[^\r]*)\r\n" { + set ud $expect_out(1,string) + puts $fileid [format "\n %s (Updated) : \n----" $ud] + msgprint -c WOKVC -i [format " %s (Updated) : \n----" $ud] + exp_continue + } + + + -i $LOCID -indices -re "^Deleted file (\[^\r]*)\r\n" { + set file $expect_out(1,string) + set straff [format " Deleted : %s x.x" $file] + puts $fileid $straff + msgprint -c WOKVC -i $straff + exp_continue + } + + + -i $LOCID -re "ERROR(\[^\r]*)\r\n" { + msgprint -c WOKVC -e $expect_out(buffer) + return 0 + } + + -i $LOCID "Successfull completion\r\n" { + set return_status 1 + exp_continue + } + + -i $LOCID eof { + if { $VERBOSE } { + puts stdout "Received eof" + } + return $return_status + } + + -i $LOCID timeout { + msgprint -c WOKVC -e "Timeout excedeed ($timeout) from spawned process." + } + + } + return $return_status +} +;# +;# (((((((((((((((pour le desktop: ici on fait exec et c'est une catastroffe ))))))))))))))) +;#;> +;# retourne une string contenant le diff de Sfile dans les versions v1 et v2 +;#;< +proc wokIntegre:BASE:diff { sfile v1 v2 } { + return [exec sccsdiff -p $sfile -r$v1 -r$v2] +} +;#;> +;# retourne une string contenant le contenu de la version v de sfile. +;#;< +proc wokIntegre:BASE:cat { sfile {v last} } { + if { $v == "last" } { + return [exec sccs get -s -p $sfile] + } else { + return [exec sccs get -s -p -r$v $sfile] + } +} +;#;> +;# retourne une string contenant le nom de la derniere version de sfile. +;#;< +proc wokIntegre:BASE:vrs { sfile } { + return [exec prs -d:I: $sfile] +} +;#;> +;# Check for corruption +;#;< +proc wokIntegre:BASE:check { sfile } { + catch { exec admin -h $sfile } status + return $status +} +;#;> +;# fabrique de quoi afficher l'arbre des versions. +;#;< +proc wokIntegre:BASE:tree { infile fils} { + upvar $fils FILS + set l [split [exec sccs prs $infile] \n] + set len [llength $l] + for {set i 0} {$i < $len} {incr i 1} { + set s [lindex $l $i] + if { $s != {} } { + if [regexp {^D } $s] { + set p [lindex $s 6] + set next [lindex $s 5] + set lab [lindex $s 1] + set cmt [lindex $l [expr $i+3]] + if [info exists FILS($p)] { + set w $FILS($p) + } else { + set w {} + } + set data [list $lab $cmt] + lappend w [list $data $next] + set FILS($p) $w + } + } + } + return [list $data $next] +} +# +# ((((((((((((((((VERSION)))))))))))))))) +# +#;> +# Verifie que l'on peu plugger shop avec le numero ver retourne ver si OK +#;< +proc wokIntegre:Version:Check { fshop ver } { + set f [wokIntegre:Version:GetTableName $fshop 1] + set l [wokUtils:FILES:FileToList $f] + set str [wokinfo -n [wokinfo -s $fshop]] + foreach e $l { + if { [lindex $e 0] == $str } { + if { [lindex $e 1] != $ver } { + msgprint -c WOKVC -e "The shop $str is already registered with number [lindex $e 1]" + return {} + } else { + return $ver + } + } + } + set mx 0 + foreach e $l { + set n [lindex $e 1] + set mx [expr ( $mx > $n ) ? $mx : $n] + } + foreach e $l { + set n [lindex $e 1] + if {$ver < $n } { + msgprint -c WOKVC -e "Bad version number. Should be strictly greater than $mx " + return {} + } + if {$ver == $n } { + msgprint -c WOKVC -e "The version $ver is already assigned to the shop [lindex $e 0]" + return {} + } + } + return $ver +} diff --git a/src/WOKTclLib/Wok_Init.tcl b/src/WOKTclLib/Wok_Init.tcl new file mode 100755 index 0000000..237bce3 --- /dev/null +++ b/src/WOKTclLib/Wok_Init.tcl @@ -0,0 +1,29 @@ + +auto_load wok_cd_proc +auto_load wok_exit_proc +auto_load wok_source_proc +auto_load wok_setenv_proc +auto_load wokemacs + +if { [info commands tcl_exit_proc] == "" } { + rename exit tcl_exit_proc + rename wok_exit_proc exit +} + +set tcl_prompt1 {if {[info commands wokcd] != ""} then {puts -nonewline stdout "[wokcd]> "} else {puts -nonewline stdout "tclsh> "}} + +global WOK_GLOBALS; + +set WOK_GLOBALS(setenv_proc,term) 1 +set WOK_GLOBALS(setenv_proc,emacs) 1 +set WOK_GLOBALS(setenv_proc,tcl) 0 + +set WOK_GLOBALS(cd_proc,term) 1 +set WOK_GLOBALS(cd_proc,emacs) 1 +set WOK_GLOBALS(cd_proc,tcl) 1 + +set WOK_GLOBALS(source_proc,term) 1 +set WOK_GLOBALS(source_proc,emacs) 1 +set WOK_GLOBALS(source_proc,tcl) 1 + +set WOK_GLOBALS(wokinterp,tclcommands) "Winfo|finfo|pinfo|screate|sinfo|srm|ucreate|uinfo|umake|urm|w_info|wcreate|wokcd|wokclose|wokinfo|wokparam|wokprofile|wokenv|wrm|wmove|msclear|wprepare|wstore|wintegre|upack|iwok|wsrc|wdrv|wls|wcd|cd" diff --git a/src/WOKTclLib/abstract.xpm b/src/WOKTclLib/abstract.xpm new file mode 100755 index 0000000..ba6ab7d --- /dev/null +++ b/src/WOKTclLib/abstract.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char * abstract_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"16 16 4 1 -1 -1", +/* colors */ +" s topShadowColor m white c #bdbdbdbdbdbd", +". s iconGray6 m black c #636363636363", +"X s bottomShadowColor m black c #636363636363", +"o s iconColor2 m white c white", +/* pixels */ +" ", +" ..............X", +" ......oo......X", +" ......oo......X", +" .....o..o.....X", +" .....o..o.....X", +" .....o..o.....X", +" ....o....o....X", +" ....o....o....X", +" ...oooooooo...X", +" ...o......o...X", +" ...o......o...X", +" ..o........o..X", +" ..o........o..X", +" ..............X", +" XXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/admin.xpm b/src/WOKTclLib/admin.xpm new file mode 100755 index 0000000..21d2b5f --- /dev/null +++ b/src/WOKTclLib/admin.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * continued_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 5 1", +/* colors */ +" s None c None", +". c black", +"X c slate grey", +"o c white", +"O c dark slate grey", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" .. .. .. ", +" .XX. .XX. .XX. ", +".XooX. .XooX. .XooX.", +".XoXX. .XoXX. .XoXX.", +".XXXX. .XXXX. .XXXX.", +"O.XX.O O.XX.O O.XX.O", +" O..O O..O O..O ", +" OO OO OO ", +" ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/src/WOKTclLib/back.xpm b/src/WOKTclLib/back.xpm new file mode 100755 index 0000000..5bb0b57 --- /dev/null +++ b/src/WOKTclLib/back.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * dirup_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 5 1", +/* colors */ +" s None c None", +". c black", +"X c wheat", +"o c sienna", +"O c dark slate grey", +/* pixels */ +" ", +" ", +" ", +" ", +" ........ ", +" .XXXXXXXX. ", +".XXXXXXXXXX...... ", +".oXXXXXXXXoXXXXXX. ", +".XooooooooXXXXXXXo. ", +".XXXXXXXXXXXX.XXXoO.", +".XXXXXXXXXXX...XXoO.", +".XXXXXXXXXX.....XoO.", +".XXXXXXXXXXXX.XXXoO.", +".XXXXXXXXXXXX.XXXoO.", +".XX.XXX.XXXXX.XXXoO.", +".X...X...X...XXXXoO.", +".XX.XXX.XXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +" .oooooooooooooooOO.", +" .OOOOOOOOOOOOOOO.O", +" ...............O "}; diff --git a/src/WOKTclLib/browser.xpm b/src/WOKTclLib/browser.xpm new file mode 100755 index 0000000..d7adc32 --- /dev/null +++ b/src/WOKTclLib/browser.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char * browser_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 12 1 0 0", +/* colors */ +" s iconGray4 m white c #949494949494", +". s iconGray2 m white c #bdbdbdbdbdbd", +"X s iconColor1 m black c black", +"o c #FFFF63634747", +"O c #B2B222222222", +"+ s iconColor2 m white c white", +"@ c #BEBEBEBEBEBE", +"# s iconColor6 m white c yellow", +"$ c #A0A02020F0F0", +"% c #EEEE8282EEEE", +"& c #1E1E9090FFFF", +"* c #3232CDCD3232", +/* pixels */ +" ...........X ", +" .oOoOoOoOoOX ", +" .OoOoOoOoOoX ", +" .oOoOoOoOoOX ", +" .OoOoOoOoOoX ", +" .oOoOXXXXXXX ", +" .......OoOoX ", +" .oOoOoOoOoOX ", +" .OoOoOoOoOoX ", +" .oOoOoOoOoOX ", +" .OoOoOoOoOoX ", +" .XXXXXXXXXXX ", +" ", +" +++ +++ + ", +" ..... + + + + .....X ", +" .@#@#X + + + + .$%$%X ", +" .#@#@X + + + + .%$%$X ", +" .@#@#X + + + + .$%$%X ", +" .#@#@X +++ +++ +++ .%$%$X ", +" .@#@#X .$%$%X ", +" .#@#@X.....X...........X.%$%$X ", +" .@#@#@#@#@#X.&*&*&*&*&*X.$%$%X ", +" .#@#@#@#@#@X.*&*&*&*&*&X.%$%$X ", +" .@#@#@#@#@#X.&*&*&*&*&*X.$%$%X ", +" .#@#@#@#@#@X.*&*&*&*&*&X.%$%$X ", +" .@#@#XXXXXXX.&*&*XXXXXXX.$%$%X ", +" .#@#@X.......*&*&X.......%$%$X ", +" .@#@#X.&*&*&*&*&*X.$%$%$%$%$%X ", +" .#@#@X.*&*&*&*&*&X.%$%$%$%$%$X ", +" .@#@#X.&*&*&*&*&*X.$%$%$%$%$%X ", +" .#@#@X.*&*&*&*&*&X.%$%$%$%$%$X ", +" .XXXXX.XXXXXXXXXXX.XXXXXXXXXXX "}; diff --git a/src/WOKTclLib/bycol.xbm b/src/WOKTclLib/bycol.xbm new file mode 100755 index 0000000..2ab6033 --- /dev/null +++ b/src/WOKTclLib/bycol.xbm @@ -0,0 +1,8 @@ +#define textrect0_width 16 +#define textrect0_height 16 +#define textrect0_x_hot -1 +#define textrect0_y_hot -1 +static char textrect0_bits[] = { + 0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0xc2, 0x4f, 0x02, 0x40, 0xf2, 0x4f, + 0x02, 0x40, 0xf2, 0x4f, 0x02, 0x40, 0xf2, 0x4f, 0x02, 0x40, 0xf2, 0x4f, + 0x02, 0x40, 0xf2, 0x43, 0x02, 0x40, 0xfe, 0x7f}; diff --git a/src/WOKTclLib/bylast.xbm b/src/WOKTclLib/bylast.xbm new file mode 100755 index 0000000..1d19c36 --- /dev/null +++ b/src/WOKTclLib/bylast.xbm @@ -0,0 +1,6 @@ +#define search_width 16 +#define search_height 16 +static char search_bits[] = { + 0x00, 0x00, 0xfc, 0x7f, 0x02, 0x00, 0xfc, 0x1f, 0x00, 0x20, 0xf0, 0x1f, + 0x08, 0x00, 0xf0, 0x07, 0x00, 0x08, 0x80, 0x07, 0x80, 0x00, 0xf0, 0x07, + 0xe0, 0x03, 0xc0, 0x01, 0x80, 0x00, 0x00, 0x00}; diff --git a/src/WOKTclLib/bylong.xbm b/src/WOKTclLib/bylong.xbm new file mode 100755 index 0000000..404218b --- /dev/null +++ b/src/WOKTclLib/bylong.xbm @@ -0,0 +1,6 @@ +#define clock_width 16 +#define clock_height 16 +static char clock_bits[] = { + 0xc0,0x03,0x2c,0x04,0xec,0x07,0xc8,0x03,0xe8,0x0f,0x18,0x14,0x04,0x2a,0x04, + 0x2b,0x82,0x51,0xc2,0x50,0xc2,0x50,0x82,0x51,0x04,0x29,0x04,0x38,0x1e,0x7e, + 0xe6,0x6f}; diff --git a/src/WOKTclLib/byrow.xbm b/src/WOKTclLib/byrow.xbm new file mode 100755 index 0000000..d67ac8a --- /dev/null +++ b/src/WOKTclLib/byrow.xbm @@ -0,0 +1,6 @@ +#define txt_modify_width 16 +#define txt_modify_height 16 +static char txt_modify_bits[] = { + 0x06, 0x00, 0x09, 0x00, 0x09, 0x00, 0x0f, 0x00, 0x09, 0x00, 0xc9, 0x01, + 0x40, 0x02, 0x40, 0x02, 0xc0, 0x01, 0x40, 0x02, 0x40, 0xe2, 0xc0, 0x91, + 0x00, 0x10, 0x00, 0x10, 0x00, 0x90, 0x00, 0xe0}; diff --git a/src/WOKTclLib/caution.xpm b/src/WOKTclLib/caution.xpm new file mode 100755 index 0000000..f14001f --- /dev/null +++ b/src/WOKTclLib/caution.xpm @@ -0,0 +1,57 @@ +/* XPM */ +static char * caution_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"40 44 7 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #DCDCDCDCDCDC", +"o s iconColor3 m black c red", +"O c #707080809090", +"+ s iconColor2 m white c white", +"@ c #2E2E8B8B5757", +/* pixels */ +" ", +" ", +" ", +" ..... ", +" ..X.X.. ", +" ..XXXXX... ", +" ..XXXXXXXX.. ", +" .XXXXXXXXXX.. ", +" ..XXXXXXXXX... ", +" .XXXXXXXXXX..... ", +" ..XXXXXXXXXXXXX.. ", +" ..XXXXXXXXXX..... ", +" .XXXXXXXXX....... ", +" ..XXXXXXXX...o..X. ", +" ....XXXXX..oo..XX. ", +" ...XX...X......XX.. ", +" ..X.....X.XX.XXX.X.. ", +" .X...o..X.X...X.XX.. ", +" ....oo.X...XX....XX.. ", +" ......XX...XX....X.. ", +" .......X.XXXX....O. ", +" .XX.X.XXXXXX...X.. ", +" .XXX..XXXX.....X.. . ", +" .XXX..XX...+...X. .... ", +" ..........+.+...X.....X... ", +" ..XX.....+.+.....X...XXXX.. ", +" ..XXX.....+...+..X.XXXXXXX.. ", +" ..XXXX.X.....++..X.OOXOXXXX.. ", +" ..XOXX.X...++XOXXXOXXOXOXO..@. ", +" ..XOOX.X....XOXXX......XO.... ", +" ..X...X..X.XXXX........... ", +" .......XXXXXX...@@@@@@@..O ", +" ..@@@.@@@..X.X..@@@@@@@..OOOOO ", +" .@@@@@@@@@.X...@@@@@@@..OOOOO ", +" ..@@@@@...XOX.@@@@@@..OOOOO ", +" ..@@@...XX.@@@@@..OOOOO ", +" OOO...XXXX..@@@..OOOOO ", +" OOOOO..XXXX..@..OOOOO ", +" OOO..XOXXX...OOOOO ", +" O..XOXX..OOOOO ", +" ..XXOX.OOOO ", +" .....OOO ", +" ....O ", +" "}; diff --git a/src/WOKTclLib/cback.xpm b/src/WOKTclLib/cback.xpm new file mode 100755 index 0000000..be18bcb --- /dev/null +++ b/src/WOKTclLib/cback.xpm @@ -0,0 +1,37 @@ +/* XPM */ +static char *DocsLeftArrowSmall_xpm[] = { +/* width height ncolors chars_per_pixel */ +"15 15 15 1", +/* colors */ +"` c #77868F", +"a c #556067", +"b c #CFD4D7", +"c c #B5BDC2", +"d c #8C98A0", +"e c #7E8C95", +"f c #606C74", +"g c #4F5A60", +"h c #6C7A83", +"i c #A7B0B6", +"j c #C2C9CD", +"k c #99A4AB", +"l c #EBEDEE", +"m c #AEB7BC", +"n c #DDE1E3", +/* pixels */ +"llllllllllnlllf", +"lbimbbcmbnjjjch", +"lkcicjjbjbfbbn`", +"ljjmjjmcegfjbbd", +"ljbjccdaafhjbjd", +"lcjijaahhd`cjc`", +"lmjfaaaede`jjjf", +"lbbhfh`ededcjjf", +"lcccchheddejjjd", +"lkkjbbke`khmcjf", +"ljmnjbbmdddmmni", +"lijcimjkbj`bmbf", +"ljbjcjbmckjnjih", +"ljbjcjbmckjnjih", +"ffddkiiefhkifdi" +}; diff --git a/src/WOKTclLib/ccl.xpm b/src/WOKTclLib/ccl.xpm new file mode 100755 index 0000000..7187d10 --- /dev/null +++ b/src/WOKTclLib/ccl.xpm @@ -0,0 +1,53 @@ +/* XPM */ +static char * ccl_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 21 1 0 0", +/* colors */ +" s none m none c none", +". c #999980805555", +"X c #66668080AAAA", +"o c #CCCCBFBFAAAA", +"O s iconColor1 m black c black", +"+ s iconColor2 m white c white", +"@ c #333340405555", +"# c #333360605555", +"$ c #FFFFDFDFFFFF", +"% c #FFFFFFFFAAAA", +"& c #CCCC20200000", +"* c #CCCC40400000", +"= c #999920205555", +"- c #CCCC80805555", +"; c #CCCC9F9F5555", +": c #CCCC80800000", +"? c #333360600000", +"> c #333380805555", +", c #000040405555", +"< c #33339F9F5555", +"1 c #00008080AAAA", +/* pixels */ +" ", +" ", +" ", +" .XoO.O ", +" oO++O XO ", +" .OOXoo+O oO ", +" XO++O O+O OO ", +" OooXO .O ", +" OXOo @ ", +" o.O #$% & ", +" XO #+%+O+*= ", +" Oo &$%O%$%%O$& ", +" #+O-O=%+%+%O%OO ", +" @#+%$O-O=%+%$%OO ", +" # O+%+O+%O;OOOOO ", +" O=%%%$%O%O%%:O?>>O ", +" OO=%+%+%O%+&O#,#>><>O ", +" O#@OOO@#@#><>OO ", +" OO?@#@O@#@?>>>OX.X ", +" O<1<>#,#><1<>>> c #333380805555", +", c #000040405555", +"< c #33339F9F5555", +"1 c #00008080AAAA", +" ", +" ", +" ", +" .XoO.O ", +" oO++O XO ", +" .OOXoo+O oO ", +" XO++O O+O OO ", +" OooXO .O ", +" OXOo @ ", +" o.O #$%+& ", +" XO #+%+O+*= ", +" Oo &$%O%$%%O$& ", +" #+O-O=%+%+%O%OO ", +" @#+%$O-O=%+%$%OO ", +" #+O+%+O+%O;OOOOO ", +" O=%%%$%O%O%%:O?>>O ", +" OO=%+%+%O%+&O#,#>><>O ", +" O#@OOO@#@#><>OO ", +" OO?@#@O@#@?>>>OX.X ", +" O<1<>#,#><1<>>> c #00008080FFFF", +", c #66668080AAAA", +"< c #999980805555", +"1 c #333380805555", +"2 c #CCCC20200000", +"3 c #33339F9FFFFF", +"4 c #33339F9F5555", +"5 c #000040405555", +"6 c #FFFFDFDFAAAA", +"7 c #333360600000", +"8 c #3333BFBF0000", +"9 c #3333DFDF5555", +"0 c #CCCC9F9F5555", +"q c #CCCC80805555", +"w c #CCCC80800000", +"e c #00008080AAAA", +/* pixels */ +" ", +" ", +" . ", +" ..Xo.. ", +" ..O+X@#$. ", +" .%&*&=&-&;. ", +" ;&;:;**?;>;&. ", +" ;,<&1,%:2&3&;. ", +" 145;$,:;$;$;&. ", +" 41;&6,6&6&6&;.; ", +" &4&;$;$;$;$;&;: ", +" 7&1&6&2&3&8:+ ", +" 54&;:;&%:9+O+ ", +" ;14,%&%:%:+++ ", +" &014+O+++O++: ", +" 7qwq++++++++%11. ", +" 50q0+O+O+O+%:414. ", +" ;qwq%:++++%&;141. ", +" &4q4:%:9:;141.. ", +" ..7111%:8&7111.,<, ", +" .4e;&4:;&4e4.,,, ", +" <,.141114..,<, ", +" ,,,..414.,,, ", +" <,<,.,<, ", +" ,,,, ", +" , "}; diff --git a/src/WOKTclLib/delivery_open.xpm b/src/WOKTclLib/delivery_open.xpm new file mode 100755 index 0000000..8804ecd --- /dev/null +++ b/src/WOKTclLib/delivery_open.xpm @@ -0,0 +1,62 @@ +/* XPM */ +static char * delivery_open_xpm[] = { +"24 26 33 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #99992020FFFF", +"o c #CCCC2020AAAA", +"O c #FFFFBFBF0000", +"+ c #FFFF9F9F0000", +"@ c #6666BFBFFFFF", +"# c #FFFFDFDF0000", +"$ c #CCCCDFDFFFFF", +"% c #3333DFDF0000", +"& c #333340405555", +"* c #9999FFFFAAAA", +"= c #FFFF00000000", +"- c #9999DFDFFFFF", +"; c #333360605555", +": c #3333BFBF5555", +"? c #999920205555", +"> c #00008080FFFF", +", c #66668080AAAA", +"< c #999980805555", +"1 c #333380805555", +"2 c #CCCC20200000", +"3 c #33339F9FFFFF", +"4 c #33339F9F5555", +"5 c #000040405555", +"6 c #FFFFDFDFAAAA", +"7 c #333360600000", +"8 c #3333BFBF0000", +"9 c #3333DFDF5555", +"0 c #CCCC9F9F5555", +"q c #CCCC80805555", +"w c #CCCC80800000", +"e c #00008080AAAA", +" ", +" ", +" . ", +" ..Xo.. ", +" ..O+X@#$. ", +" .%&*&=&-&;. ", +" ;&;:;**?;>;&. ", +" ;,<&1,%:2&3&;. ", +" 145;$,:;$;$;&. ", +" 41;&6,6&6&6&;.; ", +" &4&;$;$;$;$;&;: ", +" 7&1&6&2&3&8:+ ", +" 54&;:;&%:9+O+ ", +" ;14,%&%:%:+++ ", +" &014+O+++O++: ", +" 7qwq++++++++%11. ", +" 50q0+O+O+O+%:414. ", +" ;qwq%:++++%&;141. ", +" &4q4:%:9:;141.. ", +" ..7111%:8&7111.,<, ", +" .4e;&4:;&4e4.,,, ", +" <,.141114..,<, ", +" ,,,..414.,,, ", +" <,<,.,<, ", +" ,,,, ", +" , "}; diff --git a/src/WOKTclLib/dep.tcl b/src/WOKTclLib/dep.tcl new file mode 100755 index 0000000..40adb1a --- /dev/null +++ b/src/WOKTclLib/dep.tcl @@ -0,0 +1,193 @@ +# tri topologik. retourne une liste +# Exemple wokUtils:EASY:tsort { {a h} {b g} {c f} {c h} {d i} } +# => { d a b c i g f h } +#wokUtils:EASY:tsort { listofpairs } + +proc ClientTree {w fromud location meter} { + global ClientTree_arrayofud ClientTree_arrayofimpl ClientTree_Stop ClientTree_FileName + set ClientTree_Stop 0 + + if {[winfo exist $w]} { + destroy $w + } + + if {[info exist ClientTree_arrayofud]} { + unset ClientTree_arrayofud + } + + if {[info exist ClientTree_arrayofimpl]} { + unset ClientTree_arrayofimpl + } + + set ClientTree_arrayofud(__uu) 0 + set ClientTree_arrayofimpl(__uu) 0 + + tixTree $w + set hlist [$w subwidget hlist] + + $hlist config -indicator 1 -selectmode single -separator "-" -width 30 -drawbranch 1 -indent 30 + + tixForm $w -left 0 -right -0 -top 0 -bottom -0 + tixBusy $w on + wokPROP:Meter $meter 1000 0 + update + [wokPROP:LabClt] configure -text "Hit Escape to stop..." + bind $hlist { + global ClientTree_Stop + set ClientTree_Stop 1 + [wokPROP:LabClt] configure -text "Interrupted..." + update + } + focus $hlist + + ClientTree_GetDependence $w $location $fromud $ClientTree_FileName $meter + $w autosetmode + + tixBusy $w off + [wokPROP:LabClt] configure -text "Ready..." + update + + return $ClientTree_arrayofud(__uu) +} + +proc ClientTree_GetDependence {wtree location fromud targetinclude meter} { + global ClientTree_arrayofud ClientTree_Stop + + set usetinclude 1 + set w [$wtree subwidget hlist] + set lstud [w_info -l $location] + set progress 0 + set maxrange [llength $lstud] + + if {$targetinclude == ""} { + set usetinclude 0 + } + + foreach ud $lstud { + update + set ifile "" + set lstofimpl {} + set ifile [woklocate -p ${ud}:stadmfile:${ud}_obj_comp.Dep $location] + + if {$ClientTree_Stop} return + + if {$ifile != ""} { + set lstinc {} + set vcxx "" + set vhxx "" + set vsource "" + for_file allud $ifile { + if {$ClientTree_Stop} return + ## we search for string like this: + ## + Storage:object:Storage_BaseDriver.o Storage:source:Storage_BaseDriver.cxx + ## + if {[string index $allud 0] == "+"} { + ## we shoot these kinds of strings: + ## + Storage:stadmfile:Storage_obj_comp.In Storage:admfile:Storage_src.Out + ## + * Storage:dbadmfile:Storage_xcpp_header.Out + ## + if {[string first "admfile:" $allud] < 0} { + ## we look for a source file including our package + ## + if {$vsource != "" && $lstinc != {}} { + lappend lstofimpl $vsource $lstinc + if {[$w info exist $ud] == 0} { + $w add $ud -text $ud + $w see $ud + } + set i 0 + set nomsrc "" + regexp {([^:]*):([^:]*):([^:]*)} $vsource all av avv nomsrc + $w add $ud-$vsource -text $nomsrc + $w hide entry $ud-$vsource + foreach u $lstinc { + incr i + $w add $ud-$vsource-$i -text $u + $w hide entry $ud-$vsource-$i + if {$ClientTree_Stop} return + } + update + if {$ClientTree_Stop} return + } + scan $allud "%s %s %s" vs vo vsource + set lstinc {} + } + } else { + update + if {$ClientTree_Stop} return + scan $allud "- * %s" vcxx + if {[string first :${fromud}_${ud}_ $vcxx] >= 0} { + scan $vcxx "$ud:pubinclude:%s" vhxx + if {$usetinclude} { + if {$vhxx == $targetinclude} { + lappend lstinc $vhxx + } + } else { + lappend lstinc $vhxx + } + } elseif {[string first :${fromud}_${ud}. $vcxx] >= 0} { + scan $vcxx "$fromud:pubinclude:%s" vhxx + if {$usetinclude} { + if {$vhxx == $targetinclude} { + lappend lstinc $vhxx + } + } else { + lappend lstinc $vhxx + } + } elseif {[string first :${fromud}. $vcxx] >= 0} { + scan $vcxx "$fromud:pubinclude:%s" vhxx + if {$usetinclude} { + if {$vhxx == $targetinclude} { + lappend lstinc $vhxx + } + } else { + lappend lstinc $vhxx + } + } elseif {[string first :${fromud}_ $vcxx] >= 0} { + scan $vcxx "$fromud:pubinclude:%s" vhxx + if {$usetinclude} { + if {$vhxx == $targetinclude} { + lappend lstinc $vhxx + } + } else { + lappend lstinc $vhxx + } + } elseif {[string first Handle_${fromud}_ $vcxx] >= 0} { + scan $vcxx "$fromud:pubinclude:%s" vhxx + if {$usetinclude} { + if {$vhxx == $targetinclude} { + lappend lstinc $vhxx + } + } else { + lappend lstinc $vhxx + } + } + } + } + ## we look for a source file including our package + ## + if {$vsource != "" && $lstinc != {}} { + lappend lstofimpl $vsource $lstinc + if {[$w info exist $ud] == 0} { + $w add $ud -text $ud + $w see $ud + } + set i 0 + set nomsrc "" + regexp {([^:]*):([^:]*):([^:]*)} $vsource all av avv nomsrc + $w add $ud-$vsource -text $nomsrc + $w hide entry $ud-$vsource + foreach u $lstinc { + incr i + $w add $ud-$vsource-$i -text $u + $w hide entry $ud-$vsource-$i + if {$ClientTree_Stop} return + } + update + if {$ClientTree_Stop} return + } + } + set ClientTree_arrayofud($ud) $lstofimpl + set progress [wokPROP:Meter $meter $maxrange $progress] + } +} diff --git a/src/WOKTclLib/documentation.xpm b/src/WOKTclLib/documentation.xpm new file mode 100755 index 0000000..33e3d2e --- /dev/null +++ b/src/WOKTclLib/documentation.xpm @@ -0,0 +1,57 @@ +/* XPM */ +static char * documentation_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 25 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #FFFFFFFFAAAA", +"o c #333360605555", +"O c #CCCC80805555", +"+ c #FFFFDFDFAAAA", +"@ c #333340405555", +"# c #66668080AAAA", +"$ c #CCCCDFDFFFFF", +"% c #FFFFDFDFFFFF", +"& s iconColor2 m white c white", +"* c #CCCCDFDFAAAA", +"= c #33339F9FFFFF", +"- c #999920205555", +"; c #CCCC20200000", +": c #00008080FFFF", +"? c #CCCC40400000", +"> c #999920200000", +", c #CCCC80800000", +"< c #FFFF80800000", +"1 c #CCCC9F9F5555", +"2 c #999940405555", +"3 c #999960600000", +"4 c #CCCC60600000", +"5 c #999980805555", +/* pixels */ +" ", +" ", +" ", +" .X ", +" X. ", +" oOX. +++. ", +" . o@X#X +..++$ ", +" XXOX@o%X.&&+++. ", +" .&X#o&X&+..$+*+.= ", +" . X-;&X%X&X...++++.: ", +" X.?-.&X&X&X.......= ", +" X%;OXO;>;.XXX%.. .. ", +" .&X.?-;.X&X&X. ", +" X..-;-.&X.X&. ", +" X&...&X&X... ", +" .%XX.%X.,O c #999920200000", +", c #CCCC80800000", +"< c #FFFF80800000", +"1 c #CCCC9F9F5555", +"2 c #999940405555", +"3 c #999960600000", +"4 c #CCCC60600000", +"5 c #999980805555", +" ", +" ", +" ", +" .X ", +" oX. ", +" oO+X. @@@. ", +" .oO#X$Xo@..@@% ", +" XX+X#O&X.oo@@@. ", +" o.oX$OoXo@..%@*@.= ", +" .oX-;oX&XoX...@@@@.: ", +" oX.?-.oXoXoX.......= ", +" X&;+X+;>;.XXX&.. .. ", +" .oX.?-;.XoXoX. ", +" X..-;-.oX.Xo. ", +" Xo...oXoX... ", +" .&XX.&X.,+<+,. ", +" X.XoXo.+1+1+1. ", +" ..X&X..+,+,+,+. ", +" .123...++1+++.. ", +" ..<+,+4..+<+,+.$5$ ", +" .1+1+1+1+1+1.$$$ ", +" 5$.+,+,+,..$5$ ", +" $$$..++1.$$$ ", +" 5$5$.$5$ ", +" $$$$ ", +" $ "}; diff --git a/src/WOKTclLib/engine.xpm b/src/WOKTclLib/engine.xpm new file mode 100755 index 0000000..776613a --- /dev/null +++ b/src/WOKTclLib/engine.xpm @@ -0,0 +1,54 @@ +/* XPM */ +static char * engine_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 22 1 0 0", +/* colors */ +" s none m none c none", +". c #CCCCBFBFAAAA", +"X c #9999BFBFFFFF", +"o c #66668080AAAA", +"O c #CCCCDFDFFFFF", +"+ c #999980805555", +"@ c #333340405555", +"# c #333360605555", +"$ c #333360600000", +"% c #FFFFDFDFAAAA", +"& s iconColor1 m black c black", +"* c #999920205555", +"= c #CCCC40400000", +"- c #999920200000", +"; c #CCCC20200000", +": s iconColor2 m white c white", +"? c #CCCCBFBFFFFF", +"> c #000040405555", +", c #CCCC80800000", +"< c #CCCC80805555", +"1 c #CCCC9F9F5555", +"2 c #FFFF80800000", +/* pixels */ +" ", +" ", +" .XoX.X.XOO ", +" ..+@..#@$o#o%o ", +" Xo@#X.X#XoX.OO ", +" ..#.%.+@#.+& ", +" o.@.o.X.X&&&*= ", +" +@+..&&*&-&*;- ", +" &&X.&;&=*&*&*& ", +" &&...&&;.;.;& ", +" =*.X.X&&.*.*& ", +" -;*;&.&&.;*;- ", +" &*&@=*&*=&;&=*; ", +" &*;*;*;&;*;&;&&& ", +" =O#*&&;*=&;*=oo& ", +" $::?;&&&&-&&+&+o$ ", +" >O:#*&&=*;&oo&&o>& ", +" &&&*,&&&&&+o&&&<&& ", +" &&&&&&&&&&&&o&1&o ", +" &&&&@&&#&+&&&2&+o+ ", +" &&&&&&&&&&&1&&ooo ", +" o+@&&,<,<&o+o ", +" oooo@<<1<&&oo ", +" +o+o&&+o+ ", +" ooo ", +" + "}; diff --git a/src/WOKTclLib/engine_open.xpm b/src/WOKTclLib/engine_open.xpm new file mode 100755 index 0000000..ecd7eb3 --- /dev/null +++ b/src/WOKTclLib/engine_open.xpm @@ -0,0 +1,51 @@ +/* XPM */ +static char * engine_open_xpm[] = { +"24 26 22 1", +" c #FFFFFFFF0000", +". c #CCCCBFBFAAAA", +"X c #9999BFBFFFFF", +"o c #66668080AAAA", +"O c #CCCCDFDFFFFF", +"+ c #999980805555", +"@ c #333340405555", +"# c #333360605555", +"$ c #333360600000", +"% c #FFFFDFDFAAAA", +"& c #000000000000", +"* c #999920205555", +"= c #CCCC40400000", +"- c #999920200000", +"; c #CCCC20200000", +": c #FFFFFFFFFFFF", +"? c #CCCCBFBFFFFF", +"> c #000040405555", +", c #CCCC80800000", +"< c #CCCC80805555", +"1 c #CCCC9F9F5555", +"2 c #FFFF80800000", +" ", +" ", +" .XoX.X.XOO ", +" ..+@..#@$o#o%o ", +" Xo@#X.X#XoX.OO ", +" ..#.%.+@#.+& ", +" o.@.o.X.X&&&*= ", +" +@+..&&*&-&*;- ", +" &&X.&;&=*&*&*& ", +" &&...&&;.;.;& ", +" =*.X.X&&.*.*& ", +" -;*;&.&&.;*;- ", +" &*&@=*&*=&;&=*; ", +" &*;*;*;&;*;&;&&& ", +" =O#*&&;*=&;*=oo& ", +" $::?;&&&&-&&+&+o$ ", +" >O:#*&&=*;&oo&&o>& ", +" &&&*,&&&&&+o&&&<&& ", +" &&&&&&&&&&&&o&1&o ", +" &&&&@&&#&+&&&2&+o+ ", +" &&&&&&&&&&&1&&ooo ", +" o+@&&,<,<&o+o ", +" oooo@<<1<&&oo ", +" +o+o&&+o+ ", +" ooo ", +" + "}; diff --git a/src/WOKTclLib/envir.xpm b/src/WOKTclLib/envir.xpm new file mode 100755 index 0000000..0436574 --- /dev/null +++ b/src/WOKTclLib/envir.xpm @@ -0,0 +1,54 @@ +/* XPM */ +static char * envir60_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 22 1 0 0", +/* colors */ +" s none m none c none", +". c #AAAAAAAAAAAA", +"X c #3E3E3E3E3E3E", +"o c #515151515151", +"O c #2F2F2F2F2F2F", +"+ c cyan", +"@ c #777777777777", +"# c cyan", +"$ c #7D7D7D7D7D7D", +"% s iconColor1 m black c black", +"& c blue", +"* c blue", +"= c blue", +"- c green", +"; c cyan", +": c #838383838383", +"? s iconGray2 m white c #bdbdbdbdbdbd", +"> c red", +", c #646464646464", +"< c #767676767676", +"1 c #484848484848", +"2 c #5E5E5E5E5E5E", +/* pixels */ +" ", +" ", +" ", +" ..X ", +" .oO+ ", +" .X+@+# .Xo ", +" $#+#+#%.o&*& ", +" $+@+%%.o=-=- ", +" $#+.oO*&*&*& ", +" ;+#:=*&-=*&- ", +" ;#+$*&*&*& & ", +" ;+@:=-=%%. - ", +" ;#+;*%?Xo> & ", +" ;+#;%.X>>> - ", +" ;#%.o>>>>> ", +" ;%$>>>>>>> , ", +" ;%$>>>>>>> ,< ", +" ;%$>>>>>>> <, ", +" oX;%;>>>>>%, ", +" 1Xo%%;>>>>%,%$:$ ", +" <2oXo%;>%%<%$$$ ", +" :$%, c #1C1C1C1C1C1C", +", c #646464646464", +"< c #767676767676", +"1 c #484848484848", +"2 c #5E5E5E5E5E5E", +/* pixels */ +" ", +" ", +" ", +" ..X ", +" .oO+ ", +" .X+@+# .Xo ", +" $#+#+#%.o&*& ", +" $+@+%%.o=-=- ", +" $#+.oO*&*&*& ", +" ;+#:=*&-=*&- ", +" ;#+$*&*&*& & ", +" ;+@:=-=%%. - ", +" ;#+;*%?Xo> & ", +" ;+#;%.X>>> - ", +" ;#%.o>>>>> ", +" ;%$>>>>>>> , ", +" ;%$>>>>>>> ,< ", +" ;%$>>>>>>> <, ", +" oX;%;>>>>>%, ", +" 1Xo%%;>>>>%,%$:$ ", +" <2oXo%;>%%<%$$$ ", +" :$%, c #CCCCBFBFFFFF", +", c #CCCC40400000", +"< c #CCCC20200000", +"1 c #999920205555", +/* pixels */ +" ", +" ", +" .XoOo+ ", +" +@+@+#X@X@ ", +" o$O+oXOOoX ", +" .X%+.X.%%%% ", +" &+.+oX%%%+.+**& ", +" *.=#X@%%+&*-;%* ", +" **+:$:+.&*;?;;;?;& ", +" &-*-+-+.*%;%;%;%;%& ", +" &+***+.*;;%;;;%;;;& ", +" &#&&+-*%>%;%>%;%>%& ", +" +.$.+.$.;?;;;?;;;?;& ", +" .+.+.+&+%;%;%;%;%;%& ", +" &+.+;&.;;;%;;;%;;& ", +" &#&&+#+%>%;%>%;%& ", +" &$.&.$.;?;;;?;&&,& ", +" &+&+.+%;%;%&.+<1& ", +" &.&.+.;;;&+.1&& ", +" &&#+.&#+%&&+<1&*-* ", +" &,1.+.$.+.1<&*** ", +" -*&1<1.+<&&*-* ", +" ***&&<1,&*** ", +" -*-*&*-* ", +" **** ", +" * "}; diff --git a/src/WOKTclLib/executable_open.xpm b/src/WOKTclLib/executable_open.xpm new file mode 100755 index 0000000..778e189 --- /dev/null +++ b/src/WOKTclLib/executable_open.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char * executable_open_xpm[] = { +"24 26 21 1", +" c #FFFFFFFF0000", +". c #333360605555", +"X c #999940405555", +"o c #999960600000", +"O c #999960605555", +"+ c #333340405555", +"@ c #CCCC60600000", +"# c #333360600000", +"$ c #000040405555", +"% c #FFFFDFDFAAAA", +"& c #000000000000", +"* c #66668080AAAA", +"= c #CCCC9F9FAAAA", +"- c #999980805555", +"; c #CCCCDFDFFFFF", +": c #CCCCBFBFAAAA", +"? c #CCCCDFDFAAAA", +"> c #CCCCBFBFFFFF", +", c #CCCC40400000", +"< c #CCCC20200000", +"1 c #999920205555", +" ", +" ", +" .XoOo+ ", +" +@+@+#X@X@ ", +" o$O+oXOOoX ", +" .X%+.X.%%%% ", +" &+.+oX%%%+.+**& ", +" *.=#X@%%+&*-;%* ", +" **+:$:+.&*;?;;;?;& ", +" &-*-+-+.*%;%;%;%;%& ", +" &+***+.*;;%;;;%;;;& ", +" &#&&+-*%>%;%>%;%>%& ", +" +.$.+.$.;?;;;?;;;?;& ", +" .+.+.+&+%;%;%;%;%;%& ", +" &+.+;&.;;;%;;;%;;& ", +" &#&&+#+%>%;%>%;%& ", +" &$.&.$.;?;;;?;&&,& ", +" &+&+.+%;%;%&.+<1& ", +" &.&.+.;;;&+.1&& ", +" &&#+.&#+%&&+<1&*-* ", +" &,1.+.$.+.1<&*** ", +" -*&1<1.+<&&*-* ", +" ***&&<1,&*** ", +" -*-*&*-* ", +" **** ", +" * "}; diff --git a/src/WOKTclLib/factory.xpm b/src/WOKTclLib/factory.xpm new file mode 100755 index 0000000..1c12a84 --- /dev/null +++ b/src/WOKTclLib/factory.xpm @@ -0,0 +1,51 @@ +/* XPM */ +static char * home3_xpm[] = { +/* width height ncolors chars_per_pixel */ +"32 32 13 1", +/* colors */ +" c none m none c none", +". c slate grey", +"X c black", +"o c sienna", +"O c orange", +"+ c red", +"@ c tan", +"# c wheat", +"$ c lime green", +"% c sky blue", +"& c dodger blue", +"* c sea green", +"= c peru", +/* pixels */ +" ", +" . .. .. ", +" .. . . . ", +" . ", +" . ", +" XXX ", +" XoX ", +" XXXXXoXXXXXXXXXXXX ", +" XOOOXXOOO+OOOO+OOX ", +" XXOO+O+OO+OOOO+OOO+X ", +" X@X+OOO+OOOO+OOOO+OX ", +" X@@XOO+OOOO+OOOO+OOOOX ", +" XX@XX+OOO+OO+O+OO+O+OX ", +" XoX@XOOO+OOOOOO+OOOOOOX ", +" X#oXXXXXXXXXXXXXXXXXXXX ", +" X##oXoooooooooooooooo#X ", +" X#X#X#################X ", +" X#X#X##XX###XX###ooo##X ", +" X#X#X#X%&X#X%&X#o###o#X ", +" X#X#X#X%&X#X%&X##XXX##X ", +" *X###X#X&&X#X&&X#X===X#X* ", +" *$X###X#XXXX#XXXX#X===X#X$*$ ", +" $$$X###X###########X===X#X$$*$ ", +"$*$*X#*#X###########XX==X#X**$*$", +"$$$$$X*#X##*#####*##X===X#X$$*$*", +"**$*$$*#X#*###*#*###X===X#X*$$*$", +"$$$*$*$XX#*#*#*#*#*#XXXXX#X$*$*$", +"*$*$$**$XX*X*X*X*X*XX@@@XXX*$$$*", +" *$$$**$*$*$**$$*$*$$@@@@$$$$*$ ", +" **$$$$*$**$$$*$*$$$*@@@@*$** ", +" $$*$$$$**$*$*$**$@@@ ", +" "}; diff --git a/src/WOKTclLib/factory_open.xpm b/src/WOKTclLib/factory_open.xpm new file mode 100755 index 0000000..8f00d45 --- /dev/null +++ b/src/WOKTclLib/factory_open.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * factory_open_xpm[] = { +"28 28 12 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #99998080AAAA", +"o c #99999F9FAAAA", +"O c #FFFFFFFFFFFF", +"+ c #FFFF00000000", +"@ c #CCCCBFBFAAAA", +"# c #9999BFBFFFFF", +"$ c #00000000FFFF", +"% c #CCCC9F9FAAAA", +"& c #FFFF0000FFFF", +"* c #0000FFFF0000", +" .... ", +" .X... ", +" .........oo......... ", +" .O+++++++++...++++++++. ", +"..O.++++++++++++++++++++ ", +"OO...+++...+++...+++...+ ", +".O..+...+++...+++...+++.. ", +"@....+++...+++...+++...++ ", +"#@.OO.+++++++++++++++++++. ", +"@.@.O.++++++++++++++++++++. ", +"#$.@...++++++++++++++++++++ ", +"@$.%@...+++...+++...+++...+ ", +"#..@.@......................", +"@@@@$.@@@@@@@@@@@@@@@@@@@@@.", +"#@#@$.#@#@..#@#.#@#..@#..@#.", +"@@@%..@%@@$$.@.$.@.$.@.$.@@.", +"#@.@#@#@#@...@...@...@...@#.", +"@.@@.@@@@@...@...@...@...@@.", +"#$.@&.#@#.#@#@.@#@.@#@#@#@#.", +"@$.%@.@%@.@%@@.%. ..@@.%@@@.", +"#..@#@#@#@#@#@#@. .#@#@#@#.", +".@..*.@@.@@@@@@.@@.@@@@@@@@.", +" .#.*.#@#$...$.@#@.@#.......", +" ...*.@%@$...$.%@.*.@.......", +" .*.#@#$...$.@.**.........", +" ..@@@......@..*..@@@@@@.", +" .#@#......@.**..@#.#@#.", +" .%.@@.@@@%.......%@@.."}; diff --git a/src/WOKTclLib/file.xpm b/src/WOKTclLib/file.xpm new file mode 100755 index 0000000..9f9d4f1 --- /dev/null +++ b/src/WOKTclLib/file.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * file_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"20 22 5 1 0 0", +/* colors */ +" c #2F2F4F4F4F4F", +". s iconGray4 m white c #949494949494", +"X s iconColor2 m white c white", +"o s iconColor1 m black c black", +"O c #707080809090", +/* pixels */ +" .......", +" XXXXXXXXXX X ......", +" XXXXXXXXXX XX .....", +" XXXXXXXXXX XXX ....", +" XXXXXXXXXX XXXX ...", +" XXXXXXXXXXo o o o..", +" XXXXXXXXXXooooooo..", +" XXXXXXXXXXXXOOOOo..", +" XXXXXXXXXXXXXOOOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" OOOOOOOOOOOOOO o..", +"..oooooooooooooooo.."}; diff --git a/src/WOKTclLib/frontal.xpm b/src/WOKTclLib/frontal.xpm new file mode 100755 index 0000000..7eed1f8 --- /dev/null +++ b/src/WOKTclLib/frontal.xpm @@ -0,0 +1,61 @@ +/* XPM */ +static char * frontal_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 29 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #333360605555", +"o c #333340405555", +"O c #333360600000", +"+ c #66668080AAAA", +"@ c #999980805555", +"# c #000040405555", +"$ c #CCCCDFDFFFFF", +"% c #CCCCBFBFAAAA", +"& c #FFFFDFDFAAAA", +"* c #CCCCDFDFAAAA", +"= c #FFFFBFBF0000", +"- c #FFFF9F9F0000", +"; s iconColor3 m black c red", +": c #3333DFDF0000", +"? c #3333BFBF5555", +"> c #CCCCBFBFFFFF", +", c #3333BFBF0000", +"< c #33339F9FFFFF", +"1 c #00008080FFFF", +"2 c #00009F9FFFFF", +"3 c #999940405555", +"4 c #CCCC60600000", +"5 c #CCCC80805555", +"6 c #999960600000", +"7 c #CCCC9F9F5555", +"8 c #999960605555", +"9 c #CCCC80800000", +/* pixels */ +" ", +" ", +" .....XoXo ", +" .....OoXoOoX+@+ ", +" .....oX#XoX#X++++ ", +" .....oXoXoXoX+@+@o@+ ", +" ...XoXoXoX+++++X$%++ ", +" ...oXoOo@+@+@+O$&%@+ ", +" ......+++++X$*$=$%++ ", +" ......@+X$&$---$&%@+ ", +" ......+X$$$=--;:?%++ ", +" ......@o&>-;;;:?,%@+ ", +" ......+X;;;$?:$;$%++ ", +" ......@o&;&$:$&;;%@+ ", +" ......+X$$$<1$$&.+++ ", +" ......@o<1<$&>.+@+. ", +" ......+X2*$$..+++.. ", +" ....@o&$.+@+.345. ", +" ....+..+++.65.. ", +" ..4...@+@+@.45.+@+ ", +" .758..++.637.+++ ", +" @+.593.39..+@+ ", +" +++..587.+++ ", +" @+@+.+@+ ", +" ++++ ", +" + "}; diff --git a/src/WOKTclLib/frontal_open.xpm b/src/WOKTclLib/frontal_open.xpm new file mode 100755 index 0000000..13f7ac3 --- /dev/null +++ b/src/WOKTclLib/frontal_open.xpm @@ -0,0 +1,58 @@ +/* XPM */ +static char * frontal_open_xpm[] = { +"24 26 29 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #333360605555", +"o c #333340405555", +"O c #333360600000", +"+ c #66668080AAAA", +"@ c #999980805555", +"# c #000040405555", +"$ c #CCCCDFDFFFFF", +"% c #CCCCBFBFAAAA", +"& c #FFFFDFDFAAAA", +"* c #CCCCDFDFAAAA", +"= c #FFFFBFBF0000", +"- c #FFFF9F9F0000", +"; c #FFFF00000000", +": c #3333DFDF0000", +"? c #3333BFBF5555", +"> c #CCCCBFBFFFFF", +", c #3333BFBF0000", +"< c #33339F9FFFFF", +"1 c #00008080FFFF", +"2 c #00009F9FFFFF", +"3 c #999940405555", +"4 c #CCCC60600000", +"5 c #CCCC80805555", +"6 c #999960600000", +"7 c #CCCC9F9F5555", +"8 c #999960605555", +"9 c #CCCC80800000", +" ", +" ", +" .....XoXo ", +" .....OoXoOoX+@+ ", +" .....oX#XoX#X++++ ", +" .....oXoXoXoX+@+@o@+ ", +" ...XoXoXoX+++++X$%++ ", +" ...oXoOo@+@+@+O$&%@+ ", +" ......+++++X$*$=$%++ ", +" ......@+X$&$---$&%@+ ", +" ......+X$$$=--;:?%++ ", +" ......@o&>-;;;:?,%@+ ", +" ......+X;;;$?:$;$%++ ", +" ......@o&;&$:$&;;%@+ ", +" ......+X$$$<1$$&.+++ ", +" ......@o<1<$&>.+@+. ", +" ......+X2*$$..+++.. ", +" ....@o&$.+@+.345. ", +" ....+..+++.65.. ", +" ..4...@+@+@.45.+@+ ", +" .758..++.637.+++ ", +" @+.593.39..+@+ ", +" +++..587.+++ ", +" @+@+.+@+ ", +" ++++ ", +" + "}; diff --git a/src/WOKTclLib/gettable.xpm b/src/WOKTclLib/gettable.xpm new file mode 100755 index 0000000..fc4f91b --- /dev/null +++ b/src/WOKTclLib/gettable.xpm @@ -0,0 +1,18 @@ +/* XPM */ +static char * textfile_xpm[] = { +"12 12 3 1", +" s None c None", +". c black", +"X c #FFFFFFFFF3CE", +" ........ ", +" .XXXXXX. ", +" .XXXXXX... ", +" .XX...XXX. ", +" .XXX....X. ", +" .X.XX...X. ", +" .X..XX..X. ", +" .X...XX.X. ", +" .X....XXX. ", +" .X......X. ", +" .XXXXXXXX. ", +" .......... "}; diff --git a/src/WOKTclLib/idl.xpm b/src/WOKTclLib/idl.xpm new file mode 100755 index 0000000..fbe3e87 --- /dev/null +++ b/src/WOKTclLib/idl.xpm @@ -0,0 +1,49 @@ +/* XPM */ +static char * idl_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 17 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor3 m black c red", +"X s iconColor1 m black c black", +"o c #FFFFDFDFAAAA", +"O c #CCCCDFDFFFFF", +"+ c #FFFF9F9F0000", +"@ c #CCCCBFBFFFFF", +"# s iconColor2 m white c white", +"$ c #CCCCDFDFAAAA", +"% c #FFFFBFBF0000", +"& c #333380805555", +"* c #333340405555", +"= c #000040405555", +"- c #333360605555", +"; c #33339F9F5555", +": c #00008080AAAA", +"? c #333360600000", +/* pixels */ +" ", +" ", +" ", +" .X ", +" X..X ", +" .....X ", +" X....XX oX ", +" X...X XOX ", +" X....X XOX ", +" XXX..X X XXX+ ", +" X..X XOX XOXX+X ", +" X..XoOX@XXoX##X+++ ", +" X..XX#X$OXOX#X+%+X ", +" X..XX##OXXoXX+++X ", +" XOX.XO###XXX+++%X+ ", +" XXoOo@oX&X++++X*XX ", +" XXX$OOX%+%XX=-&X ", +" o..X++++X*-*-&;X ", +" XOX..++%X-*;&;&X* ", +" X@X.X+XX-*;&&&X*-* ", +" X;:%X-=-&;:X*-= ", +" -*X&-&&&;X-*- ", +" *-*X&;&;X-*- ", +" *?*-X?*- ", +" -*-= ", +" * "}; diff --git a/src/WOKTclLib/idl_open.xpm b/src/WOKTclLib/idl_open.xpm new file mode 100755 index 0000000..0909380 --- /dev/null +++ b/src/WOKTclLib/idl_open.xpm @@ -0,0 +1,55 @@ +/* XPM */ +static char * idl_open_xpm[] = { +"24 26 26 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #FFFF00000000", +"o c #33338080FFFF", +"O c #33339F9FFFFF", +"+ c #00008080FFFF", +"@ c #00009F9FFFFF", +"# c #CCCCBFBFAAAA", +"$ c #9999BFBFFFFF", +"% c #FFFFBFBF0000", +"& c #FFFF9F9F0000", +"* c #3333BFBF5555", +"= c #3333DFDF0000", +"- c #3333BFBF0000", +"; c #66668080AAAA", +": c #333360605555", +"? c #CCCC80805555", +"> c #FFFF80800000", +", c #CCCC9F9F5555", +"< c #999940405555", +"1 c #CCCC60600000", +"2 c #999960600000", +"3 c #999960605555", +"4 c #333340405555", +"5 c #CCCC80800000", +"6 c #999980805555", +" ", +" ", +" ", +" .XX. .oO. ", +" .XXXX.. .+O@O. ", +" .XXXXX#X.oO+OoO. ", +" .XXX$#$X.O+O$O+. ", +" ....XXX#.+OoO##.. ", +" ..XX.%&..O@#.%$ ", +" .*=*...&##&&&&&&# ", +" ..*=*.&.&&$..#$#& ", +" ....-*=.&+O..#.. ", +" ...*=*.@#+O.. ", +" .*##.+Oo##.;. ", +" .X....+O$.XXXXX. ", +" .XXXXXXX:?>XXXXXXX ", +" .XXXXXX#?,<..XXX$#. ", +" .XXXXXX#1<2..XXX##. ", +" .XXXXX.<232.XXX. ", +" .4..#..?5<1<5.#.6; ", +" .,<,.,?,?,?,.;;; ", +" 6;.?5?5?5..;6; ", +" ;;;..??,.;;; ", +" 6;6;.;6; ", +" ;;;; ", +" ; "}; diff --git a/src/WOKTclLib/interface.xpm b/src/WOKTclLib/interface.xpm new file mode 100755 index 0000000..104ddb0 --- /dev/null +++ b/src/WOKTclLib/interface.xpm @@ -0,0 +1,42 @@ +/* XPM */ +static char * interface_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 10 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #FFFF9F9F0000", +"o s iconColor3 m black c red", +"O c #FFFFBFBF0000", +"+ c #66668080AAAA", +"@ c #33339F9F5555", +"# c #333380805555", +"$ c #999980805555", +"% c #00008080AAAA", +/* pixels */ +" ", +" . ", +" ..X.o. ", +" .XXXX.oo. ", +" .XOXO.ooo ", +" . ..XXX.ooooo+ ", +" ...XXOX.oooo... ", +" ..XXXX.ooo..X.o. ", +" .XOX.oooo.OXOX.oo. ", +" .XX.oooo.XXX..ooo. ", +" .X.oo..XXX.ooooo. ", +" ..XXXX.oooo... ", +" .OXO..ooo.XOX.oo. ", +" .XXX.oooo.XXXX.oo. ", +" .XX.oooo.XXO..ooo. ", +" ..o.XXXX.oooo.o. ", +" ..OXOX.oooo...@. ", +" .XXX..ooo.@###@#. ", +" .XO.oooo.#@#@#.. ", +" .XX.oooo.#@###.+$+ ", +" .@..o.%@#@%@.+++ ", +" $+.#@###@..+$+ ", +" +++..@#@.+++ ", +" $+$+.+$+ ", +" ++++ ", +" + "}; diff --git a/src/WOKTclLib/interface_open.xpm b/src/WOKTclLib/interface_open.xpm new file mode 100755 index 0000000..921cf9a --- /dev/null +++ b/src/WOKTclLib/interface_open.xpm @@ -0,0 +1,39 @@ +/* XPM */ +static char * interface_open_xpm[] = { +"24 26 10 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #FFFF9F9F0000", +"o c #FFFF00000000", +"O c #FFFFBFBF0000", +"+ c #66668080AAAA", +"@ c #33339F9F5555", +"# c #333380805555", +"$ c #999980805555", +"% c #00008080AAAA", +" ", +" . ", +" ..X.o. ", +" .XXXX.oo. ", +" .XOXO.ooo ", +" . ..XXX.ooooo+ ", +" ...XXOX.oooo... ", +" ..XXXX.ooo..X.o. ", +" .XOX.oooo.OXOX.oo. ", +" .XX.oooo.XXX..ooo. ", +" .X.oo..XXX.ooooo. ", +" ..XXXX.oooo... ", +" .OXO..ooo.XOX.oo. ", +" .XXX.oooo.XXXX.oo. ", +" .XX.oooo.XXO..ooo. ", +" ..o.XXXX.oooo.o. ", +" ..OXOX.oooo...@. ", +" .XXX..ooo.@###@#. ", +" .XO.oooo.#@#@#.. ", +" .XX.oooo.#@###.+$+ ", +" .@..o.%@#@%@.+++ ", +" $+.#@###@..+$+ ", +" +++..@#@.+++ ", +" $+$+.+$+ ", +" ++++ ", +" + "}; diff --git a/src/WOKTclLib/journal.xpm b/src/WOKTclLib/journal.xpm new file mode 100755 index 0000000..5299528 --- /dev/null +++ b/src/WOKTclLib/journal.xpm @@ -0,0 +1,46 @@ +/* XPM */ +static char * journal_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 8 1 0 0", +/* colors */ +" s iconGray4 m white c #949494949494", +". s iconColor1 m black c black", +"X c #F5F5DEDEB3B3", +"o s iconColor5 m black c blue", +"O c #2F2F4F4F4F4F", +"+ s iconColor3 m black c red", +"@ c #BEBEBEBEBEBE", +"# c #707080809090", +/* pixels */ +" ", +" ", +" .............................. ", +" .XXXXXXXXXXXXXXXXXXXXXXXXXXXX. ", +" .XooooXXXXXXXXX..XXXXXXXooooX.O", +" .XXXXXX.X.X.X.X.XXX.X..XXXXXX.O", +" .X++++XX..XX.XX..X..X..X++++X.O", +" .X++++XXXXXXXXXXXXXXXX.X++++X.O", +" .XXXXXXXXXXXXXXXXXXXXXXXXXXXX.O", +" ..............................O", +" .XXXXXXXXXXXXXXXXXXXXXXXXXXXX.O", +" .XX...X.XX.X....X...@X@..@X.X.O", +" .XX.#XXXOOXXX.XXX.XX.X.XX.X.X.O", +" .XX.XXXXOOXXX.XXX.X.XX....XXX.O", +" .XX...X.XX.XX.XXX.XX.X.XX.X.X.O", +" .XXXXXXXXXXXXXXXXXXXXXXXXXXXX.O", +" ..............................O", +" .XXXXXXXXXXXXXXXXXXXXXXXXXXXX.O", +" .X.X.X.XXO..........OX.X..X.X.O", +" .X..X...X.@O@@@@@@@@.XX.X..XX.O", +" .XXXXXXXX............XXXXXXXX.O", +" .X.#O...X.##########.X.#..#OX.O", +" .XXXXXXXX.##########.XXXXXXXX.O", +" .X#.O.#.X.##########.X#.O..#X.O", +" .XXXXXXXX.##########.XXXXXXXX.O", +" .X.##..OX.##########.X.#.#..X.O", +" .XXXXXXXXO..........OXXXXXXXX.O", +" .X.O.#..XXXXXXXXXXXXXXO.#...X.O", +" .XXXXXXXXXX.#O..#..XXXXXXXXXX.O", +" .XXXXXXXXXXXXXXXXXXXXXXXXXXXX.O", +" .............................O", +" OOOOOOOOOOOOOOOOOOOOOOOOOOOOO"}; diff --git a/src/WOKTclLib/nocdlpack.xpm b/src/WOKTclLib/nocdlpack.xpm new file mode 100755 index 0000000..1dc6d45 --- /dev/null +++ b/src/WOKTclLib/nocdlpack.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char * nocdlpack_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 18 1 0 0", +/* colors */ +" s none m none c none", +". c #66668080AAAA", +"X c #333340405555", +"o c #999980805555", +"O c #333360600000", +"+ c #333360605555", +"@ s iconColor1 m black c black", +"# c #9999BFBFFFFF", +"$ c #CCCCBFBFAAAA", +"% c #CCCC80805555", +"& c #CCCC9F9F5555", +"* s iconColor3 m black c red", +"= c #CCCC80800000", +"- c #FFFF80800000", +"; c #999940405555", +": c #999960600000", +"? c #CCCC60600000", +"> c #999960605555", +/* pixels */ +" ", +" ", +" ..X ", +" XoXO ", +" +X@@ ", +" oX ", +" +X+#+ ", +" OX$.$$ ", +" #.%&*+ ", +" $$*%=X ", +" #*%%%$ ", +" $X=%@$ ", +" #@@$.$ ", +" $$$$o$@ ", +" #.#$.$%%@ ", +" $@$$@$@%-%=@ ", +" #$#$#.X+%&%&@ ", +" @;$.$@o@=%=%=%@ ", +" @:;+@$X@%&%%%@@ ", +" @@?;?@O@@%-%=%@.o. ", +" @&%&>@%&%&%&@... ", +" o.@%=%=%=@@.o. ", +" ...@@%%&@... ", +" o.o.@.o. ", +" .... ", +" . "}; diff --git a/src/WOKTclLib/nocdlpack_open.xpm b/src/WOKTclLib/nocdlpack_open.xpm new file mode 100755 index 0000000..095995d --- /dev/null +++ b/src/WOKTclLib/nocdlpack_open.xpm @@ -0,0 +1,47 @@ +/* XPM */ +static char * nocdlpack_open_xpm[] = { +"24 26 18 1", +" c #FFFFFFFF0000", +". c #66668080AAAA", +"X c #333340405555", +"o c #999980805555", +"O c #333360600000", +"+ c #333360605555", +"@ c #000000000000", +"# c #9999BFBFFFFF", +"$ c #CCCCBFBFAAAA", +"% c #CCCC80805555", +"& c #CCCC9F9F5555", +"* c #FFFF00000000", +"= c #CCCC80800000", +"- c #FFFF80800000", +"; c #999940405555", +": c #999960600000", +"? c #CCCC60600000", +"> c #999960605555", +" ", +" ", +" ..X ", +" XoXO ", +" +X@@ ", +" oX ", +" +X+#+ ", +" OX$.$$ ", +" #.%&*+ ", +" $$*%=X ", +" #*%%%$ ", +" $X=%@$ ", +" #@@$.$ ", +" $$$$o$@ ", +" #.#$.$%%@ ", +" $@$$@$@%-%=@ ", +" #$#$#.X+%&%&@ ", +" @;$.$@o@=%=%=%@ ", +" @:;+@$X@%&%%%@@ ", +" @@?;?@O@@%-%=%@.o. ", +" @&%&>@%&%&%&@... ", +" o.@%=%=%=@@.o. ", +" ...@@%%&@... ", +" o.o.@.o. ", +" .... ", +" . "}; diff --git a/src/WOKTclLib/notes.xpm b/src/WOKTclLib/notes.xpm new file mode 100755 index 0000000..c13d889 --- /dev/null +++ b/src/WOKTclLib/notes.xpm @@ -0,0 +1,37 @@ +/* XPM */ +static char * layout_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 9 1", +/* colors */ +" c dark slate grey", +". s None c None", +"X c white", +"o c gold", +"O c sky blue", +"+ c black", +"@ c sienna", +"# c slate grey", +"$ c tomato", +/* pixels */ +" .......", +" XXXXXXXXXX X ......", +" XXXXXXXXXX XX .....", +" XX XX XXX ....", +" XX ooOOOXX XXXX ...", +" XX oOOOOXX+ + + +..", +" XX OOOOOXX+++++++..", +" XX @@@@@XXXX####+..", +" XX @@@@@XXXXX###+..", +" XXXXXXXXXXXXXXX#+..", +" XXXXXXXXXXXXXXX#+..", +" XX++++++++++XXX#+..", +" XXXXXXXXXXXXXXX#+..", +" XX++++++++++XXX#+..", +" XXXXXXXXXXXXXXX#+..", +" XXXX$X++++++XXX#+..", +" XXXXXXXXXXXXXXX#+..", +" XXXX$X++++++XXX#+..", +" XXXXXXXXXXXXXXX#+..", +" XXXXXXXXXXXXXXX#+..", +" ############## +..", +"..++++++++++++++++.."}; diff --git a/src/WOKTclLib/package.xpm b/src/WOKTclLib/package.xpm new file mode 100755 index 0000000..27b3026 --- /dev/null +++ b/src/WOKTclLib/package.xpm @@ -0,0 +1,56 @@ +/* XPM */ +static char * package_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 24 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #CCCC80805555", +"o c #CCCC9F9F5555", +"O c #CCCCBFBFAAAA", +"+ c #CCCC20200000", +"@ c #66668080AAAA", +"# c #CCCC80800000", +"$ c #9999BFBFFFFF", +"% c #999980805555", +"& c #999920205555", +"* c #CCCC40400000", +"= c #999960600000", +"- c #999940405555", +"; c #CCCC60600000", +": c #999920200000", +"? c #999960605555", +"> c #33339F9F5555", +", c #333380805555", +"< c #333360600000", +"1 c #000040405555", +"2 c #333360605555", +"3 c #333340405555", +"4 c #00008080AAAA", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ....Xo.. ", +" ..X.O+@#X# ", +" .$......oX ", +" .%.#&..+&.X# ", +" oX.Xo.*&+&*.oX ", +" ..X#.#&+&+&.X# ", +" =-=.oX+&*&+.oX ", +" -;-.X#&+:+&.X#. ", +" ??=.oX*&+&*.oX>. ", +" -;-.X#&+&+&.,>,. ", +" .=-=.oX+&*.>,.. ", +" ..<-;-.X#&+.,,.@%@ ", +" .>123..o.>4>.@@@ ", +" %@.,>32,>..@%@ ", +" @@@..>,>.@@@ ", +" %@%@.@%@ ", +" @@@@ ", +" @ "}; diff --git a/src/WOKTclLib/package_open.xpm b/src/WOKTclLib/package_open.xpm new file mode 100755 index 0000000..917c5a9 --- /dev/null +++ b/src/WOKTclLib/package_open.xpm @@ -0,0 +1,53 @@ +/* XPM */ +static char * package_open_xpm[] = { +"24 26 24 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #CCCC80805555", +"o c #CCCC9F9F5555", +"O c #CCCCBFBFAAAA", +"+ c #CCCC20200000", +"@ c #66668080AAAA", +"# c #CCCC80800000", +"$ c #9999BFBFFFFF", +"% c #999980805555", +"& c #999920205555", +"* c #CCCC40400000", +"= c #999960600000", +"- c #999940405555", +"; c #CCCC60600000", +": c #999920200000", +"? c #999960605555", +"> c #33339F9F5555", +", c #333380805555", +"< c #333360600000", +"1 c #000040405555", +"2 c #333360605555", +"3 c #333340405555", +"4 c #00008080AAAA", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ....Xo.. ", +" ..X.O+@#X# ", +" .$......oX ", +" .%.#&..+&.X# ", +" oX.Xo.*&+&*.oX ", +" ..X#.#&+&+&.X# ", +" =-=.oX+&*&+.oX ", +" -;-.X#&+:+&.X#. ", +" ??=.oX*&+&*.oX>. ", +" -;-.X#&+&+&.,>,. ", +" .=-=.oX+&*.>,.. ", +" ..<-;-.X#&+.,,.@%@ ", +" .>123..o.>4>.@@@ ", +" %@.,>32,>..@%@ ", +" @@@..>,>.@@@ ", +" %@%@.@%@ ", +" @@@@ ", +" @ "}; diff --git a/src/WOKTclLib/params.xpm b/src/WOKTclLib/params.xpm new file mode 100755 index 0000000..2830cf3 --- /dev/null +++ b/src/WOKTclLib/params.xpm @@ -0,0 +1,47 @@ +/* XPM */ +static char * config_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 9 1 0 0", +/* colors */ +" s iconGray4 m white c #949494949494", +". s iconColor1 m black c black", +"X c #707080809090", +"o s iconColor2 m white c white", +"O c #BEBEBEBEBEBE", +"+ c #FFFFFAFACDCD", +"@ c #2F2F4F4F4F4F", +"# s iconColor5 m black c blue", +"$ c #F5F5DEDEB3B3", +/* pixels */ +" .......... ", +" ...XXXXXXXX... ", +" ..XXXXoXXooOXXXX.. ", +" .oXXXXXoXXXOoXXXXXo. ", +" .XOoXXXXoXX++XXXXXXoX. ", +" .XXXOoXXXoXXoooXXXXoX@@. ", +" .XXXXXXXXXXXXXXXXXX@o@@@@. ", +" .oXXXXXXXXX######@@@@@@@@@.. ", +" .XooXXXXX##########@@@@@@@@. ", +" .XXXOoXXX###OOOOOO###@@@@@@@+. ", +" .XXXXXXX##OO......OO##@@@@@+X. ", +"..XXXXXX##O.........O##.@@@+X@..", +".XXXXXXX##O..........O##.@@@@@@.", +".XXXXXX##O...........O##..@@@@@.", +".XOoOXX##O...$...$...O##...XoX@.", +".XoXoXX##O....$..$...O##....@o@.", +".XOooXX##O....$$$$$....#....oX@.", +".XXXoXX##O.....$$$$$.$......@o@.", +".XXXoXX@##O....$$.$$.$.....XoX@.", +".XXXXXX@###O....$.$$$$$.....@@@.", +"..XXXXX@@###OO.....$$$$....@@@..", +" .XooX@@@@####OOOO.$$.$$...@@@. ", +" .oOXX@@@@@#######..$..$..@++@. ", +" .XXX@@@@@@.#####.....$..@@@. ", +" ..X@@@@@@@@............@@@.. ", +" .X@@@o@@@@@.XoX......@@@@. ", +" .@@oX@@@@@@o......@+@@@. ", +" .oX@@@@@@@ooX@@@@@X+@.. ", +" ..@@@@@@@o@o@@@@@@+. ", +" ..@@@@@@XoX@@@@@.. ", +" ...@@@@@@@@... ", +" .......... "}; diff --git a/src/WOKTclLib/parcel.xpm b/src/WOKTclLib/parcel.xpm new file mode 100755 index 0000000..5605c51 --- /dev/null +++ b/src/WOKTclLib/parcel.xpm @@ -0,0 +1,48 @@ +/* XPM */ +static char * parcel_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 16 1 0 0", +/* colors */ +" s none m none c none", +". c #CCCCDFDFFFFF", +"X c #FFFFDFDFAAAA", +"o c #CCCCDFDFAAAA", +"O s iconColor1 m black c black", +"+ c #333340405555", +"@ c #333360605555", +"# c #CCCCBFBFFFFF", +"$ c #333360600000", +"% s iconColor7 m white c cyan", +"& c #000040405555", +"* c #66668080AAAA", +"= c #33339F9F5555", +"- c #333380805555", +"; c #999980805555", +": c #00008080AAAA", +/* pixels */ +" ", +" ", +" ", +" .X ", +" ...o ", +" X.X.X.X ", +" ..X...X.O+@ ", +" X#X.X#X.O+$% ", +" ..o...OO@+@%@ ", +" @+O.XO@+@+@%@+ ", +" +@+OO@+@+@%@+% ", +" $+@+$+@+$%@+%+ ", +" &@+@&@+@%@+%&@ ", +" @+@+@+@%@+%+@+ ", +" +@+@+@%@+%+@+@ ", +" $+@+$%@*%+@+$+ ", +" &@+@%@*%&*+@&@ = ", +" @+@+@+%+@+@+O-=- ", +" +@+@+%+@+@O=- ", +" $+@+%+@+$O--O*;* ", +" =:OO@&@O=:=O*** ", +" ;*O-=-O-=OO*;* ", +" ***OO=-=O*** ", +" ;*;*O*;* ", +" **** ", +" * "}; diff --git a/src/WOKTclLib/parcel_open.xpm b/src/WOKTclLib/parcel_open.xpm new file mode 100755 index 0000000..3ff621c --- /dev/null +++ b/src/WOKTclLib/parcel_open.xpm @@ -0,0 +1,49 @@ +/* XPM */ +static char * parcel_open_xpm[] = { +"24 26 20 1", +" c #FFFFFFFF0000", +". c #333340405555", +"X c #333360605555", +"o c #333380805555", +"O c #33339F9F5555", +"+ c #333360600000", +"@ c #3333DFDF0000", +"# c #00008080AAAA", +"$ c #3333BFBF5555", +"% c #3333DFDF5555", +"& c #3333BFBF0000", +"* c #FFFF9F9F0000", +"= c #000040405555", +"- c #FFFFBFBF0000", +"; c #CCCC9F9F5555", +": c #CCCC80805555", +"? c #CCCC80800000", +"> c #000000000000", +", c #66668080AAAA", +"< c #999980805555", +" ", +" ", +" ", +" ", +" ", +" .XoX ", +" XoOoOoO. ", +" +oooOoo.@ ", +" X.O#OoO#X$@$ ", +" X.OoooX$@$@$X ", +" .O.OoO$%$@$X$ ", +" +ooo@$&$@.&$* ", +" =O.O$%.@$%*-* ", +" XoOo@.@$@$*** ", +" .;oO*-***-**$ ", +" +:?:********@oo> ", +" =;:;*-*-*-*@$OoO> ", +" Xo?:@$****@.XoOo> ", +" .OoO$@$%$XoOo>> ", +" >>+ooo@$&.+ooo>,<, ", +" >O#X.O$X.O#O>,,, ", +" <,>oOoooO>>,<, ", +" ,,,>>OoO>,,, ", +" <,<,>,<, ", +" ,,,, ", +" , "}; diff --git a/src/WOKTclLib/patch.xpm b/src/WOKTclLib/patch.xpm new file mode 100755 index 0000000..1b9f0fd --- /dev/null +++ b/src/WOKTclLib/patch.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * patch_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 7 1", +/* colors */ +" c dark slate grey", +". s None c None", +"X c white", +"o c black", +"O c slate grey", +"+ c firebrick", +"@ c tomato", +/* pixels */ +" .......", +" XXXXXXXXXX X ......", +" XXXXXXXXXX XX .....", +" XXXXXXXXXX XXX ....", +" XXXXXXXXXX XXXX ...", +" XXXXXXXXXXo o o o..", +" XXXXXXXXXXooooooo..", +" XXXXXXXXXXXXOOOOo..", +" XXXX+X+X+XXXXOOOo..", +" XX+@+@+@+@+XXXXOo..", +" XX@@@@@@@@@XXXXOo..", +" X++@@@@@@@++XXXOo..", +" XX@@@@@@@@@XXXXOo..", +" X++@@@@@@@++XXXOo..", +" XX@@@@@@@@@XXXXOo..", +" X++@@@@@@@++XXXOo..", +" XX@@@@@@@@@XXXXOo..", +" XX+@+@+@+@+XXXXOo..", +" XXXX+X+X+XXXXXXOo..", +" XXXXXXXXXXXXXXXOo..", +" OOOOOOOOOOOOOO o..", +"..oooooooooooooooo.."}; diff --git a/src/WOKTclLib/patches.xpm b/src/WOKTclLib/patches.xpm new file mode 100755 index 0000000..5d68281 --- /dev/null +++ b/src/WOKTclLib/patches.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char * patches_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 12 1 0 0", +/* colors */ +" s background m black c #949494949494", +". c #1E1E9090FFFF", +"X c #FFFFFAFACDCD", +"o c #BEBEBEBEBEBE", +"O c #707080809090", +"+ s iconColor5 m black c blue", +"@ c #000000008080", +"# c #2F2F4F4F4F4F", +"$ s iconColor1 m black c black", +"% s iconColor2 m white c white", +"& c #F5F5DEDEB3B3", +"* s iconColor3 m black c red", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +".....XXXoXXXXXO.. ", +".++++XOoXO@@@O#+++ ", +".++++XoXOo@@@O#+++$ ", +".++++oXOoX@@@O#+++$ ", +".++++%OoXO@@@O#+++$ ", +".++++XoXOO@@@O#+++$ ", +".++++oXOOOOOOO#+++$ ", +".++++#########@+++$$$$$$ ", +".+++++++++++++++++$&&&&&$ ", +".+$$$$$$$$$$$$$$$+$&&&&&&$ ", +".+$%%%%%%%%%%%%%$+$$&&&&&&$ ", +".+$%%%%%**%%%%%%$+$$$&&&&&&$ ", +".+$%%%%%**%%%%%%$+$$$&&&&&&&$$$ ", +".+$%%%%%**%%%%%%$$$$&&&&&&&&&$$ ", +".+$%%********%%$&&&&&&&&&&&&&$$ ", +".+$%%********%%$&&&&&&&&&&&&&$$ ", +".+$%%%%%**%%%%%$&&&&&&&&&&&&&$$ ", +".+$%%%%%**%%%%%%$$$$$$$$$$$&&$$ ", +".+$%%%%%**%%%%%%$+$ $$$$ ", +".+$%%%%%%%%%%%%%$+$ $$ ", +"+$$$$$$$$$$$$$$$$$$ ", +" ", +" ", +" ", +" "}; diff --git a/src/WOKTclLib/path.xpm b/src/WOKTclLib/path.xpm new file mode 100755 index 0000000..8fa7344 --- /dev/null +++ b/src/WOKTclLib/path.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char * clover_green_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 16 3 1", +/* colors */ +" s None c None", +". c green", +"X c sea green", +/* pixels */ +" ", +" ", +" ", +" ... ", +" ....X ", +" ...XX ", +" .. XXX .. ", +" ...X X ...X ", +" ...XX.....X ", +" X.XX . X.XX ", +" XX ... XX ", +" ....X ", +" X..XX ", +" XXX ", +" ", +" "}; diff --git a/src/WOKTclLib/persistent.xpm b/src/WOKTclLib/persistent.xpm new file mode 100755 index 0000000..7e35275 --- /dev/null +++ b/src/WOKTclLib/persistent.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char * persistent_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"16 16 4 1 -1 -1", +/* colors */ +" s topShadowColor m white c #bdbdbdbdbdbd", +". s iconGray6 m black c #636363636363", +"X s bottomShadowColor m black c #636363636363", +"o s iconColor2 m white c white", +/* pixels */ +" ", +" ..............X", +" ..............X", +" ..oooooo......X", +" ..o.....o.....X", +" ..o.....o.....X", +" ..o.....o.....X", +" ..o.....o.....X", +" ..oooooo......X", +" ..o...........X", +" ..o...........X", +" ..o...........X", +" ..o...........X", +" ..............X", +" ..............X", +" XXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/pinstall.tcl b/src/WOKTclLib/pinstall.tcl new file mode 100755 index 0000000..b82928a --- /dev/null +++ b/src/WOKTclLib/pinstall.tcl @@ -0,0 +1,41 @@ +proc pinstallUsage {} { + puts stderr { usage : pinstall parcelname } +} + +proc pinstall {args} { + + set tblreq(-h) {} + set param {} + + if { [wokUtils:EASY:GETOPT param table tblreq pinstallUsage $args] == -1 } return + + if { [info exists table(-h)] } { + pinstallUsage + return + } + + set ULNAME [lindex $param 0] + if { $ULNAME == {} } { + pinstallUsage + return + } + + set thefact [Sinfo -f] + set theware [finfo -W $thefact] + puts "Installing $ULNAME from Warehouse ${thefact}:${theware}" + wokcd ${thefact}:${theware} + wokcd $ULNAME + set theullibdir [wokparam -e WOKEntity_libdir ${thefact}:${theware}:${ULNAME}] + cd $theullibdir + foreach atempld [glob *.ldt] { + source $atempld + set goodlen [expr [clength $atempld] - 2] + set aldfile [crange $atempld 0 $goodlen] + set ldfileid [open $aldfile w] + puts $ldfileid [WOKDeliv_Makeld $thefact] + if {![catch {set esvers [wokparam -e %ENV_EngineStarterVersion]}]} { + puts $ldfileid $esvers + } + close $ldfileid + } +} diff --git a/src/WOKTclLib/pqueue.xpm b/src/WOKTclLib/pqueue.xpm new file mode 100755 index 0000000..a45bf38 --- /dev/null +++ b/src/WOKTclLib/pqueue.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char * pqueue_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 12 1 0 0", +/* colors */ +" s background m black c #949494949494", +". s iconColor5 m black c blue", +"X c #000000008080", +"o c #2F2F4F4F4F4F", +"O c #BEBEBEBEBEBE", +"+ s iconColor2 m white c white", +"@ c #707080809090", +"# s iconColor3 m black c red", +"$ s iconColor1 m black c black", +"% c #FFFFFAFACDCD", +"& c #A0A052522D2D", +"* c #FFFFA5A50000", +/* pixels */ +" . . . . . ", +" ..X ..X ..X ..X ..X ", +" o...XX..XX..XX..XX..X ", +" oOO...XX..XX..XX..XX..X ", +" oOXOO...XX..XX..XX..XX..X ", +" oOOOXO..+.XXO.XXO.XXO.XXO.X ", +" ..OOOO..+++.X@O.X@O.X@O.X@O.X ", +"....OO..+++++.X@O.X@O.X@O.X@O.X ", +" X.....+##+++X@OOX@OOX@OOX@OOX ", +" X...++##++X@OOX@OOX@OOX@OOX ", +" X.++++++X@OOX@OOX@OOX@OOX ", +" X.++++X@OOX@OOX@OOX@OOX ", +" X.++XXOOXXOOXXOOXXOOX ", +" X.X $.X $.X $.X $.X ", +" X X X X X ", +"$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$", +" @%%%OOOOOOOO@@@@oooooooo$$$$$$ ", +" $$$$$$$$$$$$$$$$$$$$$$$$$$$$ ", +" &**&*&*& &*& ", +" &*&*&*& &*& ", +" &*&*&**& &*& ", +" &&**&***& &&&*& ", +" &***&***&&*&&*& ", +" &&**&****&*&*& ", +" &&*******&**& ", +" &&******&*& ", +" &&******& ", +" &****& ", +" &****& ", +" o$$$$$$$ ", +" o$$$$$$$ ", +" o$$$$$$$ "}; diff --git a/src/WOKTclLib/prepare.xpm b/src/WOKTclLib/prepare.xpm new file mode 100755 index 0000000..2574421 --- /dev/null +++ b/src/WOKTclLib/prepare.xpm @@ -0,0 +1,50 @@ +/* XPM */ +static char * prepare_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 12 1 0 0", +/* colors */ +" s iconGray4 m white c #949494949494", +". s iconColor1 m black c black", +"X c #FFFFFAFACDCD", +"o c #D2D2B4B48C8C", +"O c #2F2F4F4F4F4F", +"+ c #707080809090", +"@ c #BEBEBEBEBEBE", +"# c #DCDCDCDCDCDC", +"$ s iconColor2 m white c white", +"% c #A0A052522D2D", +"& c #1E1E9090FFFF", +"* c #8787CECEEBEB", +/* pixels */ +" ", +" ........ ", +" .XXXXXX.. ", +" .XXXXXX.o. ", +" .XXXXXX.oo. ", +" .XXXXXX.ooo. ", +" .XXXXXX...... ", +" .XXXXXXXoooo. ", +" .OXOXOXOXOXO. ", +" +@@#$$$$$#@@++OO. ", +" O++@@##$#@@+++OO... ", +" .++@@##$#@@+++OO... ", +" .OO++@@@++OO..... ", +" ++@@#$#@@++OO.. ", +" ++@@#$#@@++OO..+ ", +" ++@@#$#@@++OO..O.... ", +" ++@@#$#@@++OO... . ", +" ++@@#$#@@++OO.. . ", +" +@@#$$$$$#@@++OO. . %% ", +" O++@@##$#@@++OOO... ..%% ", +" .OOOOOOOOOOOOOOO... .. ", +" ................. ", +" .+.+..O.++++. ", +" .&&&&&&&&&&&. ", +" .***O*OO@++*. ", +" .***********. ", +" .***+*O+OO**. ", +" .***********. ", +" .*****O*OO+*. ", +" .***********. ", +" ............. ", +" "}; diff --git a/src/WOKTclLib/private.xpm b/src/WOKTclLib/private.xpm new file mode 100755 index 0000000..572a32e --- /dev/null +++ b/src/WOKTclLib/private.xpm @@ -0,0 +1,27 @@ +/* XPM */ +static char * private_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"16 16 5 1 0 0", +/* colors */ +" s topShadowColor m white c #bdbdbdbdbdbd", +". s iconGray6 m black c #636363636363", +"X s bottomShadowColor m black c #636363636363", +"o s iconColor2 m white c white", +"O s iconColor3 m black c red", +/* pixels */ +" ", +" ..............X", +" .....ooooo....X", +" ....oOOOOOo...X", +" ...oOOOOOOOo..X", +" ..oOOOOOOOOOo.X", +" .oOOOOOOOOOOOoX", +" .oOoooooooooOoX", +" .oOoooooooooOoX", +" .oOoooooooooOoX", +" .oOOOOOOOOOOOoX", +" ..oOOOOOOOOOo.X", +" ...oOOOOOOOo..X", +" ....oOOOOOo...X", +" .....ooooo....X", +" XXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/ptypefile.tcl b/src/WOKTclLib/ptypefile.tcl new file mode 100755 index 0000000..c2908bc --- /dev/null +++ b/src/WOKTclLib/ptypefile.tcl @@ -0,0 +1,217 @@ +proc ptypefile_usage { } { + puts stderr \ + { + Usage: ptypefile -[hwt] [-S ao1,sil,sun,hp,wnt] + + Context: + The command must be runned from a workbnech belonging to a workshop which contains + the given parcel in its ParcelList + + ptypefile -h displays this text + + ptypefile -w + displays on the standard output the non kept type files. + + ptypefile + generates a type file in the adm directory of the parcel for ALL UNIX PLATFORMS + + ptypefile -S ao1,sil + generates a type file in the adm directory of the parcel ONLY for the given platforms + + ptypefile -S wnt + generates a type file in the adm directory of the parcel ONLY for wnt platform + + ptypefile -t + generates a type file in the adm directory where the package libraries contained in a toolkit + are removed from the type file. + + 3 files are generated: + parcel.typ contains pairs of file type, relative path which will be taken into account + during packaging. + parcel.unktyp file warns the UNKNOWN types i.e. not taken into account + parcel.notyp warns all the files that will be removed while packaging the parcel for Quantum + } +} +proc ptypefile { args } { + ;# Options + ;# + set tblreq(-h) {} + set tblreq(-w) {} + set tblreq(-t) {} + set tblreq(-S) value_required:list + ;# Parameters + ;# + set param {} + if {[wokUtils:EASY:GETOPT param table tblreq ptypefile_usage $args] == -1 } return + ;# + if { [info exists table(-h)] } { + ptypefile_usage + return + } + set warn 0 + if { [info exists table(-w)] } { + set warn 1 + } + if { [info exists table(-t)] } { + set tkpriority 1 + msgprint -w "SORRY NOT YET IMPLEMENTED ...." + return + } + set statlist { ao1 hp sil sun } + if { [info exists table(-S)] } { + set statlist $table(-S) + } + set parc [lindex $param 0] + if { $parc == "" } { + ptypefile_usage + return + } + set parcname [wokinfo -n $parc] + # sauvons la plateforme en cours + set curstation [wokparam -v %Station] + ;# sauvons + catch {exec cp "[wokparam -v %${parcname}_Adm]/${parcname}.typ" "[wokparam -v %${parcname}_Adm]/${parcname}.typ-sav"} + set typfile [open "[wokparam -v %${parcname}_Adm]/$parcname.typ" w+] + set notypfile [open "[wokparam -v %${parcname}_Adm]/$parcname.notyp" w+] + set unktypfile [open "[wokparam -v %${parcname}_Adm]/$parcname.unktyp" w+] + # Traitons d'abord les fichiers non plateformes dependants + # les uds de l'ul + ;# catch { + foreach ud [ pinfo -l $parc] { + set lstwokfilecom "[uinfo -Fi $parc:$ud ] [uinfo -Fb $parc:$ud ] " + puts " UD $ud " + foreach wokfile $lstwokfilecom { + switch -exact [lindex $wokfile 0] { + EXTERNLIB - + admfile - + ccldrv - + dbadmfile - + demofile - + derivated - + dummy - + infofile - + intdat - + object - + pubinclude - + source - + srcinc - + stadmfile - + sttmpdir - + testobject {typnotkept $warn $wokfile $notypfile } + cclcfg - + cclrun - + corelisp - + dbunit - + 'default' - + engdatfile - + engine - + englisp - + englispfile - + executable - + icon - + iconfd - + loginfile - + motifdefault - + msentity - + msgfile - + shapefile - + shellcfg - + shellscript - + template - + testexec { typkept $wokfile $parcname $ud $typfile } + datafile { typdatafile $warn $wokfile $parcname $ud $typfile $notypfile } + default { typunknown $wokfile $unktypfile} + } + } + foreach worksta $statlist { + wokprofile -S $worksta + set lstwokfilesta [uinfo -Fs $parc:$ud ] + foreach wokfile $lstwokfilesta { + switch -exact [lindex $wokfile 0] { + EXTERNLIB - + admfile - + ccldrv - + dbadmfile - + demofile - + derivated - + dummy - + infofile - + intdat - + object - + pubinclude - + source - + srcinc - + stadmfile - + sttmpdir - + testobject { typnotkept $warn $wokfile $notypfile } + cclcfg - + cclrun - + corelisp - + dbunit - + 'default' - + engdatfile - + engine - + englisp - + englispfile - + executable - + icon - + iconfd - + motifdefault - + msentity - + msgfile - + shapefile - + shellcfg - + shellscript - + template - + testexec { typkept $wokfile $parcname $ud $typfile } + library { typlibrary $warn $wokfile $parcname $ud $typfile $notypfile } + datafile { typdatafile $warn $wokfile $parcname $ud $typfile $notypfile } + loginfile { typloginfile $warn $wokfile $parcname $ud $typfile $notypfile } + default { typunknown $wokfile $unktypfile } + } + } + } + } + ;# } + close $typfile + close $unktypfile + close $notypfile + ;# on remet la station + wokprofile -S $curstation +} +;# +proc typkept { wokfile parcname ud typfile } { + puts $typfile "[lindex $wokfile 0] [string range [wokinfo -p [lindex $wokfile 0]:[lindex $wokfile 1] ${parcname}:${ud}] [expr [string length [wokparam -v %${parcname}_Home]] + 1] end]" +} +proc typnotkept { warn wokfile notypfile } { + if { $warn } { msgprint -w "TYPE $wokfile NOT KEPT" } + puts $notypfile "TYPE $wokfile NOT KEPT" +} +proc typunknown { wokfile unktypfile } { + msgprint -e "TYPE $wokfile UNKNOWN " + puts $unktypfile "TYPE $wokfile UNKNOWN" +} + +proc typlibrary { warn wokfile parcname ud typfile notypfile } { + ;# rajouter pktklist et tkpriority apres + if {[file extension [lindex $wokfile 1]] == ".Z"} { + typnotkept $warn $wokfile $notypfile + } else { + typkept $wokfile $parcname $ud $typfile + } +} +proc typdatafile { warn wokfile parcname ud typfile notypfile} { + if {[file extension [lindex $wokfile 1]] == ".ilm"} { + typnotkept $warn $wokfile $notypfile + } else { + typkept $wokfile $parcname $ud $typfile + } +} +proc typloginfile { warn wokfile parcname ud typfile notypfile } { + if {[file extension [lindex $wokfile 1]] == ".edl"} { + typnotkept $warn $wokfile $notypfile + } else { + typkept $wokfile $parcname $ud $typfile + } +} + diff --git a/src/WOKTclLib/queue.xpm b/src/WOKTclLib/queue.xpm new file mode 100755 index 0000000..3f93573 --- /dev/null +++ b/src/WOKTclLib/queue.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char * queue_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"19 19 6 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #33339F9F5555", +"o c #333380805555", +"O c #00008080AAAA", +"+ s iconColor2 m white c white", +/* pixels */ +" ", +" .... ", +" .XoX........ ", +" .ooXoooXoooXo.", +" .oXOXoXOXoXOX.", +" ..XoooXoooXooo.", +" .XoXoXoXoXoXoX.", +" .oooXoooXoooXo.", +" .XoXOXoXOXoXO..", +" .ooXoooXoooXoo..", +" .oXoXoXoXoXoXo..", +" ..oooXoooXooo.. ", +" .........OXo... ", +" ++++++++....... ", +" ......++++++.. ", +" +++++......... ", +" ....++++++++.. ", +" +++........+. ", +" +++++++++. "}; diff --git a/src/WOKTclLib/reposit.xpm b/src/WOKTclLib/reposit.xpm new file mode 100755 index 0000000..6ba8560 --- /dev/null +++ b/src/WOKTclLib/reposit.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * reposit_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"19 19 5 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #66668080AAAA", +"o c #999980805555", +"O s iconColor2 m white c white", +/* pixels */ +" ", +" ..XoXoXoXoXoXoX.. ", +" .XXXXXXXXXXXXXXX. ", +" ................. ", +" ..XXXXXXXXXXXXX.. ", +" ..XoXoXoXoXoXoX.. ", +" ..XXXX.OOOOXXXX.. ", +" ..XoXo.OOOOoXoX.. ", +" ..XXXXXXXXXXXXX.. ", +" ..XoXo.....oXoX.. ", +" ..XXXXXXXXXXXXX.. ", +" ..XoXoXo.oXoXoX.. ", +" ..XXXXXXXXXXXXX.. ", +" ................. ", +" .XXXXXXXXXXXXXXX. ", +" ..XoXoXoXoXoXoX.. ", +" ..XXXXXXXXXXXXX.. ", +" ..XoXo.....oXoX.. ", +" "}; diff --git a/src/WOKTclLib/resource.xpm b/src/WOKTclLib/resource.xpm new file mode 100755 index 0000000..598fe93 --- /dev/null +++ b/src/WOKTclLib/resource.xpm @@ -0,0 +1,58 @@ +/* XPM */ +static char * resource_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 26 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X s iconColor3 m black c red", +"o c #33338080FFFF", +"O c #33339F9FFFFF", +"+ c #00008080FFFF", +"@ c #00009F9FFFFF", +"# c #CCCCBFBFAAAA", +"$ c #9999BFBFFFFF", +"% c #FFFFBFBF0000", +"& c #FFFF9F9F0000", +"* c #3333BFBF5555", +"= c #3333DFDF0000", +"- c #3333BFBF0000", +"; c #66668080AAAA", +": c #333360605555", +"? c #CCCC80805555", +"> c #FFFF80800000", +", c #CCCC9F9F5555", +"< c #999940405555", +"1 c #CCCC60600000", +"2 c #999960600000", +"3 c #999960605555", +"4 c #333340405555", +"5 c #CCCC80800000", +"6 c #999980805555", +/* pixels */ +" ", +" ", +" ", +" .XX. .oO. ", +" .XXXX.. .+O@O. ", +" .XXXXX#X.oO+OoO. ", +" .XXX$#$X.O+O$O+. ", +" ....XXX#.+OoO##.. ", +" ..XX.%&..O@#.%$ ", +" .*=*...&##&&&&&&# ", +" ..*=*.&.&&$..#$#& ", +" ....-*=.&+O..#.. ", +" ...*=*.@#+O.. ", +" .*##.+Oo##.;. ", +" .X....+O$.XXXXX. ", +" .XXXXXXX:?>XXXXXXX ", +" .XXXXXX#?,<..XXX$#. ", +" .XXXXXX#1<2..XXX##. ", +" .XXXXX.<232.XXX. ", +" .4..#..?5<1<5.#.6; ", +" .,<,.,?,?,?,.;;; ", +" 6;.?5?5?5..;6; ", +" ;;;..??,.;;; ", +" 6;6;.;6; ", +" ;;;; ", +" ; "}; diff --git a/src/WOKTclLib/resource_open.xpm b/src/WOKTclLib/resource_open.xpm new file mode 100755 index 0000000..4579fb6 --- /dev/null +++ b/src/WOKTclLib/resource_open.xpm @@ -0,0 +1,55 @@ +/* XPM */ +static char * resource_open_xpm[] = { +"24 26 26 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #FFFF00000000", +"o c #33338080FFFF", +"O c #33339F9FFFFF", +"+ c #00008080FFFF", +"@ c #00009F9FFFFF", +"# c #CCCCBFBFAAAA", +"$ c #9999BFBFFFFF", +"% c #FFFFBFBF0000", +"& c #FFFF9F9F0000", +"* c #3333BFBF5555", +"= c #3333DFDF0000", +"- c #3333BFBF0000", +"; c #66668080AAAA", +": c #333360605555", +"? c #CCCC80805555", +"> c #FFFF80800000", +", c #CCCC9F9F5555", +"< c #999940405555", +"1 c #CCCC60600000", +"2 c #999960600000", +"3 c #999960605555", +"4 c #333340405555", +"5 c #CCCC80800000", +"6 c #999980805555", +" ", +" ", +" ", +" .XX. .oO. ", +" .XXXX.. .+O@O. ", +" .XXXXX#X.oO+OoO. ", +" .XXX$#$X.O+O$O+. ", +" ....XXX#.+OoO##.. ", +" ..XX.%&..O@#.%$ ", +" .*=*...&##&&&&&&# ", +" ..*=*.&.&&$..#$#& ", +" ....-*=.&+O..#.. ", +" ...*=*.@#+O.. ", +" .*##.+Oo##.;. ", +" .X....+O$.XXXXX. ", +" .XXXXXXX:?>XXXXXXX ", +" .XXXXXX#?,<..XXX$#. ", +" .XXXXXX#1<2..XXX##. ", +" .XXXXX.<232.XXX. ", +" .4..#..?5<1<5.#.6; ", +" .,<,.,?,?,?,.;;; ", +" 6;.?5?5?5..;6; ", +" ;;;..??,.;;; ", +" 6;6;.;6; ", +" ;;;; ", +" ; "}; diff --git a/src/WOKTclLib/rotate.xpm b/src/WOKTclLib/rotate.xpm new file mode 100755 index 0000000..d1639b6 --- /dev/null +++ b/src/WOKTclLib/rotate.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char *cycle_xpm[] = { +/* width height ncolors chars_per_pixel */ +"32 32 4 1", +/* colors */ +"` c black", +"a c red", +"b c white", +"c c blue", +/* pixels */ +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbb````````bbbbbbbbbbbb", +"bbbbbbbbb```aaaaaaaa```bbbbbbbbb", +"bbbbbbbb`aaaaaaaaaaaaaa`bbbbbbbb", +"bbbbbb``aaaaaaaaaaaaaaaa``bbbbbb", +"b```b`aaaaaaaaaaaaaaaaaaaa`bbbbb", +"b`aa`aaaaaaaaaaaaaaaaaaaaaa`bbbb", +"b`aaa`aaaaaaaaaaaaaaaaaaaaaa`bbb", +"b`aaaaaaaaaaa``````aaaaaaaaa`bbb", +"b`baaaaaaaa``bbbbbb``aaaaaaaa`bb", +"b`baaaaaa``bbbbbbbbbb`aaaaaaa`bb", +"b`baaaaaaaa`bbbbbbbbb`aaaaaaaa`b", +"b`baaaaaaaaa`bbbbbbbbb`aaaaaaa`b", +"b`cbaaaaaaa`bbbbbbbbbb`aaabbaa`b", +"b`cbaaaab`bbbbbbbbbbbb`abbccba`b", +"b`ccaabbc`bbbbbbbbbbb`bbccccba`b", +"b`ccbbccc`bbbbbbbbbb`cccccccba`b", +"b`ccccccc`bbbbbbbbb`cccccccccb`b", +"b`cccccccc`bbbbbbbbb`ccccccccb`b", +"bb`ccccccc`bbbbbbbbbb``ccccccc`b", +"bb`cccccccc``bbbbbb``ccccccccc`b", +"bbb`ccccccccc``````cccccccc`cc`b", +"bbb`cccccccccccccccccccccccc`c`b", +"bbbb`cccccccccccccccccccccc`b``b", +"bbbbb`cccccccccccccccccccc`bbbbb", +"bbbbbb``cccccccccccccccc``bbbbbb", +"bbbbbbbb`cccccccccccccc``bbbbbbb", +"bbbbbbbbb```cccccccc````bbbbbbbb", +"bbbbbbbbbbbb````````bbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb", +"bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +}; diff --git a/src/WOKTclLib/scheck.tcl b/src/WOKTclLib/scheck.tcl new file mode 100755 index 0000000..3472f45 --- /dev/null +++ b/src/WOKTclLib/scheck.tcl @@ -0,0 +1,149 @@ + + + +proc scheck { } { + + + set errorCount 0 + set warnCount 0 + + set shop [wokinfo -s] + set warehouse "[wokinfo -f]:[finfo -W]" + + msgprint -c "scheck" -i "Checking BAG installation" + + set parcellist [Winfo -p $warehouse] + set parcelconfig [sinfo -p $shop] + + + msgprint -c "scheck" -i "++ Checking for parcel aggregates" + + foreach parcel $parcellist { + + set parcelfile [wokinfo -p admfile:$parcel.edl $warehouse] + + if { [file exists $parcelfile ] } { + + set phome [wokparam -e %${parcel}_Home] + + if { [file exists $phome] } { + + if { ! [info exists phomes($phome)] } { + set phomes($phome) $parcel + } else { + lappend phomes($phome) $parcel + } + set delivery [pinfo -d ${warehouse}:$parcel] + set allrequisites($parcel) [wokparam -e %${delivery}_AllRequisites ${warehouse}:$parcel] + } else { + msgprint -c "scheck" -e "Wrong parcel declaration for $parcel ($phome does not exist)" + incr errorCount + } + } else { + msgprint -c "scheck" -e "No definition file for $parcel ($parcelfile does not exists)" + incr errorCount + } + + } + + set noagg 1 + foreach aggregate [array names phomes] { + if { [llength $phomes($aggregate) ] > 1 } { + msgprint -c "scheck" -i "+++ Found aggregate : $aggregate containing $phomes($aggregate)" + set agregates($aggregate) $phomes($aggregate) + set noagg 0 + } + } + if $noagg { + msgprint -c "scheck" -i "+++ No aggregate parcels found" + } + msgprint -c "scheck" -i "++" + msgprint -c "scheck" -i "++ Checking $shop configuration" + msgprint -c "scheck" -i "++" + + set conflicts "" + + msgprint -c "scheck" -i "+++ Checking $shop agregates usage" + msgprint -c "scheck" -i "+++" + + foreach parcel $parcelconfig { + foreach agregate [array names agregates] { + if { [lsearch -exact $agregates($agregate) $parcel] >= 0 } { + if [info exists usedagregates($agregate)] { + lappend usedagregates($agregate) $parcel + } else { + set usedagregates($agregate) $parcel + } + } + } + } + + foreach used [array names usedagregates] { + msgprint -c "scheck" -i "++++ $used for $usedagregates($used)" + } + + msgprint -c "scheck" -i "+++" + msgprint -c "scheck" -i "+++ Checking used parcels requisites" + msgprint -c "scheck" -i "+++" + + foreach parcel $parcelconfig { + + foreach requisite [lindex $allrequisites($parcel) 0] { + if { [lsearch -exact $parcelconfig $requisite] == -1 } { + msgprint -c "scheck" -e "$requisite used for $parcel is not in $shop configuration" + incr errorCount + } + } + } + + msgprint -c "scheck" -i "+++" + msgprint -c "scheck" -i "+++ Checking accurate agregates usage" + msgprint -c "scheck" -i "+++" + + foreach parcel $parcelconfig { + foreach agregate [array names agregates] { + if { [lsearch -exact $agregates($agregate) $parcel] >= 0 } { + foreach aggparcel $agregates($agregate) { + if { [lsearch -exact $parcelconfig $aggparcel] == -1 } { + if { [lsearch -exact $conflicts $aggparcel] == -1 } { + lappend conflicts $aggparcel + msgprint -c "scheck" -e "$aggparcel (in $agregate) should be in configuration of workshop $shop" + incr errorCount + } + } + } + } + } + } + + + msgprint -c "scheck" -i "+++" + msgprint -c "scheck" -i "+++ Checking accurate configuration namings" + msgprint -c "scheck" -i "+++" + + foreach parcel $parcelconfig { + scan $parcel "%\[^-\]-%s" name extension + lappend configs($extension) $name + } + + + if { [llength [array names configs]] > 1 } { + + msgprint -c "scheck" -w "More than one configuration extensions are currently in use :" + + foreach extension [array names configs] { + msgprint -c "scheck" -w " $extension used for parcels : $configs($extension)" + incr warnCount + } + + } else { + msgprint -c "scheck" -i "++++ $extension is the current and only configuration used" + } + + if { $errorCount || $warnCount } { + msgprint -c "scheck" -e "$errorCount errors and $warnCount warnings were found in $shop installation and configuration" + msgprint -c "scheck" -e "Please remedy" + } else { + msgprint -c "scheck" -i "No installation or configuration errors was found" + } +} diff --git a/src/WOKTclLib/schema.xpm b/src/WOKTclLib/schema.xpm new file mode 100755 index 0000000..c0887c4 --- /dev/null +++ b/src/WOKTclLib/schema.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * schema_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 11 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #FFFFDFDF0000", +"o c #FFFFBFBF0000", +"O s iconColor3 m black c red", +"+ s iconColor2 m white c white", +"@ c #33339F9F5555", +"# c #333380805555", +"$ c #00008080AAAA", +"% c #66668080AAAA", +"& c #999980805555", +/* pixels */ +" ", +" . ", +" .XX. ", +" .oXoX ", +" XX.XX. ", +" Xo.O.o ", +" .XX.OOXX. ", +" .XoOOOoX. ", +" .XXOOO.XX. ", +" oX.OOO+.oX ", +" XX.OOO++.X. ", +" .o.+OOO+++Xo. ", +" .X.+OO.+++.XX ", +" .o.+OO.+.++oX. ", +" .XX++.O.@#@..XX ", +" .Xo++..@###.oXo ", +" XX...#@$...XXX.. ", +" oX.##@OO.XoX.@#. ", +" .XX@#@.O.X..#.. ", +" ...oX#..X.X.##.%&% ", +" .@XX.XXXX.$@.%%% ", +" &%XoXo..@..%&% ", +" %%XXX.#@.%%% ", +" &%&%.%&% ", +" %%%% ", +" % "}; diff --git a/src/WOKTclLib/schema_open.xpm b/src/WOKTclLib/schema_open.xpm new file mode 100755 index 0000000..d04a4a2 --- /dev/null +++ b/src/WOKTclLib/schema_open.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * schema_open_xpm[] = { +"24 26 11 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #FFFFDFDF0000", +"o c #FFFFBFBF0000", +"O c #FFFF00000000", +"+ c #FFFFFFFFFFFF", +"@ c #33339F9F5555", +"# c #333380805555", +"$ c #00008080AAAA", +"% c #66668080AAAA", +"& c #999980805555", +" ", +" . ", +" .XX. ", +" .oXoX ", +" XX.XX. ", +" Xo.O.o ", +" .XX.OOXX. ", +" .XoOOOoX. ", +" .XXOOO.XX. ", +" oX.OOO+.oX ", +" XX.OOO++.X. ", +" .o.+OOO+++Xo. ", +" .X.+OO.+++.XX ", +" .o.+OO.+.++oX. ", +" .XX++.O.@#@..XX ", +" .Xo++..@###.oXo ", +" XX...#@$...XXX.. ", +" oX.##@OO.XoX.@#. ", +" .XX@#@.O.X..#.. ", +" ...oX#..X.X.##.%&% ", +" .@XX.XXXX.$@.%%% ", +" &%XoXo..@..%&% ", +" %%XXX.#@.%%% ", +" &%&%.%&% ", +" %%%% ", +" % "}; diff --git a/src/WOKTclLib/see.xpm b/src/WOKTclLib/see.xpm new file mode 100755 index 0000000..4f2381f --- /dev/null +++ b/src/WOKTclLib/see.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * small_xpm[] = { +"19 19 14 1", +" c #9999BFBFFFFF", +". c #CCCCBFBFAAAA", +"X c #000000000000", +"o c #66668080AAAA", +"O c #00000000FFFF", +"+ c #CCCCDFDFAAAA", +"@ c #CCCCDFDFFFFF", +"# c #FFFFDFDFAAAA", +"$ c #FFFFFFFFFFFF", +"% c #33338080FFFF", +"& c #9999DFDFFFFF", +"* c #6666BFBFFFFF", +"= c #9999DFDFAAAA", +"- c #999980805555", +" . . . . . . . . . ", +"...................", +" . . . . . . . . . ", +".............XXXXXX", +" . . . . . XXXXXXX ", +".......XXXXXXX.....", +" . . XXXXXXXoooooo ", +"....XXXXXXOOOOOOOO.", +" .XXXXO+@XXXXXXXXX ", +"...O#XXXXXXXXXXXXXX", +" . O@XXXXXXXXXXXXXX", +"..OXX.XXXXX$X%X$$@X", +" OX.XX@$X&*X*&X$$XX", +"..XXX.$$$*= &*$$$XX", +" X X $X$$$*&*$$$XX ", +"..XX$o-o-o-o-o-o-..", +" .X.X. . . . . . . ", +"...................", +" . . . . . . . . . "}; diff --git a/src/WOKTclLib/see_closed.xpm b/src/WOKTclLib/see_closed.xpm new file mode 100755 index 0000000..ecbf7a0 --- /dev/null +++ b/src/WOKTclLib/see_closed.xpm @@ -0,0 +1,37 @@ +/* XPM */ +static char * see_closed_xpm[] = { +"19 19 15 1", +" c #000000005555", +". c #9999BFBFFFFF", +"X c #CCCCBFBFAAAA", +"o c #000000000000", +"O c #999980805555", +"+ c #66668080AAAA", +"@ c #FFFFFFFFFFFF", +"# c #6666BFBFFFFF", +"$ c #9999DFDFFFFF", +"% c #9999DFDFAAAA", +"& c #CCCCDFDFFFFF", +"* c #00000000FFFF", +"= c #33338080FFFF", +"- c #FFFFDFDFAAAA", +"; c #CCCCDFDFAAAA", +" ", +" .X.X.X.X.X.X.X.X.X", +" XXXXXXXXXXXXXXXXXX", +" .X.X.X.X.X.X.XoXoX", +" XXO+O+O+O+O+O+@ooX", +" .oo@@@#$#@@@o@.o.o", +" oo@@@#$.%#@@@XoooX", +" oo@@o$#o#$o@&ooXo*", +" o&@@o=o@oooooXoo*X", +" oooooooooooooo&*.X", +" oooooooooooooo-*XX", +" .ooooooooo&;*ooooX", +" X********ooooooXXX", +" .++++++ooooooo.X.X", +" XXXXXoooooooXXXXXX", +" .ooooooo.X.X.X.X.X", +" ooooooXXXXXXXXXXXX", +" .X.X.X.X.X.X.X.X.X", +" XXXXXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/server.xpm b/src/WOKTclLib/server.xpm new file mode 100755 index 0000000..96ec30b --- /dev/null +++ b/src/WOKTclLib/server.xpm @@ -0,0 +1,53 @@ +/* XPM */ +static char * server_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 21 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #999920200000", +"o c #CCCC40400000", +"O c #999920205555", +"+ c #00008080FFFF", +"@ s iconColor2 m white c white", +"# c #CCCC20200000", +"$ c #FFFFDFDF0000", +"% c #333380805555", +"& c #33339F9F5555", +"* c #33339F9FFFFF", +"= c #CCCC80805555", +"- c #FFFF80800000", +"; c #CCCC80800000", +": c #CCCC9F9F5555", +"? c #33338080FFFF", +"> s iconColor7 m white c cyan", +", c #999940405555", +"< c #66668080AAAA", +"1 c #999980805555", +/* pixels */ +" ", +" ", +" ", +" ..X ", +" oO. . ", +" . .+.@@.#O. ", +" $$. . .+. ", +" .. .%. . ", +" ..$ .@@.$$. ", +" .. .%.&%. . ", +" .*.o..@.%. ", +" . .@.@..$.#. ", +" $$. .$.@..O. ", +" ..$ ..#.@.#O. ", +" ..$ .+.$.%..&.*+ ", +" ..$ .@@.=-=;=.=;. ", +" $$. .@..=:=:=:=:=:. ", +" *?.%.O.+.=;>>=#=;=. ", +" ...&.:===o,==.. ", +" ..-%%.-=;=#,;=.<1< ", +" .:=:=:=:=:=:.<<< ", +" 1<.=;=;=;..<1< ", +" <<<..==:.<<< ", +" 1<1<.<1< ", +" <<<< ", +" < "}; diff --git a/src/WOKTclLib/server_open.xpm b/src/WOKTclLib/server_open.xpm new file mode 100755 index 0000000..7ddc3f5 --- /dev/null +++ b/src/WOKTclLib/server_open.xpm @@ -0,0 +1,55 @@ +/* XPM */ +static char * server_open_xpm[] = { +"24 26 26 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #FFFF00000000", +"o c #33338080FFFF", +"O c #33339F9FFFFF", +"+ c #00008080FFFF", +"@ c #00009F9FFFFF", +"# c #CCCCBFBFAAAA", +"$ c #9999BFBFFFFF", +"% c #FFFFBFBF0000", +"& c #FFFF9F9F0000", +"* c #3333BFBF5555", +"= c #3333DFDF0000", +"- c #3333BFBF0000", +"; c #66668080AAAA", +": c #333360605555", +"? c #CCCC80805555", +"> c #FFFF80800000", +", c #CCCC9F9F5555", +"< c #999940405555", +"1 c #CCCC60600000", +"2 c #999960600000", +"3 c #999960605555", +"4 c #333340405555", +"5 c #CCCC80800000", +"6 c #999980805555", +" ", +" ", +" ", +" .XX. .oO. ", +" .XXXX.. .+O@O. ", +" .XXXXX#X.oO+OoO. ", +" .XXX$#$X.O+O$O+. ", +" ....XXX#.+OoO##.. ", +" ..XX.%&..O@#.%$ ", +" .*=*...&##&&&&&&# ", +" ..*=*.&.&&$..#$#& ", +" ....-*=.&+O..#.. ", +" ...*=*.@#+O.. ", +" .*##.+Oo##.;. ", +" .X....+O$.XXXXX. ", +" .XXXXXXX:?>XXXXXXX ", +" .XXXXXX#?,<..XXX$#. ", +" .XXXXXX#1<2..XXX##. ", +" .XXXXX.<232.XXX. ", +" .4..#..?5<1<5.#.6; ", +" .,<,.,?,?,?,.;;; ", +" 6;.?5?5?5..;6; ", +" ;;;..??,.;;; ", +" 6;6;.;6; ", +" ;;;; ", +" ; "}; diff --git a/src/WOKTclLib/source.xpm b/src/WOKTclLib/source.xpm new file mode 100755 index 0000000..7b448aa --- /dev/null +++ b/src/WOKTclLib/source.xpm @@ -0,0 +1,27 @@ +/* XPM */ +static char * b_green_xpm[] = { +/* width height ncolors chars_per_pixel */ +"14 14 7 1", +/* colors */ +" s None c None", +". c black", +"X c pale green", +"o c lime green", +"O c white", +"+ c sea green", +"@ c dark slate grey", +/* pixels */ +" ", +" .... ", +" .XXXo. ", +" .XOXoo+. ", +" .XXOXXoo+. ", +" .oXoXo+++. ", +" .XoXooo+@. ", +" .oooo+++@. ", +" .oo+o++@@. ", +" .++++@@. ", +" .+@@@. ", +" .... ", +" ", +" "}; diff --git a/src/WOKTclLib/storable.xpm b/src/WOKTclLib/storable.xpm new file mode 100755 index 0000000..f7fbf46 --- /dev/null +++ b/src/WOKTclLib/storable.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char * storable_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"16 16 4 1 -1 -1", +/* colors */ +" s topShadowColor m white c #bdbdbdbdbdbd", +". s iconGray6 m black c #636363636363", +"X s bottomShadowColor m black c #636363636363", +"o s iconColor2 m white c white", +/* pixels */ +" ", +" ..............X", +" ..............X", +" ....ooooooo...X", +" ...o..........X", +" ...o..........X", +" ...o..........X", +" ...o..........X", +" ....oooooo....X", +" ..........o...X", +" ..........o...X", +" ..........o...X", +" ..........o...X", +" ...ooooooo....X", +" ..............X", +" XXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/tclx.nt b/src/WOKTclLib/tclx.nt new file mode 100755 index 0000000..d775577 --- /dev/null +++ b/src/WOKTclLib/tclx.nt @@ -0,0 +1,2086 @@ +# +# arrayprocs.tcl -- +# +# Extended Tcl array procedures. +# +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc for_array_keys {varName arrayName codeFragment} { + upvar $varName enumVar $arrayName enumArray + + if ![info exists enumArray] { + error "\"$arrayName\" isn't an array" + } + + set code 0 + set result {} + set searchId [array startsearch enumArray] + while {[array anymore enumArray $searchId]} { + set enumVar [array nextelement enumArray $searchId] + set code [catch {uplevel 1 $codeFragment} result] + if {$code != 0 && $code != 4} break + } + array donesearch enumArray $searchId + + if {$code == 0 || $code == 3 || $code == 4} { + return $result + } + if {$code == 1} { + global errorCode errorInfo + return -code $code -errorcode $errorCode -errorinfo $errorInfo $result + } + return -code $code $result +} +# +# compat -- +# +# This file provides commands compatible with older versions of Extended Tcl. +# +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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-GenCompat assign_fields cexpand + +proc assign_fields {list args} { + puts stderr {**** Your program is using an obsolete TclX proc, "assign_fields".} + puts stderr {**** Please use the command "lassign". Compatibility support will} + puts stderr {**** be removed in the next release.} + + proc assign_fields {list args} { + if [lempty $args] { + return + } + return [uplevel lassign [list $list] $args] + } + return [uplevel assign_fields [list $list] $args] +} + +# Added TclX 7.4a +proc cexpand str {subst -nocommands -novariables $str} + +#@package: TclX-ServerCompat server_open server_connect server_send \ + server_info server_cntl + +# Added TclX 7.4a + +proc server_open args { + set cmd server_connect + + set buffered 1 + while {[string match -* [lindex $args 0]]} { + set opt [lvarpop args] + if [cequal $opt -buf] { + set buffered 1 + } elseif [cequal $opt -nobuf] { + set buffered 0 + } + lappend cmd $opt + } + set handle [uplevel [concat $cmd $args]] + if $buffered { + lappend handle [dup $handle] + } + return $handle +} + +# Added TclX 7.5a + +proc server_connect args { + set cmd socket + + set buffered 1 + set twoids 0 + while {[string match -* [lindex $args 0]]} { + switch -- [set opt [lvarpop args]] { + -buf { + set buffered 1 + } + -nobuf { + set buffered 0 + } + -myip { + lappend cmd -myaddr [lvarpop args] + } + -myport { + lappend cmd -myport [lvarpop args] + } + -twoids { + set twoids 1 + } + default { + error "unknown option \"$opt\"" + } + } + } + set handle [uplevel [concat $cmd $args]] + if !$buffered { + fconfigure $handle -buffering none + } + if $twoids { + lappend handle [dup $handle] + } + return $handle +} + +proc server_send args { + set cmd puts + + while {[string match -* [lindex $args 0]]} { + switch -- [set opt [lvarpop args]] { + {-dontroute} { + error "server_send if obsolete, -dontroute is not supported by the compatibility proc" + } + {-outofband} { + error "server_send if obsolete, -outofband is not supported by the compatibility proc" + } + } + lappend cmd $opt + } + uplevel [concat $cmd $args] + flush [lindex $args 0] +} + +proc server_info args { + eval [concat host_info $args] +} + +proc server_cntl args { + eval [concat fcntl $args] +} + +#@package: TclX-ClockCompat fmtclock convertclock getclock + +# Added TclX 7.5a + +proc fmtclock {clockval {format {}} {zone {}}} { + lappend cmd clock format $clockval + if ![lempty $format] { + lappend cmd -format $format + } + if ![lempty $zone] { + lappend cmd -gmt 1 + } + return [eval $cmd] +} + +# Added TclX 7.5a + +proc convertclock {dateString {zone {}} {baseClock {}}} { + lappend cmd clock scan $dateString + if ![lempty $zone] { + lappend cmd -gmt 1 + } + if ![lempty $baseClock] { + lappend cmd -base $baseClock + } + return [eval $cmd] +} + +# Added TclX 7.5a + +proc getclock {} { + return [clock seconds] +} + +#@package: TclX-FileCompat mkdir rmdir unlink frename + +# Added TclX 7.6.0 + +proc mkdir args { + set path 0 + if {[llength $args] > 1} { + lvarpop args + set path 1 + } + foreach dir [lindex $args 0] { + if {((!$path) && [file isdirectory $dir]) || \ + ([file exists $dir] && ![file isdirectory $dir])} { + error "creating directory \"$dir\" failed: file already exists" \ + {} {POSIX EEXIST {file already exists}} + } + file mkdir $dir + } + return +} + +# Added TclX 7.6.0 + +proc rmdir args { + set nocomplain 0 + if {[llength $args] > 1} { + lvarpop args + set nocomplain 1 + global errorInfo errorCode + set saveErrorInfo $errorInfo + set saveErrorCode $errorCode + } + foreach dir [lindex $args 0] { + if $nocomplain { + catch {file delete $dir} + } else { + if ![file exists $dir] { + error "can't remove \"$dir\": no such file or directory" {} \ + {POSIX ENOENT {no such file or directory}} + } + if ![cequal [file type $dir] directory] { + error "$dir: not a directory" {} \ + {POSIX ENOTDIR {not a directory}} + } + file delete $dir + } + } + if $nocomplain { + set errorInfo $saveErrorInfo + set errorCode $saveErrorCode + } + return +} + +# Added TclX 7.6.0 + +proc unlink args { + set nocomplain 0 + if {[llength $args] > 1} { + lvarpop args + set nocomplain 1 + global errorInfo errorCode + set saveErrorInfo $errorInfo + set saveErrorCode $errorCode + } + foreach file [lindex $args 0] { + if {[file exists $file] &&[cequal [file type $file] directory]} { + if !$nocomplain { + error "$file: not owner" {} {POSIX EPERM {not owner}} + } + } elseif $nocomplain { + catch {file delete $file} + } else { + if ![file exists $file] { + error "can't remove \"$file\": no such file or directory" {} \ + {POSIX ENOENT {no such file or directory}} + } + file delete $file + } + } + if $nocomplain { + set errorInfo $saveErrorInfo + set errorCode $saveErrorCode + } + return +} + +# Added TclX 7.6.0 + +proc frename {old new} { + if {[file isdirectory $new] && ![lempty [readdir $new]]} { + error "rename \"foo\" to \"baz\" failed: directory not empty" {} \ + POSIX ENOTEMPTY {directory not empty} + } + file rename $old $new +} + +# +# convlib.tcl -- +# +# Convert Ousterhout style tclIndex files and associated libraries to a +# package library. +# +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +#------------------------------------------------------------------------------ +# tclx:ParseTclIndex +# Parse a tclIndex file, returning an array of file names with the list of +# procedures in each package. This is done by sourcing the file and then +# going through the local auto_index array that was created. Issues warnings +# for lines that can't be converted. tclIndex should be an absolute path +# name. Returns 1 if all lines are converted, 0 if some failed. +# + +proc tclx:ParseTclIndex {tclIndex fileTblVar ignore} { + upvar $fileTblVar fileTbl + set allOK 1 + + # Open and validate the file. + + set tclIndexFH [open $tclIndex r] + set hdr [gets $tclIndexFH] + if {!(($hdr == {# Tcl autoload index file, version 2.0}) || + ($hdr == {# Tcl autoload index file, version 2.0 for [incr Tcl]}))} { + error "can only convert version 2.0 Tcl auto-load files" + } + set dir [file dirname $tclIndex] ;# Expected by the script. + eval [read $tclIndexFH] + close $tclIndexFH + + foreach procName [array names auto_index] { + if ![string match "source *" $auto_index($procName)] { + puts stderr "WARNING: Can't convert load command for \"$procName\": $auto_index($procName)" + set allOK 0 + continue + } + set filePath [lindex $auto_index($procName) 1] + set fileName [file tail $filePath] + if {[lsearch $ignore $fileName] >= 0} continue + + lappend fileTbl($filePath) $procName + } + if ![info exists fileTbl] { + error "no entries could be converted in $tclIndex" + } + return $allOK +} + +#------------------------------------------------------------------------------ +# convert_lib: +# Convert a tclIndex library to a .tlib. ignore any files in the ignore +# list + +proc convert_lib {tclIndex packageLib {ignore {}}} { + global tclx_library + source $tclx_library/buildidx.tcl + + if {[file tail $tclIndex] != "tclIndex"} { + error "Tail file name must be `tclIndex': $tclIndex"} + if ![file readable $tclIndex] { + error "File not readable: $tclIndex" + } + + # Expand to root relative file name. + + set tclIndex [glob $tclIndex] + if ![string match "/*" $tclIndex] { + set tclIndex "[pwd]/$tclIndex" + } + + # Parse the file. + + set allOK [tclx:ParseTclIndex $tclIndex fileTbl $ignore] + + # Generate the .tlib package names with contain the directory and + # file name, less any extensions. + + if {[file extension $packageLib] != ".tlib"} { + append packageLib ".tlib" + } + set libFH [open $packageLib w] + + foreach srcFile [array names fileTbl] { + set pkgName [file tail [file dirname $srcFile]]/[file tail [file root $srcFile]] + set srcFH [open $srcFile r] + puts $libFH "#@package: $pkgName $fileTbl($srcFile)\n" + copyfile $srcFH $libFH + close $srcFH + } + close $libFH + buildpackageindex $packageLib + if !$allOK { + error "*** Not all entries converted, but library generated" + } +} +# +# edprocs.tcl -- +# +# Tools for Tcl developers. Procedures to save procs to a file and to edit +# a proc in memory. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc saveprocs {fileName args} { + set fp [open $fileName w] + puts $fp "# tcl procs saved on [fmtclock [getclock]]\n" + puts $fp [eval "showproc $args"] + close $fp +} + +proc edprocs {args} { + global env + + set tmpFilename /tmp/tcldev.[id process] + + set fp [open $tmpFilename w] + puts $fp "\n# TEMP EDIT BUFFER -- YOUR CHANGES ARE FOR THIS SESSION ONLY\n" + puts $fp [eval "showproc $args"] + close $fp + + if [info exists env(EDITOR)] { + set editor $env(EDITOR) + } else { + set editor vi + } + + set startMtime [file mtime $tmpFilename] + system "$editor $tmpFilename" + + if {[file mtime $tmpFilename] != $startMtime} { + source $tmpFilename + echo "Procedures were reloaded." + } else { + echo "No changes were made." + } + unlink $tmpFilename + return +} +# +# eventloop.tcl -- +# +# Eventloop procedure. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc mainloop {} { + global tcl_interactive + + if {[info exists tcl_interactive] && $tcl_interactive} { + commandloop -async -interactive on -endcommand exit + } + set loopVar 0 + catch {vwait loopVar} + exit +} +# +# forfile.tcl -- +# +# Proc to execute code on every line of a file. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc for_file {var filename cmd} { + upvar $var line + set fp [open $filename r] + set code 0 + set result {} + while {[gets $fp line] >= 0} { + set code [catch {uplevel 1 $cmd} result] + if {$code != 0 && $code != 4} break + } + close $fp + + if {$code == 0 || $code == 3 || $code == 4} { + return $result + } + if {$code == 1} { + global errorCode errorInfo + return -code $code -errorcode $errorCode -errorinfo $errorInfo $result + } + return -code $code $result +} +# +# globrecur.tcl -- +# +# Build or process a directory list recursively. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc recursive_glob {dirlist globlist} { + set result {} + set recurse {} + foreach dir $dirlist { + if ![file isdirectory $dir] { + error "\"$dir\" is not a directory" + } + foreach pattern $globlist { + set result [concat $result \ + [glob -nocomplain -- [file join $dir $pattern]]] + } + foreach file [readdir $dir] { + set file [file join $dir $file] + if [file isdirectory $file] { + set fileTail [file tail $file] + if {!(($fileTail == ".") || ($fileTail == ".."))} { + lappend recurse $file + } + } + } + } + if ![lempty $recurse] { + set result [concat $result [recursive_glob $recurse $globlist]] + } + return $result +} + +#@package: TclX-forrecur for_recursive_glob + +proc for_recursive_glob {var dirlist globlist cmd {depth 1}} { + upvar $depth $var myVar + set recurse {} + foreach dir $dirlist { + if ![file isdirectory $dir] { + error "\"$dir\" is not a directory" + } + set code 0 + set result {} + foreach pattern $globlist { + foreach file [glob -nocomplain -- [file join $dir $pattern]] { + set myVar $file + set code [catch {uplevel $depth $cmd} result] + if {$code != 0 && $code != 4} break + } + if {$code != 0 && $code != 4} break + } + if {$code != 0 && $code != 4} { + if {$code == 3} { + return $result + } + if {$code == 1} { + global errorCode errorInfo + return -code $code -errorcode $errorCode \ + -errorinfo $errorInfo $result + } + return -code $code $result + } + + foreach file [readdir $dir] { + set file [file join $dir $file] + if [file isdirectory $file] { + set fileTail [file tail $file] + if {!(($fileTail == ".") || ($fileTail == ".."))} { + lappend recurse $file + } + } + } + } + if ![lempty $recurse] { + return [for_recursive_glob $var $recurse $globlist $cmd \ + [expr {$depth + 1}]] + } + return {} +} +# +# help.tcl -- +# +# Tcl help command. (see TclX manual) +# +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# software for any purpose. It is provided "as is" without express or +# implied warranty. +#------------------------------------------------------------------------------ +# The help facility is based on a hierarchical tree of subjects (directories) +# and help pages (files). There is a virtual root to this tree. The root +# 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 + +#------------------------------------------------------------------------------ +# Return a list of help root directories. + +proc help:RootDirs {} { + global auto_path + set roots {} + foreach dir $auto_path { + if [file isdirectory $dir/help] { + lappend roots $dir/help + } + } + return $roots +} + +#------------------------------------------------------------------------------ +# Take a path name which might have "." and ".." elements and flatten them out. +# Also removes trailing and adjacent "/", unless its the only character. + +proc help:FlattenPath pathName { + set newPath {} + foreach element [split $pathName /] { + if {"$element" == "." || [lempty $element]} continue + + if {"$element" == ".."} { + if {[llength [join $newPath /]] == 0} { + error "Help: name goes above subject directory root" {} \ + [list TCLXHELP NAMEABOVEROOT $pathName] + } + lvarpop newPath [expr [llength $newPath]-1] + continue + } + lappend newPath $element + } + set newPath [join $newPath /] + + # Take care of the case where we started with something line "/" or "/." + + if {("$newPath" == "") && [string match "/*" $pathName]} { + set newPath "/" + } + + return $newPath +} + +#------------------------------------------------------------------------------ +# Given a pathName relative to the virtual help root, convert it to a list of +# real file paths. A list is returned because the path could be "/", returning +# a list of all roots. The list is returned in the same order of the auto_path +# variable. If path does not start with a "/", it is take as relative to the +# current help subject. Note: The root directory part of the name is not +# flattened. This lets other commands pick out the part relative to the +# one of the root directories. + +proc help:ConvertPath pathName { + global TCLXENV + + if {![string match "/*" $pathName]} { + if {"$TCLXENV(help:curSubject)" == "/"} { + set pathName "/$pathName" + } else { + set pathName "$TCLXENV(help:curSubject)/$pathName" + } + } + set pathName [help:FlattenPath $pathName] + + # If the virtual root is specified, return a list of directories. + + if {$pathName == "/"} { + return [help:RootDirs] + } + + # Not the virtual root find the first match. + + foreach dir [help:RootDirs] { + if [file readable $dir/$pathName] { + return [list $dir/$pathName] + } + } + error "\"$pathName\" does not exist" {} \ + [list TCLXHELP NOEXIST $pathName] +} + +#------------------------------------------------------------------------------ +# Return the virtual root relative name of the file given its absolute path. +# The root part of the path should not have been flattened, as we would not +# be able to match it. + +proc help:RelativePath pathName { + foreach dir [help:RootDirs] { + if {[csubstr $pathName 0 [clength $dir]] == $dir} { + set name [csubstr $pathName [clength $dir] end] + if {$name == ""} {set name /} + return $name + } + } + if ![info exists found] { + error "problem translating \"$pathName\"" {} [list TCLXHELP INTERROR] + } +} + +#------------------------------------------------------------------------------ +# Given a list of path names to subjects generated by ConvertPath, return +# the contents of the subjects. Two lists are returned, subjects under that +# subject and a list of pages under the subject. Both lists are returned +# sorted. This merges all the roots into a virtual root. pathName is the +# string that was passed to ConvertPath and is used for error reporting. +# *.brk files are not returned. + +proc help:ListSubject {pathName pathList subjectsVar pagesVar} { + upvar $subjectsVar subjects $pagesVar pages + + set subjects {} + set pages {} + set foundDir 0 + foreach dir $pathList { + if ![file isdirectory $dir] continue + set foundDir 1 + foreach file [glob -nocomplain $dir/*] { + if [string match *.brf $file] continue + if [file isdirectory $file] { + lappend subjects [file tail $file]/ + } else { + lappend pages [file tail $file] + } + } + } + if !$foundDir { + if [cequal $pathName /] { + global auto_path + error "no \"help\" directories found on auto_path ($auto_path)" {} \ + [list TCLXHELP NOHELPDIRS] + } else { + error "\"$pathName\" is not a subject" {} \ + [list TCLXHELP NOTSUBJECT $pathName] + } + } + set subjects [lsort $subjects] + set pages [lsort $pages] + return {} +} + +#------------------------------------------------------------------------------ +# Display a line of output, pausing waiting for input before displaying if the +# screen size has been reached. Return 1 if output is to continue, return +# 0 if no more should be outputed, indicated by input other than return. +# + +proc help:Display line { + global TCLXENV + if {$TCLXENV(help:lineCnt) >= 23} { + set TCLXENV(help:lineCnt) 0 + puts -nonewline stdout ":" + flush stdout + gets stdin response + if {![lempty $response]} { + return 0} + } + puts stdout $line + incr TCLXENV(help:lineCnt) +} + +#------------------------------------------------------------------------------ +# Display a help page (file). + +proc help:DisplayPage filePath { + + set inFH [open $filePath r] + while {[gets $inFH fileBuf] >= 0} { + if {![help:Display $fileBuf]} { + break} + } + close $inFH +} + +#------------------------------------------------------------------------------ +# Display a list of file names in a column format. This use columns of 14 +# characters 3 blanks. + +proc help:DisplayColumns {nameList} { + set count 0 + set outLine "" + foreach name $nameList { + if {$count == 0} { + append outLine " "} + append outLine $name + if {[incr count] < 4} { + set padLen [expr 17-[clength $name]] + if {$padLen < 3} { + set padLen 3} + append outLine [replicate " " $padLen] + } else { + if {![help:Display $outLine]} { + return} + set outLine "" + set count 0 + } + } + if {$count != 0} { + help:Display [string trimright $outLine]} + return +} + +#------------------------------------------------------------------------------ +# Display help on help, the first occurance of a help page called "help" in +# the help root. + +proc help:HelpOnHelp {} { + set helpPage [lindex [help:ConvertPath /help] 0] + if [lempty $helpPage] { + error "No help page on help found" {} \ + [list TCLXHELP NOHELPPAGE] + } + help:DisplayPage $helpPage +} + +#------------------------------------------------------------------------------ +# Help command. + +proc help {{what {}}} { + global TCLXENV + + set TCLXENV(help:lineCnt) 0 + + # Special case "help help", so we can get it at any level. + + if {($what == "help") || ($what == "?")} { + help:HelpOnHelp + return + } + + set pathList [help:ConvertPath $what] + if [file isfile [lindex $pathList 0]] { + help:DisplayPage [lindex $pathList 0] + return + } + + help:ListSubject $what $pathList subjects pages + set relativeDir [help:RelativePath [lindex $pathList 0]] + + if {[llength $subjects] != 0} { + help:Display "\nSubjects available in $relativeDir:" + help:DisplayColumns $subjects + } + if {[llength $pages] != 0} { + help:Display "\nHelp pages available in $relativeDir:" + help:DisplayColumns $pages + } +} + + +#------------------------------------------------------------------------------ +# helpcd command. The name of the new current directory is assembled from the +# current directory and the argument. + +proc helpcd {{dir /}} { + global TCLXENV + + set pathName [lindex [help:ConvertPath $dir] 0] + + if {![file isdirectory $pathName]} { + error "\"$dir\" is not a subject" \ + [list TCLXHELP NOTSUBJECT $dir] + } + + set TCLXENV(help:curSubject) [help:RelativePath $pathName] + return +} + +#------------------------------------------------------------------------------ +# Helpcd main. + +proc helppwd {} { + global TCLXENV + echo "Current help subject: $TCLXENV(help:curSubject)" +} + +#------------------------------------------------------------------------------ +# apropos command. This search the + +proc apropos {regexp} { + global TCLXENV + + set TCLXENV(help:lineCnt) 0 + + set ch [scancontext create] + scanmatch -nocase $ch $regexp { + set path [lindex $matchInfo(line) 0] + set desc [lrange $matchInfo(line) 1 end] + if {![help:Display [format "%s - %s" $path $desc]]} { + set stop 1 + return} + } + set stop 0 + foreach dir [help:RootDirs] { + foreach brief [glob -nocomplain $dir/*.brf] { + set briefFH [open $brief] + scanfile $ch $briefFH + close $briefFH + if $stop break + } + if $stop break + } + scancontext delete $ch +} + +#------------------------------------------------------------------------------ +# One time initialization done when the file is sourced. +# +global TCLXENV + +set TCLXENV(help:curSubject) "/" +# +# profrep -- +# +# Generate Tcl profiling reports. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +# +# Convert the profile array from entries that have only the time spent in +# the proc to the time spend in the proc and all it calls. +# +proc profrep:sum {inDataVar outDataVar} { + upvar 1 $inDataVar inData $outDataVar outData + + foreach inStack [array names inData] { + for {set idx 0} {![lempty [set part [lrange $inStack $idx end]]]} \ + {incr idx} { + if ![info exists outData($part)] { + set outData($part) {0 0 0} + } + lassign $outData($part) count real cpu + if {$idx == 0} { + incr count [lindex $inData($inStack) 0] + } + incr real [lindex $inData($inStack) 1] + incr cpu [lindex $inData($inStack) 2] + set outData($part) [list $count $real $cpu] + } + } +} + +# +# Do sort comparison. May only be called by profrep:sort, as it address its +# local variables. +# +proc profrep:sortcmp {key1 key2} { + upvar profData profData keyIndex keyIndex + + set val1 [lindex $profData($key1) $keyIndex] + set val2 [lindex $profData($key2) $keyIndex] + + if {$val1 < $val2} { + return -1 + } + if {$val1 > $val2} { + return 1 + } + return 0 +} + +# +# Generate a list, sorted in descending order by the specified key, contain +# the indices into the summarized data. +# +proc profrep:sort {profDataVar sortKey} { + upvar $profDataVar profData + + case $sortKey { + {calls} {set keyIndex 0} + {real} {set keyIndex 1} + {cpu} {set keyIndex 2} + default { + error "Expected a sort type of: `calls', `cpu' or ` real'" + } + } + + return [lsort -integer -decreasing -command profrep:sortcmp \ + [array names profData]] +} + +# +# Print the sorted report +# +proc profrep:print {profDataVar sortedProcList outFile userTitle} { + upvar $profDataVar profData + + set maxNameLen 0 + foreach procStack [array names profData] { + foreach procName $procStack { + set maxNameLen [max $maxNameLen [clength $procName]] + } + } + + if {$outFile == ""} { + set outFH stdout + } else { + set outFH [open $outFile w] + } + + # Output a header. + + set stackTitle "Procedure Call Stack" + set maxNameLen [max [expr $maxNameLen+6] [expr [clength $stackTitle]+4]] + set hdr [format "%-${maxNameLen}s %10s %10s %10s" $stackTitle \ + "Calls" "Real Time" "CPU Time"] + if {$userTitle != ""} { + puts $outFH [replicate - [clength $hdr]] + puts $outFH $userTitle + } + puts $outFH [replicate - [clength $hdr]] + puts $outFH $hdr + puts $outFH [replicate - [clength $hdr]] + + # Output the data in sorted order. + + foreach procStack $sortedProcList { + set data $profData($procStack) + puts $outFH [format "%-${maxNameLen}s %10d %10d %10d" \ + [lvarpop procStack] \ + [lindex $data 0] [lindex $data 1] [lindex $data 2]] + foreach procName $procStack { + if {$procName == ""} break + puts $outFH " $procName" + } + } + if {$outFile != ""} { + close $outFH + } +} + +#------------------------------------------------------------------------------ +# Generate a report from data collect from the profile command. +# o profDataVar (I) - The name of the array containing the data from profile. +# o sortKey (I) - Value to sort by. One of "calls", "cpu" or "real". +# o outFile (I) - Name of file to write the report to. If omitted, stdout +# is assumed. +# o userTitle (I) - Title line to add to output. + +proc profrep {profDataVar sortKey {outFile {}} {userTitle {}}} { + upvar $profDataVar profData + + profrep:sum profData sumProfData + set sortedProcList [profrep:sort sumProfData $sortKey] + profrep:print sumProfData $sortedProcList $outFile $userTitle + +} +# +# pushd.tcl -- +# +# C-shell style directory stack procs. +# +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +global TCLXENV(dirPushList) + +set TCLXENV(dirPushList) "" + +proc pushd {{new ""}} { + global TCLXENV + + set current [pwd] + if {[clength $new] > 0} { + set dirs [glob -nocomplain $new] + set count [llength $dirs] + if {$count == 0} { + error "no such directory: $new" + } elseif {$count != 1} { + error "ambiguous directory: $new: [join $directories ", "]" + } + cd [lindex $dirs 0] + lvarpush TCLXENV(dirPushList) $current + } else { + if [lempty $TCLXENV(dirPushList)] { + error "directory stack empty" + } + cd [lindex $TCLXENV(dirPushList) 0] + lvarpop TCLXENV(dirPushList) + lvarpush TCLXENV(dirPushList) $current + } + return [pwd] +} + +proc popd {} { + global TCLXENV + + if [lempty $TCLXENV(dirPushList)] { + error "directory stack empty" + } + cd [lvarpop TCLXENV(dirPushList)] + return [pwd] +} + +proc dirs {} { + global TCLXENV + return [concat [list [pwd]] $TCLXENV(dirPushList)] +} +# +# setfuncs -- +# +# Perform set functions on lists. Also has a procedure for removing duplicate +# list entries. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +# +# return the logical union of two lists, removing any duplicates +# +proc union {lista listb} { + return [lrmdups [concat $lista $listb]] +} + +# +# sort a list, returning the sorted version minus any duplicates +# +proc lrmdups list { + if [lempty $list] { + return {} + } + set list [lsort $list] + set last [lvarpop list] + lappend result $last + foreach element $list { + if ![cequal $last $element] { + lappend result $element + set last $element + } + } + return $result +} + +# +# intersect3 - perform the intersecting of two lists, returning a list +# containing three lists. The first list is everything in the first +# list that wasn't in the second, the second list contains the intersection +# of the two lists, the third list contains everything in the second list +# that wasn't in the first. +# + +proc intersect3 {list1 list2} { + set a1(0) {} ; unset a1(0) + set a2(0) {} ; unset a2(0) + set a3(0) {} ; unset a3(0) + foreach v $list1 { + set a1($v) {} + } + foreach v $list2 { + if [info exists a1($v)] { + set a2($v) {} ; unset a1($v) + } { + set a3($v) {} + } + } + list [lsort [array names a1]] [lsort [array names a2]] \ + [lsort [array names a3]] +} + +# +# intersect - perform an intersection of two lists, returning a list +# containing every element that was present in both lists +# +proc intersect {list1 list2} { + set intersectList "" + + set list1 [lsort $list1] + set list2 [lsort $list2] + + while {1} { + if {[lempty $list1] || [lempty $list2]} break + + set compareResult [string compare [lindex $list1 0] [lindex $list2 0]] + + if {$compareResult < 0} { + lvarpop list1 + continue + } + + if {$compareResult > 0} { + lvarpop list2 + continue + } + + lappend intersectList [lvarpop list1] + lvarpop list2 + } + return $intersectList +} + + +# +# showproc.tcl -- +# +# Display procedure headers and bodies. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc showproc args { + if [lempty $args] { + set args [info procs] + } + set out {} + + foreach procname $args { + if [lempty [info procs $procname]] { + auto_load $procname + } + set arglist [info args $procname] + set nargs {} + while {[llength $arglist] > 0} { + set varg [lvarpop arglist 0] + if [info default $procname $varg defarg] { + lappend nargs [list $varg $defarg] + } else { + lappend nargs $varg + } + } + append out "proc $procname [list $nargs] \{[info body $procname]\}\n" + } + return $out +} +# +# string_file -- +# +# Functions to read and write strings from a file that has not been opened. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc read_file {fileName args} { + if {$fileName == "-nonewline"} { + set flag $fileName + set fileName [lvarpop args] + } else { + set flag {} + } + set fp [open $fileName] + set stat [catch { + eval read $flag $fp $args + } result] + close $fp + if {$stat != 0} { + global errorInfo errorCode + error $result $errorInfo $errorCode + } + return $result +} + +proc write_file {fileName args} { + set fp [open $fileName w] + + set stat [catch { + foreach string $args { + puts $fp $string + } + } result] + close $fp + if {$stat != 0} { + global errorInfo errorCode + error $result $errorInfo $errorCode + } +} + +# +# tcllib.tcl -- +# +# Various command dealing with tlib package libraries. +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# software for any purpose. It is provided "as is" without express or +# implied warranty. +#------------------------------------------------------------------------------ +# Copyright (c) 1991-1994 The Regents of the University of California. +# All rights reserved. +# +# Permission is hereby granted, without written agreement and without +# license or royalty fees, to use, copy, modify, and distribute this +# software and its documentation for any purpose, provided that the +# above copyright notice and the following two paragraphs appear in +# all copies of this software. +# +# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR +# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT +# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF +# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +# +# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY +# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS +# 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 + +#------------------------------------------------------------------------------ +# searchpath: +# Search a path list for a file. (catch is for bad ~user) +# +proc searchpath {pathlist file} { + foreach dir $pathlist { + if {$dir == ""} {set dir .} + if {[catch {file exists $dir/$file} result] == 0 && $result} { + return $dir/$file + } + } + return {} +} + +#------------------------------------------------------------------------------ +# auto_load_file: +# Search auto_path for a file and source it. +# +proc auto_load_file {name} { + global auto_path errorCode + if {[string first / $name] >= 0} { + return [uplevel 1 source $name] + } + set where [searchpath $auto_path $name] + if [lempty $where] { + error "couldn't find $name in any directory in auto_path" + } + uplevel 1 source $where +} + +#@package: TclX-lib-list auto_packages auto_commands + +#------------------------------------------------------------------------------ +# auto_packages: +# List all of the loadable packages. If -files is specified, the file paths +# of the packages is also returned. + +proc auto_packages {{option {}}} { + global auto_pkg_index + + auto_load ;# Make sure all indexes are loaded. + if ![info exists auto_pkg_index] { + return {} + } + + set packList [array names auto_pkg_index] + if [lempty $option] { + return $packList + } + + if {$option != "-files"} { + error "Unknow option \"$option\", expected \"-files\"" + } + set locList {} + foreach pack $packList { + lappend locList [list $pack [lindex $auto_pkg_index($pack) 0]] + } + return $locList +} + +#------------------------------------------------------------------------------ +# auto_commands: +# List all of the loadable commands. If -loaders is specified, the commands +# that will be involked to load the commands is also returned. + +proc auto_commands {{option {}}} { + global auto_index + + auto_load ;# Make sure all indexes are loaded. + if ![info exists auto_index] { + return {} + } + + set cmdList [array names auto_index] + if [lempty $option] { + return $cmdList + } + + if {$option != "-loaders"} { + error "Unknow option \"$option\", expected \"-loaders\"" + } + set loadList {} + foreach cmd $cmdList { + lappend loadList [list $cmd $auto_index($cmd)] + } + return $loadList +} + +# +# fmath.tcl -- +# +# Contains a package of procs that interface to the Tcl expr command built-in +# functions. These procs provide compatibility with older versions of TclX and +# are also generally useful. +#------------------------------------------------------------------------------ +# Copyright 1993-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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 + +proc acos x {uplevel [list expr acos($x)]} +proc asin x {uplevel [list expr asin($x)]} +proc atan x {uplevel [list expr atan($x)]} +proc ceil x {uplevel [list expr ceil($x)]} +proc cos x {uplevel [list expr cos($x)]} +proc cosh x {uplevel [list expr cosh($x)]} +proc exp x {uplevel [list expr exp($x)]} +proc fabs x {uplevel [list expr abs($x)]} +proc floor x {uplevel [list expr floor($x)]} +proc log x {uplevel [list expr log($x)]} +proc log10 x {uplevel [list expr log10($x)]} +proc sin x {uplevel [list expr sin($x)]} +proc sinh x {uplevel [list expr sinh($x)]} +proc sqrt x {uplevel [list expr sqrt($x)]} +proc tan x {uplevel [list expr tan($x)]} +proc tanh x {uplevel [list expr tanh($x)]} + +proc fmod {x n} {uplevel [list expr fmod($x,$n)]} +proc pow {x n} {uplevel [list expr pow($x,$n)]} + +# New functions that TclX did not provide in eariler versions. + +proc atan2 x {uplevel [list expr atan2($x)]} +proc abs x {uplevel [list expr abs($x)]} +proc double x {uplevel [list expr double($x)]} +proc int x {uplevel [list expr int($x)]} +proc round x {uplevel [list expr round($x)]} + +# +# buildhelp.tcl -- +# +# Program to extract help files from TCL manual pages or TCL script files. +# The help directories are built as a hierarchical tree of subjects and help +# files. +# +#------------------------------------------------------------------------------ +# Copyright 1992-1996 Karl Lehenbauer and Mark Diekhans. +# +# Permission to use, copy, modify, and distribute this software and its +# documentation for any purpose and without fee is hereby granted, provided +# that the above copyright notice appear in all copies. Karl Lehenbauer and +# Mark Diekhans make no representations about the suitability of this +# 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: +# +# '\"@help: subjectdir/helpfile +# '\"@endhelp +# +# start in column one. The text between these markers is extracted and stored +# in help/subjectdir/help. The file must not exists, this is done to enforced +# cleaning out the directories before help file generation is started, thus +# removing any stale files. The extracted text is run through: +# +# nroff -man|col -xb {col -b on BSD derived systems} +# +# If there is other text to include in the helpfile, but not in the manual +# page, the text, along with nroff formatting commands, may be included using: +# +# '\"@:Other text to include in the help page. +# +# A entry in the brief file, used by apropos my be included by: +# +# '\"@brief: Short, one line description +# +# These brief request must occur with in the bounds of a help section. +# +# If some header text, such as nroff macros, need to be preappended to the +# text streem before it is run through nroff, then that text can be bracketed +# with: +# +# '\"@header +# '\"@endheader +# +# If multiple header blocks are encountered, they will all be preappended. +# +# For TCL script files, which are indentified because they end in ".tcl", +# the text to be extracted is delimited by: +# +# #@help: subjectdir/helpfile +# #@endhelp +# +# And brief lines are in the form: +# +# #@brief: Short, one line description +# +# The only processing done on text extracted from .tcl files it to replace +# the # in column one with a space. +# +# +#----------------------------------------------------------------------------- +# +# To generate help: +# +# buildhelp helpDir brief.brf filelist +# +# o helpDir is the help tree root directory. helpDir should exists, but any +# subdirectories that don't exists will be created. helpDir should be +# cleaned up before the start of manual page generation, as this program +# will not overwrite existing files. +# o brief.brf is the name of the brief file to create form the @brief entries. +# It must have an extension of ".brf". It will be created in helpDir. +# o filelist are the nroff manual pages, or .tcl, .tlib files to extract +# the help files from. If the suffix is not .tcl or .tlib, a nroff manual +# page is assumed. +# +#----------------------------------------------------------------------------- + +#@package: TclX-buildhelp buildhelp + +#----------------------------------------------------------------------------- +# Truncate a file name of a help file if the system does not support long +# file names. If the name starts with `Tcl_', then this prefix is removed. +# If the name is then over 14 characters, it is truncated to 14 charactes +# +proc TruncFileName {pathName} { + global truncFileNames + + if {!$truncFileNames} { + return $pathName} + set fileName [file tail $pathName] + if {"[crange $fileName 0 3]" == "Tcl_"} { + set fileName [crange $fileName 4 end]} + set fileName [crange $fileName 0 13] + return "[file dirname $pathName]/$fileName" +} + +#----------------------------------------------------------------------------- +# Proc to ensure that all directories for the specified file path exists, +# and if they don't create them. Don't use -path so we can set the +# permissions. + +proc EnsureDirs {filePath} { + set dirPath [file dirname $filePath] + if [file exists $dirPath] return + foreach dir [split $dirPath /] { + lappend dirList $dir + set partPath [join $dirList /] + if [file exists $partPath] continue + + mkdir $partPath + chmod u=rwx,go=rx $partPath + } +} + +#----------------------------------------------------------------------------- +# Proc to set up scan context for use by FilterNroffManPage. +# This keeps the a two line cache of the previous two lines encountered +# and the blank lines that followed them. +# + +proc CreateFilterNroffManPageContext {} { + global filterNroffManPageContext + + set filterNroffManPageContext [scancontext create] + + # On finding a page header, drop the previous line (which is + # the page footer). Also deleting the blank lines followin + # the last line on the previous page. + + scanmatch $filterNroffManPageContext {@@@BUILDHELP@@@} { + catch {unset prev2Blanks} + catch {unset prev1Line} + catch {unset prev1Blanks} + set nukeBlanks {} + } + + # Save blank lines + + scanmatch $filterNroffManPageContext {$^} { + if ![info exists nukeBlanks] { + append prev1Blanks \n + } + } + + # Non-blank line, save it. Output the 2nd previous line if necessary. + + scanmatch $filterNroffManPageContext { + catch {unset nukeBlanks} + if [info exists prev2Line] { + puts $outFH $prev2Line + unset prev2Line + } + if [info exists prev2Blanks] { + puts $outFH $prev2Blanks nonewline + unset prev2Blanks + } + if [info exists prev1Line] { + set prev2Line $prev1Line + } + set prev1Line $matchInfo(line) + if [info exists prev1Blanks] { + set prev2Blanks $prev1Blanks + unset prev1Blanks + } + } +} + +#----------------------------------------------------------------------------- +# Proc to filter a formatted manual page, removing the page headers and +# footers. This relies on each manual page having a .TH macro in the form: +# .TH @@@BUILDHELP@@@ n + +proc FilterNroffManPage {inFH outFH} { + global filterNroffManPageContext + + if ![info exists filterNroffManPageContext] { + CreateFilterNroffManPageContext + } + + scanfile $filterNroffManPageContext $inFH + + if [info exists prev2Line] { + puts $outFH $prev2Line + } +} + +#----------------------------------------------------------------------------- +# Proc to set up scan context for use by ExtractNroffHeader +# + +proc CreateExtractNroffHeaderContext {} { + global extractNroffHeaderContext + + set extractNroffHeaderContext [scancontext create] + + scanmatch $extractNroffHeaderContext {'\\"@endheader[ ]*$} { + break + } + scanmatch $extractNroffHeaderContext {'\\"@:} { + append nroffHeader "[crange $matchInfo(line) 5 end]\n" + } + scanmatch $extractNroffHeaderContext { + append nroffHeader "$matchInfo(line)\n" + } +} + +#----------------------------------------------------------------------------- +# Proc to extract nroff text to use as a header to all pass to nroff when +# processing a help file. +# manPageFH - The file handle of the manual page. +# + +proc ExtractNroffHeader {manPageFH} { + global extractNroffHeaderContext nroffHeader + + if ![info exists extractNroffHeaderContext] { + CreateExtractNroffHeaderContext + } + scanfile $extractNroffHeaderContext $manPageFH +} + + +#----------------------------------------------------------------------------- +# Proc to set up scan context for use by ExtractNroffHelp +# + +proc CreateExtractNroffHelpContext {} { + global extractNroffHelpContext + + set extractNroffHelpContext [scancontext create] + + scanmatch $extractNroffHelpContext {^'\\"@endhelp[ ]*$} { + break + } + + scanmatch $extractNroffHelpContext {^'\\"@brief:} { + if $foundBrief { + error {Duplicate "@brief:" entry} + } + set foundBrief 1 + puts $briefHelpFH "$helpName\t[csubstr $matchInfo(line) 11 end]" + continue + } + + scanmatch $extractNroffHelpContext {^'\\"@:} { + puts $nroffFH [csubstr $matchInfo(line) 5 end] + continue + } + scanmatch $extractNroffHelpContext {^'\\"@help:} { + error {"@help" found within another help section"} + } + scanmatch $extractNroffHelpContext { + puts $nroffFH $matchInfo(line) + } +} + +#----------------------------------------------------------------------------- +# Proc to extract a nroff help file when it is located in the text. +# manPageFH - The file handle of the manual page. +# manLine - The '\"@help: line starting the data to extract. +# + +proc ExtractNroffHelp {manPageFH manLine} { + global helpDir nroffHeader briefHelpFH colArgs + global extractNroffHelpContext + + if ![info exists extractNroffHelpContext] { + CreateExtractNroffHelpContext + } + + set helpName [string trim [csubstr $manLine 9 end]] + set helpFile [TruncFileName "$helpDir/$helpName"] + if [file exists $helpFile] { + error "Help file already exists: $helpFile" + } + EnsureDirs $helpFile + + set tmpFile "[file dirname $helpFile]/tmp.[id process]" + + echo " creating help file $helpName" + + set nroffFH [open "| nroff -man | col $colArgs > $tmpFile" w] + + puts $nroffFH {.TH @@@BUILDHELP@@@ 1} + + set foundBrief 0 + scanfile $extractNroffHelpContext $manPageFH + + # Close returns an error on if anything comes back on stderr, even if + # its a warning. Output errors and continue. + + set stat [catch { + close $nroffFH + } msg] + if $stat { + puts stderr "nroff: $msg" + } + + set tmpFH [open $tmpFile r] + set helpFH [open $helpFile w] + + FilterNroffManPage $tmpFH $helpFH + + close $tmpFH + close $helpFH + + unlink $tmpFile + chmod a-w,a+r $helpFile +} + +#----------------------------------------------------------------------------- +# Proc to set up scan context for use by ExtractScriptHelp +# + +proc CreateExtractScriptHelpContext {} { + global extractScriptHelpContext + + set extractScriptHelpContext [scancontext create] + + scanmatch $extractScriptHelpContext {^#@endhelp[ ]*$} { + break + } + + scanmatch $extractScriptHelpContext {^#@brief:} { + if $foundBrief { + error {Duplicate "@brief" entry} + } + set foundBrief 1 + puts $briefHelpFH "$helpName\t[csubstr $matchInfo(line) 9 end]" + continue + } + + scanmatch $extractScriptHelpContext {^#@help:} { + error {"@help" found within another help section"} + } + + scanmatch $extractScriptHelpContext {^#$} { + puts $helpFH "" + } + + scanmatch $extractScriptHelpContext { + if {[clength $matchInfo(line)] > 1} { + puts $helpFH " [csubstr $matchInfo(line) 1 end]" + } else { + puts $helpFH $matchInfo(line) + } + } +} + +#----------------------------------------------------------------------------- +# Proc to extract a tcl script help file when it is located in the text. +# ScriptPageFH - The file handle of the .tcl file. +# ScriptLine - The #@help: line starting the data to extract. +# + +proc ExtractScriptHelp {scriptPageFH scriptLine} { + global helpDir briefHelpFH + global extractScriptHelpContext + + if ![info exists extractScriptHelpContext] { + CreateExtractScriptHelpContext + } + + set helpName [string trim [csubstr $scriptLine 7 end]] + set helpFile "$helpDir/$helpName" + if {[file exists $helpFile]} { + error "Help file already exists: $helpFile" + } + EnsureDirs $helpFile + + echo " creating help file $helpName" + + set helpFH [open $helpFile w] + + set foundBrief 0 + scanfile $extractScriptHelpContext $scriptPageFH + + close $helpFH + chmod a-w,a+r $helpFile +} + +#----------------------------------------------------------------------------- +# Proc to scan a nroff manual file looking for the start of a help text +# sections and extracting those sections. +# pathName - Full path name of file to extract documentation from. +# + +proc ProcessNroffFile {pathName} { + global nroffScanCT scriptScanCT nroffHeader + + set fileName [file tail $pathName] + + set nroffHeader {} + set manPageFH [open $pathName r] + set matchInfo(fileName) [file tail $pathName] + + echo " scanning $pathName" + + scanfile $nroffScanCT $manPageFH + + close $manPageFH +} + +#----------------------------------------------------------------------------- +# Proc to scan a Tcl script file looking for the start of a +# help text sections and extracting those sections. +# pathName - Full path name of file to extract documentation from. +# + +proc ProcessTclScript {pathName} { + global scriptScanCT nroffHeader + + set scriptFH [open "$pathName" r] + set matchInfo(fileName) [file tail $pathName] + + echo " scanning $pathName" + scanfile $scriptScanCT $scriptFH + + close $scriptFH +} + +#----------------------------------------------------------------------------- +# build: main procedure. Generates help from specified files. +# helpDirPath - Directory were the help files go. +# briefFile - The name of the brief file to create. +# sourceFiles - List of files to extract help files from. + +proc buildhelp {helpDirPath briefFile sourceFiles} { + global helpDir truncFileNames nroffScanCT + global scriptScanCT briefHelpFH colArgs + + echo "" + echo "Begin building help tree" + + # Determine version of col command to use (no -x on BSD) + if {[system {col -bx /dev/null 2>&1}] != 0} { + set colArgs {-b} + } else { + set colArgs {-bx} + } + set helpDir $helpDirPath + if {![file exists $helpDir]} { + mkdir $helpDir + } + + if {![file isdirectory $helpDir]} { + error [concat "$helpDir is not a directory or does not exist. " + "This should be the help root directory"] + } + + set status [catch {set tmpFH [open $helpDir/AVeryVeryBigFileName w]}] + if {$status != 0} { + set truncFileNames 1 + } else { + close $tmpFH + unlink $helpDir/AVeryVeryBigFileName + set truncFileNames 0 + } + + set nroffScanCT [scancontext create] + + scanmatch $nroffScanCT {'\\"@help:} { + ExtractNroffHelp $matchInfo(handle) $matchInfo(line) + continue + } + + scanmatch $nroffScanCT {^'\\"@header} { + ExtractNroffHeader $matchInfo(handle) + continue + } + scanmatch $nroffScanCT {^'\\"@endhelp} { + error [concat {@endhelp" without corresponding "@help:"} \ + ", offset = $matchInfo(offset)"] + } + scanmatch $nroffScanCT {^'\\"@brief} { + error [concat {"@brief" without corresponding "@help:"} \ + ", offset = $matchInfo(offset)"] + } + + set scriptScanCT [scancontext create] + scanmatch $scriptScanCT {^#@help:} { + ExtractScriptHelp $matchInfo(handle) $matchInfo(line) + } + + if {[file extension $briefFile] != ".brf"} { + error "Brief file \"$briefFile\" must have an extension \".brf\"" + } + if [file exists $helpDir/$briefFile] { + error "Brief file \"$helpDir/$briefFile\" already exists" + } + set briefHelpFH [open "|sort > $helpDir/$briefFile" w] + + foreach manFile [glob $sourceFiles] { + set ext [file extension $manFile] + if {$ext == ".tcl" || $ext == ".tlib"} { + set status [catch {ProcessTclScript $manFile} msg] + } else { + set status [catch {ProcessNroffFile $manFile} msg] + } + if {$status != 0} { + global errorInfo errorCode + error "Error extracting help from: $manFile" $errorInfo $errorCode + } + } + + close $briefHelpFH + chmod a-w,a+r $helpDir/$briefFile + echo "Completed extraction of help files" +} + diff --git a/src/WOKTclLib/textfile_adm.xpm b/src/WOKTclLib/textfile_adm.xpm new file mode 100755 index 0000000..ac1dd87 --- /dev/null +++ b/src/WOKTclLib/textfile_adm.xpm @@ -0,0 +1,19 @@ +/* XPM */ +static char * textfile_adm[] = { +"12 12 3 1", +" s None c None", +". c orange", +"X c #FFFFFFFFF3CE", +" XXXXXXXX ", +" X......X ", +" X......XXX ", +" X........X ", +" X........X ", +" X........X ", +" X........X ", +" X........X ", +" X........X ", +" X........X ", +" X........X ", +" XXXXXXXXXX "}; + diff --git a/src/WOKTclLib/textfile_rdonly.xpm b/src/WOKTclLib/textfile_rdonly.xpm new file mode 100755 index 0000000..d18f667 --- /dev/null +++ b/src/WOKTclLib/textfile_rdonly.xpm @@ -0,0 +1,18 @@ +/* XPM */ +static char * textfile_xpm[] = { +"12 12 3 1", +" s None c None", +". c tomato", +"X c #FFFFFFFFF3CE", +" ........ ", +" .XXX..X. ", +" .XXX..X... ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .XXX..XXX. ", +" .......... "}; diff --git a/src/WOKTclLib/toolkit.xpm b/src/WOKTclLib/toolkit.xpm new file mode 100755 index 0000000..ec0addc --- /dev/null +++ b/src/WOKTclLib/toolkit.xpm @@ -0,0 +1,54 @@ +/* XPM */ +static char * toolkit_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"24 26 22 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #999960605555", +"o c #999960600000", +"O c #999940405555", +"+ c #CCCC60600000", +"@ c #CCCC80805555", +"# c #CCCC9F9F5555", +"$ c #CCCC80800000", +"% c #FFFF80800000", +"& c #9999BFBFFFFF", +"* c #9999DFDFAAAA", +"= c #9999DFDFFFFF", +"- c #6666BFBFFFFF", +"; c #33339F9F5555", +": c #333340405555", +"? c #333360605555", +"> c #333380805555", +", c #333360600000", +"< c #66668080AAAA", +"1 c #999980805555", +"2 c #00008080AAAA", +/* pixels */ +" ", +" ", +" .XoOoXo. ", +" ..O..+O+. ", +" XX.@#X.. ", +" .oO..$@ ", +" OoX..@@# ", +" .+O. .@%@ ", +" .. .#@# ", +" .@$@ ", +" .@@# . ", +" .@%@ &*. ", +" .#@# =.=-=. ", +" .@$@ &..*&=. ", +" .@@# =.;:?.=-. ", +" .@%@.&.:.&*.>. ", +" .#@#>=..-=.;>;. ", +" .@$@;&=.;>>>;>. ", +" .?.@@#>.>;>;>.. ", +" ..,:.@..>>;>>>.<1< ", +" .;2?.;2;>;2;.<<< ", +" 1<.>;>>>;..<1< ", +" <<<..;>;.<<< ", +" 1<1<.<1< ", +" <<<< ", +" < "}; diff --git a/src/WOKTclLib/toolkit_open.xpm b/src/WOKTclLib/toolkit_open.xpm new file mode 100755 index 0000000..6a6b017 --- /dev/null +++ b/src/WOKTclLib/toolkit_open.xpm @@ -0,0 +1,51 @@ +/* XPM */ +static char * toolkit_open_xpm[] = { +"24 26 22 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #999960605555", +"o c #999960600000", +"O c #999940405555", +"+ c #CCCC60600000", +"@ c #CCCC80805555", +"# c #CCCC9F9F5555", +"$ c #CCCC80800000", +"% c #FFFF80800000", +"& c #9999BFBFFFFF", +"* c #9999DFDFAAAA", +"= c #9999DFDFFFFF", +"- c #6666BFBFFFFF", +"; c #33339F9F5555", +": c #333340405555", +"? c #333360605555", +"> c #333380805555", +", c #333360600000", +"< c #66668080AAAA", +"1 c #999980805555", +"2 c #00008080AAAA", +" ", +" ", +" .XoOoXo. ", +" ..O..+O+. ", +" XX.@#X.. ", +" .oO..$@ ", +" OoX..@@# ", +" .+O. .@%@ ", +" .. .#@# ", +" .@$@ ", +" .@@# . ", +" .@%@ &*. ", +" .#@# =.=-=. ", +" .@$@ &..*&=. ", +" .@@# =.;:?.=-. ", +" .@%@.&.:.&*.>. ", +" .#@#>=..-=.;>;. ", +" .@$@;&=.;>>>;>. ", +" .?.@@#>.>;>;>.. ", +" ..,:.@..>>;>>>.<1< ", +" .;2?.;2;>;2;.<<< ", +" 1<.>;>>>;..<1< ", +" <<<..;>;.<<< ", +" 1<1<.<1< ", +" <<<< ", +" < "}; diff --git a/src/WOKTclLib/transient.xpm b/src/WOKTclLib/transient.xpm new file mode 100755 index 0000000..f3c2c70 --- /dev/null +++ b/src/WOKTclLib/transient.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char * transient_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"16 16 4 1 -1 -1", +/* colors */ +" s topShadowColor m white c #bdbdbdbdbdbd", +". s iconGray6 m black c #636363636363", +"X s bottomShadowColor m black c #636363636363", +"o s iconColor2 m white c white", +/* pixels */ +" ", +" ..............X", +" ..............X", +" ..oooooooooo..X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ......o.......X", +" ..............X", +" ..............X", +" XXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/unit.xpm b/src/WOKTclLib/unit.xpm new file mode 100755 index 0000000..3b8449c --- /dev/null +++ b/src/WOKTclLib/unit.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * dir_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 5 1", +/* colors */ +" s None c None", +". c black", +"X c wheat", +"o c sienna", +"O c dark slate grey", +/* pixels */ +" ", +" ", +" ", +" ", +" ........ ", +" .XXXXXXXX. ", +".XXXXXXXXXX...... ", +".oXXXXXXXXoXXXXXX. ", +".XooooooooXXXXXXXo. ", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +".XXXXXXXXXXXXXXXXoO.", +" .oooooooooooooooOO.", +" .OOOOOOOOOOOOOOO.O", +" ...............O "}; diff --git a/src/WOKTclLib/unit_open.xpm b/src/WOKTclLib/unit_open.xpm new file mode 100755 index 0000000..a64a9b6 --- /dev/null +++ b/src/WOKTclLib/unit_open.xpm @@ -0,0 +1,34 @@ +/* XPM */ +static char * dir_open_xpm[] = { +/* width height ncolors chars_per_pixel */ +"27 22 6 1", +/* colors */ +" s None c None", +". c black", +"X c grey", +"o c wheat", +"O c sienna", +"+ c dark slate grey", +/* pixels */ +" ", +" ", +" ", +" ", +" ........ ", +" .XXXXXXXX. ", +".XXXXXXXXXX...... ", +".XXXXXXXXXXXXXXXX. ", +".XXXXXXXXXXXXXXXXX. ", +".XXXXXXXXX.XXXXXXXX....... ", +".XXXXXXXX.o.XXXXXX.ooooooO.", +".XXXXXXX.ooo......ooooooO+.", +".XXXXXX.oooooooooooooooO+. ", +".XXXXX.oooooooooooooooO+. ", +".XXXX.oooooooooooooooO+. ", +".XXX.oooooooooooooooO+. ", +".XX.oooooooooooooooO+. ", +".X.oooooooooooooooO+. ", +"..oooooooooooooooO+. ", +" .OOOOOOOOOOOOOO++. ", +" .+++++++++++++.. ", +" .............. "}; diff --git a/src/WOKTclLib/unit_rdonly.xpm b/src/WOKTclLib/unit_rdonly.xpm new file mode 100755 index 0000000..b7c16b8 --- /dev/null +++ b/src/WOKTclLib/unit_rdonly.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * dir_sec_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 7 1", +/* colors */ +" s None c None", +". c black", +"X c wheat", +"o c tomato", +"O c firebrick", +"+ c sienna", +"@ c dark slate grey", +/* pixels */ +" ", +" ", +" ", +" ", +" ........ ", +" .XXXXXXXX.oooo ", +".XXXXXXXXXXooooO. ", +".+XXXXXXXX+ooooOX. ", +".X++++++++XooooOX+. ", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +".XXXXXXXXXXooooOX+@.", +" .+++++++++ooooO+@@.", +" .@@@@@@@@ooooO@@.@", +" .........OOOO..@ "}; diff --git a/src/WOKTclLib/upack.tcl b/src/WOKTclLib/upack.tcl new file mode 100755 index 0000000..daa427a --- /dev/null +++ b/src/WOKTclLib/upack.tcl @@ -0,0 +1,707 @@ +proc upack_usage { } { + puts stderr \ + { + Usage: upack -[hcrl] [-t ,... ] + + upack -h + + Displays this text + + upack -c [Unit] -o Archnamecompress + + Creates archive from Unit. If Unit is not + specified, then uses the current one. This is the default + option. + + upack -r Archname [-d TclScript] + + Creates a unit in the current environment using . + Basename of is used as the unit name, its extension + as the unit type (package nocdlpack schema executable etc... ) + + If -d option is specified, uses TclScript for backuping + the files from the archive. + + upack -l Archname + + Displays the contents of + + Options -t can be used to select one or more specifics types + + Examples: + To create an archive with only "source" and "object" types: + > upack -c [Unit] -o Archname -t source,object + + } + return +} + +proc upack { args } { + + ;# Options + ;# + set tblreq(-c) default + set tblreq(-h) {} + set tblreq(-l) {} + set tblreq(-r) {} + set tblreq(-v) {} + set tblreq(-d) value_required:file + set tblreq(-o) value_required:file + set tblreq(-t) value_required:list + + ;# Si on n'est sur de n'avoir que de l'ascii + ;# + set tblreq(-f) {} + set tblreq(-F) value_required:string + + ;# Parameters + ;# + set param {} + + if { [wokUtils:EASY:GETOPT param table tblreq upack_usage $args] == -1 } return + + if { [info exists table(-h)] } { + upack_usage + return + } + + set verbose [info exists table(-v)] + + set typsel {} + if { [info exists table(-t)] } { + set typsel $table(-t) + } + + if { [info exists table(-c)] } { + set Uadr [lindex $param 0] + if { $Uadr == {} } { + set Uadr [wokcd] + } + if { [info exists table(-o)] } { + set Zadr $table(-o) + if ![catch {set idar [open $Zadr w]} status] { + if { [info exists table(-f)] } { + if { [info exists table(-F)] } { + auto_load $table(-F) + upack:Fold [$table(-F) $Uadr $verbose] $idar {} $verbose + } else { + upack:Fold [uinfo -Fp -Tsource $Uadr] $idar {} $verbose + } + } else { + if { $typsel == {} } { + set typsel [upack:Upackable] + } + upack:Fold [wokUtils:LIST:Filter [uinfo -Fp $Uadr] upack:UOK 2] $idar $typsel $verbose + } + close $idar + wokUtils:FILES:compress $Zadr + } else { + puts stderr "Error: $status" + } + } else { + upack_usage + } + return + } + + if { [info exists table(-l)] } { + set Zadr [lindex $param 0] + set adr [wokUtils:FILES:SansZ $Zadr] + if { $adr != -1} { + if ![catch {set idar [open $adr r]} status] { + upack:LsFold $idar $typsel + close $idar + } else { + puts stderr "Error: $status" + } + if [file exists $adr] { + catch {unlink $adr} + } + } + return + } + + if { [info exists table(-r)] } { + set Zadr [lindex $param 0] + set adr [wokUtils:FILES:SansZ $Zadr] + if { $adr != -1} { + if ![catch {set idar [open $adr r]} status] { + set dirtmp [wokUtils:FILES:tmpname {}] + upack:UnFold $idar stderr $dirtmp $typsel $verbose + close $idar + } else { + puts stderr "Error: $status" + } + if [file exists $adr] { + catch {unlink $adr} + } + } + return + } + + upack_usage + return +} +# +# Retourne le full path du fichier ou il faut restaurer le fichier +# de nom et de type . Retourne -1 sinon. +# Cette fonction peut etre redefinie en fonction de ce que l'on souhaite faire +# Ce qui suit permet de recreer les fichiers dans le cadre d'une UD Wok++. deja existante. +# +proc upack:GetBackupName { type name } { + ;#puts stdout "type = $type name = $name longeur de name : [string length $name]" + if { [string length $name] != 0 } { + catch {unset filename} + if { ![catch {set filename [wokinfo -p ${type}:${name}] }] } { + set dna [file dirname $filename] + if {[file exists $dna]} { + return $filename + } else { + msgprint -w "Directory $dna not found. File $name not restaured." + return -1 + } + } else { + msgprint -w "Unable to get type of ${type}:${name}" + return -1 + } + } else { + msgprint -w "Obsolete type $type. File $name not restaured." + return -1 + } +} +# +# Retourne la liste des fichiers candidats a aller dans une archive de source. Si cette liste +# est {} tout le monde y va exemple: return [list source object stadmfile] +# +proc upack:Upackable { } { + return [list source] +} +# +# Permet de filtrer le retour de uinfo +# +proc upack:UOK { x } { + return [expr { [file exists $x] && ![file isdirectory $x] }] +} +# +# Depliage d'une archive de sources +# +# FileId (entree) descripteur de l'archive de source +# errlog : descripteur du fichier ou l'on ecrit ce que l'on n'a pas pu faire +# (restaurer des types inconnus ou dont le profil ne correspond pas) +# errdir : Nom du directory ou l'on restaurera tout ce qui n'a pu l'etre dans l'UD. +# typsel : Liste des types a restaurer si {} on (tente) de tout restaurer +# +proc upack:UnFold { fileid errlog errdir {typsel {}} verbose } { + set lu {} + set lst [llength $typsel] + while {[gets $fileid line] >= 0 } { + if { [regexp {^=\+=\+=\+=\+=\+=\+=\+=\+=\+=\+ ([^ ]*) ([^ ]*)} $line ignore type name] } { + if [info exist fileout] {catch {close $fileout; unset fileout } } + if { ($lst == 0) || ( ($lst != 0) && ([lsearch $typsel $type] != -1)) } { + set retval [upack:GetBackupName $type $name] + if { $retval != -1 } { + set filename $retval + } else { + puts $errlog "Error: Item $line not processed" + set filename $errdir/notdone + } + if {[string compare [file extension $retval] .U] == 0 } { + lappend lu $retval + } + if ![catch { set fileout [open $filename w] } errout] { + if { $verbose } { msgprint -i "Creating $filename" } + } else { + msgprint -e "$errout" + return -1 + } + } else { + } + } else { + if [info exist fileout] { + puts $fileout $line + } + } + } + if [info exist fileout] {catch {close $fileout; unset fileout } } + foreach u $lu { + puts -nonewline stderr "Decoding $u ..." + wokUtils:FILES:uudecode $u + unlink $u + puts stderr "Done" + } + return +} +# +# Pliage d'un liste de fichiers dans fileid (deja ouvert et checke) +# TypesAndFullPathesList : retour de uinfo -Fp +# Si typsel = {} tout le monde y va +# +proc upack:Fold { List3 fileid {typsel {}} verbose } { + set lst [llength $typsel] + set dirtmp [wokUtils:FILES:tmpname {}] + foreach e $List3 { + set type [lindex $e 0] + if {[lsearch $typsel $type] != -1 || $lst == 0} { + set tnam [lindex $e 2] + set name $tnam + set code [wokUtils:FILES:Encodable $tnam] + if { $code != -1 } { + set name $dirtmp/[file tail $tnam].U + wokUtils:FILES:uuencode $tnam $name + } + if { [catch { set in [ open $name r ] } errin] == 0 } { + if { $verbose } { msgprint -i "Processing file $name"} + puts $fileid [format "=+=+=+=+=+=+=+=+=+=+ %s %s" $type [file tail $name]] + puts -nonewline $fileid [read $in] + close $in + } else { + puts stderr "Error: $errin" + } + if { $code != -1 } { + unlink $name + } + } + } + return +} +# +# Listing d'une archive de sources +# +# FileId (entree) descripteur de l'archive de source +# +proc upack:LsFold { fileid {typsel {}} } { + set lst [llength $typsel] + while {[gets $fileid line] >= 0 } { + if { [regexp {^=\+=\+=\+=\+=\+=\+=\+=\+=\+=\+ ([^ ]*) ([^ ]*)} $line ignore type name] } { + if { ($lst == 0) || ( ($lst != 0) && ([lsearch $typsel $type] != -1)) } { + msgprint -i "$type $name" + } + } + } + return +} + +# +# Packer un workbench +# +proc wpack_usage { } { + puts stderr \ + { + Usage: + + To create an archive file from a workbench: + + wpack -c [workbench] [-d Dirname | -f filename ] [-t ,.. ] [-u Ud1,Ud2,..] + + Backup contents of in , or . + + If you specify -d Dirname, one archive file will be created for each unit in in directory + Dirname. They will be named Unit.type.Z. They can be further downloaded separatly using upack in + a existing workbench, or globally using -r option of wpack. + + If you specify -f filename, all units will be archived in one file named filename.Z. This should be + more convenient for mailing. + + Options -t and -u selects respectively the type and the name of the units to process. + Wildcard as * can be used for specifying type and unit names. + + To restore an archive file: + + wpack -r [workbench] [-d Dirname | -f filename ] [-t ,.. ] [-u Ud1,Ud2,..] + + Restores contents of or in . Options -t and -u selects + respectively the type and the name of the units to restore. If applicable, units will be + automatically created and filled in with files. No test is done to check if the restored + files are already existing. It is recommended to create and empty workbench and restore + archives in that workbench. Further comparison with existing files, and housekeeping should + be carried out using the command wprepare. + + To create an archive file from a report created by the command wprepare: + + wpack -rep -f filename + + This option should be used in conjonction with the command wprepare -since to package deltas sources. + See examples (wpack -examples) + + Other options: + + -> If applicable, source files in a parcel can be downloaded using: + + wpack -r [workbench] -p ParcelName [-t ,.. ] [-u Ud1,Ud2,..] + + -> To list the contents of a archive file: + + wpack -l + + -> To turn on verbose mode use -v option + + -> To get some examples: + + wpack -examples + + } + return +} + +proc wpack:examples { } { + puts stderr \ + { + Examples: + + To pack the full workbench MDL:k4dev:ref in file /tmp/update.bck: + > wpack -c MDL:k4dev:ref -f /tmp/send.bck + + To pack all interface and engine of current workbench in directory /tmp/transfert: + > wpack -c -d /tmp/transfert -t interface,engine + + To restore the file /tmp/update.bck.Z in workbench FAC:WS:WB + > wcreate FAC:WS:WB ... ( if applicable ) + > wpack -r FAC:WS:WB -f /tmp/update.bck.Z + + To download in the current workbench, the units of delivery KERNEL-B4-1: + > wpack -r -p MYFACT:MYBAG:KERNEL-B4-1 + + To pack all sources and units modified since the mark REL1.1 (See wnews for marks) + > wprepare -since REL1.1 -o /tmp/update-report + > ... Comments report file /tmp/update-report ... (See also wnews -comments) + > wpack -rep /tmp/update-report -f /tmp/update.bck + > ... Send update.bck with mail or Internet facilities.. + + To restore the previous update file in a workbench named WBUPD. + > wcreate WBUPD -f ... + > wokcd FACT:SHOP:WBUPD + > wpack -r -f /tmp/update.bck + All units will be created and automatically filled in with the source files. + + To restore the previous update in a integration queue ( See also command wstore) + > wstore -ar /tmp/update.bck + + To pack a workbench FAC1:SHOP1:WB1, then restore it in an other workshop queue + named FAC2:SHOP2. + > wokcd FAC1:SHOP1 + > wpack -c WB1 -f /tmp/arch.bck + > wokcd FAC2:SHOP2 + > wstore -ar /tmp/arch.bck + + + } +} +proc wpack { args } { + + ;# Options + ;# + set tblreq(-h) {} + set tblreq(-examples) {} + set tblreq(-c) default + set tblreq(-r) {} + set tblreq(-v) {} + set tblreq(-d) value_required:string + set tblreq(-f) value_required:string + set tblreq(-p) value_required:string + set tblreq(-t) value_required:list + set tblreq(-u) value_required:list + set tblreq(-l) {} + + set tblreq(-rep) value_required:string + + set disallow(-d) {-f} + set disallow(-d) {-p} + set disallow(-c) {-r} + ;# Parameters + ;# + set param {} + + if { [wokUtils:EASY:GETOPT param table tblreq wpack_usage $args] == -1 } return + if { [wokUtils:EASY:DISOPT table disallow wpack_usage ] == -1 } return + + if { [info exists table(-h)] } { + wpack_usage + return + } + if { [info exists table(-examples)] } { + wpack:examples + return + } + + set verbose [info exists table(-v)] + + if { [info exists table(-rep)] } { + if { [info exists table(-f)] } { + set Zadr $table(-f) + if ![catch {set idar [open $Zadr w]} status] { + wokStore:Report:Pack $idar $table(-rep) $verbose + close $idar + wokUtils:FILES:compress $Zadr + msgprint -i "File ${Zadr}.Z has been created." + } else { + puts stderr "$status" + } + } else { + wpack_usage + } + return + } + + + if { [info exists table(-l)] } { + set Zadr [lindex $param 0] + set adr [wokUtils:FILES:SansZ $Zadr] + if { $adr != -1} { + if ![catch {set idar [open $adr r]} status] { + wpack:LsFold $idar {} + close $idar + } else { + puts stderr "Error: $status" + } + if [file exists $adr] { + catch {unlink $adr} + } + } + return + } + + + set typsel * + if { [info exists table(-t)] } { + set typsel $table(-t) + } + + set namsel * + if { [info exists table(-u)] } { + set namsel $table(-u) + } + + set Wadr [lindex $param 0] + if { $Wadr == {} } { + set Wadr [wokcd] + } + set Wadr [wokinfo -w $Wadr] + + if { [info exists table(-c)] } { + set ulist [wpack:UF [w_info -a $Wadr] $namsel $typsel] + if { $ulist == {} } { + msgprint -w "No units selected." + return + } + if { [info exists table(-f)] } { + set Zadr $table(-f) + if ![catch {set idar [open $Zadr w]} status] { + foreach Uadr $ulist { + set typ [lindex $Uadr 0] + set nam [lindex $Uadr 1] + if { $verbose } { puts -nonewline stderr "Packing $typ $nam..." } + puts $idar [format "=!=!=!=!=!=!=!=!=!=! %s %s" $typ $nam] + upack:Fold [uinfo -Fp ${Wadr}:${nam}] $idar [upack:Upackable] 0 + if { $verbose } { puts stderr "Done" } + } + close $idar + wokUtils:FILES:compress $Zadr + msgprint -i "File ${Zadr}.Z has been created" + } else { + puts stderr "$status" + } + } elseif { [info exists table(-d)] } { + if { ![file exists $table(-d)] } { mkdir -path $table(-d) } + wpack:Fold $Wadr $ulist $table(-d) [info exists table(-v)] + msgprint -i "Archive files have been created in $table(-d)" + } else { + wpack_usage + } + return + } + + if { [info exists table(-r)] } { + if { [info exists table(-f)] } { + set Zadr $table(-f) + set adr [wokUtils:FILES:SansZ $Zadr] + if { $adr != -1} { + if ![catch {set idar [open $adr r]} status] { + set dirtmp [wokUtils:FILES:tmpname {}] + set savwd [wokcd] + wpack:UnFold $idar $Wadr stderr $dirtmp {} $verbose + close $idar + wokcd $savwd + } else { + puts stderr "Error: $status" + } + if [file exists $adr] { + catch {unlink $adr} + } + } + } else { + if { [info exists table(-d)] } { + set Dadr $table(-d) + } else { + set Dadr [pwd] + } + if { [info exists table(-p)] } { + set ULadr $table(-p) + set Dadr [wokinfo -p sourcedir:. $table(-p)] + } + if { ![file exists $Dadr] } { + msgprint -e "Directory $Dadr not found." + return + } + if { [set LZ [wpack:LZ [glob $Dadr/*.*.Z] $namsel $typsel]] != {} } { + set savwokcd [wokcd] + foreach e2 [ucreate -P $Wadr] { + set LtoS([lindex $e2 1]) [lindex $e2 0] + } + set l_ud [w_info -l $Wadr] + foreach z $LZ { + set x [split [file tail $z] .] + set nam [lindex $x 0] + set typ [lindex $x 1] + if { [lsearch $l_ud $nam] == -1 } { + ucreate -$LtoS($typ) ${Wadr}:${nam} + } + if { $verbose } { msgprint -i "Unpacking file $z" } + wokcd ${Wadr}:${nam} + upack -r $z + } + wokcd $savwokcd + } else { + msgprint -e "No match in directory $Dadr." + } + } + return + } + + wpack_usage + +} +;# +;# Filtre les UDs demandees avec -u et -t +;# l2 liste des UDs a filtrer. (w_info) +;# lu liste de ce qu'il y a derriere -u +;# lt liste de ce qu'il y a derriere -t +;# +proc wpack:UF { l2 lu lt } { + set l {} + foreach u $lu { + foreach t $lt { + foreach e2 $l2 { + set typ [lindex $e2 0] + set nam [lindex $e2 1] + if { [string match $u $nam] && [string match $t $typ] } { + lappend l $e2 + } + } + } + } + return $l +} +;# +;# Filtre les UDs demandees avec -u et -i +;# l1 liste des UDs a filtrer. (glob) +;# lu liste de ce qu'il y a derriere -u +;# lt liste de ce qu'il y a derriere -t +;# +proc wpack:LZ { l1 lu lt } { + set l {} + foreach u $lu { + foreach t $lt { + foreach e1 $l1 { + if { [string match ${u}.${t}.Z [file tail $e1] ] } { + lappend l $e1 + } + } + } + } + return $l +} +;# +;# Crees les archives a partir de ulist et les met dans Dadr. +;# +proc wpack:Fold { Wadr ulist Dadr {verbose 0 } } { + foreach e2 [lsort $ulist] { + set typ [lindex $e2 0] + set nam [lindex $e2 1] + if { $verbose } { msgprint -i "Creating file $Dadr/$nam.${typ}.Z" } + upack -f -c ${Wadr}:${nam} -o $Dadr/$nam.${typ} + } + + return +} +# +# Listing d'un backup de workbench +# +# FileId (entree) descripteur de l'archive +# +proc wpack:LsFold { fileid {typsel {}} } { + set lst [llength $typsel] + while {[gets $fileid line] >= 0 } { + if { [regexp {^=\+=\+=\+=\+=\+=\+=\+=\+=\+=\+ ([^ ]*) ([^ ]*)} $line ignore type name] } { + if { ($lst == 0) || ( ($lst != 0) && ([lsearch $typsel $type] != -1)) } { + msgprint -i "$type $name" + } + } elseif {[regexp {^=!=!=!=!=!=!=!=!=!=! ([^ ]*) ([^ ]*)} $line ignore type name]} { + msgprint -i ">> $type $name" + } + } + return +} +;# +;# Cree dans le workbench Wadr les Uds packes dans le fichier pointe par fileid +;# +proc wpack:UnFold { fileid Wadr errlog errdir {typsel {}} verbose } { + set lu {} + set lst [llength $typsel] + foreach e2 [ucreate -P $Wadr] { + set LtoS([lindex $e2 1]) [lindex $e2 0] + } + set l_ud [w_info -l $Wadr] + while {[gets $fileid line] >= 0 } { + if { [regexp {^=\+=\+=\+=\+=\+=\+=\+=\+=\+=\+ ([^ ]*) ([^ ]*)} $line ignore type name] } { + if [info exist fileout] {catch {close $fileout; unset fileout } } + if ![string match report-* $type] { + if { ($lst == 0) || ( ($lst != 0) && ([lsearch $typsel $type] != -1)) } { + set retval [upack:GetBackupName $type $name] + if { $retval != -1 } { + set filename $retval + } else { + puts $errlog "Error: Item $line not processed" + set filename $errdir/notdone + } + if {[string compare [file extension $retval] .U] == 0 } { + lappend lu $retval + } + if ![catch { set fileout [open $filename w] } errout] { + if { $verbose } { msgprint -i "Creating $filename" } + } else { + msgprint -e "$errout" + return -1 + } + } + } else { + if ![catch { set fileout [open [pwd]/$name w] } errout] { + msgprint -i "Creating [pwd]/$name" + } else { + msgprint -e "$errout" + return -1 + } + } + } elseif {[regexp {^=!=!=!=!=!=!=!=!=!=! ([^ ]*) ([^ ]*)} $line ignore typ nam]} { + if ![string match report-* $typ] { + if { [lsearch $l_ud $nam] == -1 } { + ucreate -$LtoS($typ) ${Wadr}:${nam} + if { $verbose } { msgprint -i "Creating $typ $nam " } + } + wokcd $nam + } + } else { + if [info exist fileout] { + puts $fileout $line + } + } + + } + if [info exist fileout] {catch {close $fileout; unset fileout } } + foreach u $lu { + puts -nonewline stderr "Decoding $u ..." + wokUtils:FILES:uudecode $u + unlink $u + puts stderr "Done" + } + return +} diff --git a/src/WOKTclLib/warehouse.xpm b/src/WOKTclLib/warehouse.xpm new file mode 100755 index 0000000..ea60708 --- /dev/null +++ b/src/WOKTclLib/warehouse.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * warehouse_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"19 19 7 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #CCCCBFBFAAAA", +"o c #66668080AAAA", +"O c #9999BFBFFFFF", +"+ c #999980805555", +"@ s iconColor2 m white c white", +/* pixels */ +" ", +" ", +" ", +" .XXXXXXXXXo. ", +" OXOXOXOXO.o ", +" ............o+ ", +" .@XO.OX.X.X.oo ", +" .@XXXXXXXXX.o+ ", +" .@XO.@..XOX.oo ", +" .@X.@+.@..X.o+ ", +" .@X@.oo...X.oo ", +" .@X.@+.@..X.o+ ", +" .@XO.@..X...oo ", +" .@XXX..XXXX.o+ ", +" .@XOXOXOXOX.oo ", +" .@XX.XX.X.X.. ", +" .Oooooooooo. ", +" o +. ", +" . .. "}; diff --git a/src/WOKTclLib/wbuild.hlp b/src/WOKTclLib/wbuild.hlp new file mode 100755 index 0000000..cc774dc --- /dev/null +++ b/src/WOKTclLib/wbuild.hlp @@ -0,0 +1,54 @@ + + Workbench Builder + + Menus: + + + : changes the compilation and database profiles. + : loads a specific configuration for a given workbench. + : saves the current configuration. + : saves the text in the build window into a file. + : gives the configuration of the 'cron' table on the current station. + : ends the build process. + + + : this help. + : displays the version of the 'Workbench Builder'. + + Buttons: + + : builds the units contained in the right window. + : displays in the build window the commands performed. + : positions the build window on the previous error. + : positions the build window on the next error. + : sends compilation errors to an Emacs buffer. + : stops the building process at the end of the current command. + + : push the button to perform the umake commands with the '-f' parameter. + : adds all the units from the selection window [left window] to the + right window. + : deselects all the units with no error. + : deselects all the units. + + + + Input area : + + The input area is located below the selection window. It is used to filter units according to + their name. + Example: If you type the letter 'A' then space, only the selection units beginning with an 'A' + remain displayed in the window. + + + Selection window: + + Click on the unit types (src, xcpp, obj, lib, ccl, exec, frontal, delivery) in the list provided + to display the menu used to filter units according to their type. + + + Profile button: + + The profile button is located in the top right corner of the window with the current compilation + and database profiles. + Push the profile button to display the profile selection window. + diff --git a/src/WOKTclLib/wbuild.xpm b/src/WOKTclLib/wbuild.xpm new file mode 100755 index 0000000..7851264 --- /dev/null +++ b/src/WOKTclLib/wbuild.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * wbuild_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 5 1 0 0", +/* colors */ +" s iconGray4 m white c #949494949494", +". s iconColor1 m black c black", +"X c #BEBEBEBEBEBE", +"o s iconColor5 m black c blue", +"O c #A0A052522D2D", +/* pixels */ +" ", +" ", +" ", +" ... ... ....... ", +" .X. .XX...XXXXXXX. ", +" .X. .XXXXXXXoooXXX. ", +" .XXX. .XXXXXXoooXXXXX. ", +" .XXX. .XX...XXXXX..XXX. ", +" .X. ... ..... .XX. ", +" .X. .X. .X. ", +" .X. .X. .. ", +" .X. .X. ", +" .X. .X. ", +" .X. .X. ", +" .X. .X. ", +" .X. .X. ", +" ... ... ", +" .OOO. .OOO. ", +" .OOOOO. .OOOOO. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .O.O.O. .O.O.O. ", +" .OOOOO. .OOOOO. ", +" .OOO. .OOO. ", +" ... ... "}; diff --git a/src/WOKTclLib/wcheck.tcl b/src/WOKTclLib/wcheck.tcl new file mode 100755 index 0000000..0bdd760 --- /dev/null +++ b/src/WOKTclLib/wcheck.tcl @@ -0,0 +1,119 @@ + +############################################################################# +# +# W C H E C K +# ___________ +# +############################################################################# +# +# Usage +# +proc wokCheckUsage { } { + puts stderr {Usage : wcheck [-t SCCS|RCS] [-report [filename] [file1 file2 ...]} + puts stderr "" + puts stderr { wcheck filename : Check that file1 file2 ..can be placed in repository.} + puts stderr { -report to enter a report file created by wprepare} + return +} + +proc wcheck { args } { + set tblreq(-h) {} + set tblreq(-s) {} + set tblreq(-report) value_required:string + set tblreq(-diff) {} + set tblreq(-dir) value_required:string + + set param {} + if { [wokUtils:EASY:GETOPT param tabarg tblreq wokCheckUsage $args] == -1 } return + + if { [info exists tabarg(-h)] } { + wokCheckUsage + return + } + + if [info exists tabarg(-diff)] { + if [info exists tabarg(-dir)] { + set dir(-dir) + wcheck_diff $param $dir + } else { + wokCheckUsage + } + return + } + + set BTYPE SCCS + if [info exists tabarg(-t)] { + set BTYPE $tabarg(-t) + } + + set silent [info exists tabarg(-s)] + + set tmpdir /tmp/wcheck[id process] + if [file exists $tmpdir] { + unlink [glob -nocomplain $tmpdir/*] + } else { + mkdir -path $tmpdir + } + + set LFILE {} + if { [info exists tabarg(-report)] } { + set ID $tabarg(-report) + catch { unset table banner notes } + wokPrepare:Report:Read $ID table banner notes + foreach e [lsort [array names table]] { + foreach l $table($e) { + set str [wokUtils:LIST:Trim $l] + lappend LFILE [lindex $str 4]/[lindex $str 3] + } + } + } else { + eval set LFILE $param + } + + switch -- $BTYPE { + + SCCS { + set vrs 1 + foreach file $LFILE { + update + set sfile $tmpdir/s.[file tail $file] + if { [catch { exec admin -i$file -r$vrs -yCheck $sfile } status ] == 0 } { + if { !$silent } {msgprint -c WOKVC -i "$file is OK."} + } else { + if { "$status" == "No id keywords (cm7)" } { + if { !$silent } { msgprint -c WOKVC -i "$file is OK"} + } else { + msgprint -c WOKVC -e "$file cannot be created ( $status )" + } + } + catch {unlink $sfile} + } + } + + RCS { + msgprint -c WOKVC -e "Not yet implemented" + } + + default { + msgprint -c WOKVC -e "Unknown base type. Should be SCCS or RCS" + } + + } + + catch { + if [file exists $tmpdir] { + unlink [glob -nocomplain $tmpdir/*] + } + unlink $tmpdir + } + + return +} + +proc wcheck_diff { param dir } { + ;#puts $param + ;#puts $dir + return +} + + diff --git a/src/WOKTclLib/wnews_trigger.example b/src/WOKTclLib/wnews_trigger.example new file mode 100755 index 0000000..15723c9 --- /dev/null +++ b/src/WOKTclLib/wnews_trigger.example @@ -0,0 +1,56 @@ +;# This procedure is called when using the command: +;# +;# wnews -x -from n1 -to n2 -proc MyProc where n1 and n2 are two digits +;# +;# Entries in MYTABLE are unit and type names on the form Unit.type. +;# +;# Each item in MYTABLE is a list with the the following format: +;# +;# Example: +;# MYTABLE(WOKMake.p) = {Modified { WOKUMake.edl 1.2}} {Modified { WOKUMakeStep.edl 1.2}} +;# + +proc MyProc { comments table args } { + upvar $table MYTABLE + set from_wb DESIGN:k1dev:ref + set dest_wb DESIGN:k1fab:ref + set l_fab [w_info -l $dest_wb] + set l_ud {} + foreach UD [lsort [array names MYTABLE]] { + set x [split $UD .] + set name [lindex $x 0] + set type [lindex $x 1] + lappend l_ud $name + if { [lsearch $l_fab $name] == -1 } { + puts "ucreate -${type} ${dest_wb}:${name}" + } + set from_src [wokinfo -p source:. ${from_wb}:${name}] + set dest_src [wokinfo -p source:. ${dest_wb}:${name}] + set l_file {} + foreach item $MYTABLE($UD) { + set mark [lindex $item 0] ;# == Modified | Added | Deleted + switch -- $mark { + + Modified { + set elem [lindex $item 1] ;# == {name.ext x.y} + set file [lindex $elem 0] ;# + set vers [lindex $item 1] ;# + if { [lsearch $l_file $file] == -1 } { + puts "Copying $file from $from_src to $dest_src" + ;# exec cp $from_src/$file $dest_src/$file + lappend l_file $file + } + } + + Added { + } + + Deleted { + } + } + } + } + puts " je dois recopsdsdsd $l_ud" + puts "comments = $comments" + return 1 +} diff --git a/src/WOKTclLib/wok-comm.el b/src/WOKTclLib/wok-comm.el new file mode 100755 index 0000000..345816c --- /dev/null +++ b/src/WOKTclLib/wok-comm.el @@ -0,0 +1,495 @@ +;;; Communication and interface routines for the WOK and Emacs comm + +(require 'cl) +(provide 'wok-comm) + +;;; Variables + +(defconst wok-comm-AtFS-Header + "$Header: /disk4/QA/cvsroot/test/ros/src/WOKTclLib/wok-comm.el,v 1.1 1998-09-09 18:21:42 kernel Exp $") + +(defvar wok-comm-initialized nil + "If non-nil, the Wok communication module has already been initialized.") + +(defvar wok-log-communication t + "If non-nil, the communication between Emacs and the Wok widget is +logged in wok-log-buffer.") + +(defvar wok-log-buffer-name " *wok-log*" + "Name of the buffer where Wok communication is logged. +Begins with a blank to be invisible.") + +(defvar wok-log-buffer nil + "Buffer where Wok communication is logged. +If it gets killed, it will be re-created on demand.") + +(defvar wok-controller-input-buffer-name " *wok-input*" + "Name of buffer containing incoming characters, not yet processed.") + +(defvar wok-controller-input-queue "" + "Incoming lines that have not yet been processed.") + +(defvar wok-controller-return-buffer-name " *wok-return*" + "Name of buffer containing returned characters, not yet processed.") + +(defvar wok-controller-return-queue "" + "return value lines that have not yet been processed.") + +(defvar wok-controller-process nil + "Process variable of wok-controller process +(really a network connection).") + +(defvar wok-controller-host nil + "Hostname of remote wok-controller.") + +(defvar wok-controller-port nil + "Port number of remote wok-controller.") + +(defvar wok-controller-connectedp nil + "t if connected otherwise nil.") + +(defvar wok-write-back-eval t + "If non-nil, write results of evaluations back to the wok-controller.") + +(defvar wok-widget-name "dummy-widget" + "Name of the widget we talk to in the remote wok-controller.") + +(defvar wok-kill-widget-on-exit nil + "If non-nil, Emacs kills the widget on exit.") + +(defvar wok-default-port "1563" + "Default port number for connecting to the controller, +if not given in the command line. Mostly for testing purposes. +Must be a string because it is used as initial input for read-string.") + +(defvar wok-signal-errors t + "If non-nil, signal errors in the process-filter to the user. +If nil, rely on the widget to process the error.") + + +;;; Functions for handling wok-controller-input-buffer + +(defun wok-erase-input-buffer () + "Erase wok-controller-input-buffer, i.e. flush all input." + (save-excursion + (set-buffer (get-buffer-create wok-controller-input-buffer-name)) + (erase-buffer))) + + +(defun wok-queue-controller-input (string) + "Add input STRING to wok-controller-input-buffer." + (save-excursion + (set-buffer (get-buffer-create wok-controller-input-buffer-name)) + (goto-char (point-max)) + (insert string))) + + +(defun wok-complete-input-line-p () + "Return non-nil if a complete line is available in +wok-controller-input-buffer." + (save-excursion + (set-buffer (get-buffer-create wok-controller-input-buffer-name)) + ;; DEBUG POUR DEC/JGAJGA + ;;(goto-char 1) ; don' bother with point-min here + ;;(and (> (length (buffer-string)) 0) ( equal "\^J" (buffer-substring 1 2)) + ;; (delete-char 1) + ;; ) + (wok-log-to-buffer "buffer" (buffer-string)) + (goto-char 1) ; don' bother with point-min here + (forward-line 1) + (and (bolp) + (not (bobp))))) + + +(defun wok-get-input-line () + "Return the first line from wok-controller-input-buffer and erase it there." + (save-excursion + (set-buffer (get-buffer-create wok-controller-input-buffer-name)) + (goto-char 1) + (let ((end (progn (forward-line 1) + (point)))) + (prog1 + (buffer-substring 1 end) + (delete-region 1 end))))) + +;;; Functions for handling wok-controller-return-buffer + +(defun wok-erase-return-buffer () + "Erase wok-controller-input-buffer, i.e. flush all input." + (save-excursion + (set-buffer (get-buffer-create wok-controller-return-buffer-name)) + (erase-buffer))) + + +(defun wok-queue-controller-return (string) + "Add input STRING to wok-controller-input-buffer." + (save-excursion + (set-buffer (get-buffer-create wok-controller-return-buffer-name)) + (goto-char (point-max)) + (insert string))) + + +(defun wok-complete-return-line-p () + "Return non-nil if a complete line is available in +wok-controller-return-buffer." + (save-excursion + (set-buffer (get-buffer-create wok-controller-return-buffer-name)) + (goto-char 1) ; don' bother with point-min here + (forward-line 1) + (and (bolp) + (not (bobp))))) + + +(defun wok-get-return-line () + "Return the first line from wok-controller-input-buffer and erase it there." + (save-excursion + (set-buffer (get-buffer-create wok-controller-return-buffer-name)) + (goto-char 1) + (let ((end (progn (forward-line 1) + (point)))) + (prog1 + (buffer-substring 1 end) + (delete-region 1 end))))) + + +;;; Functions etc. to set up, continue, and shut down communication +;;; to the WokEmacs widget + +(defun wok-get-command-line-args (switch) + "Consume commandline arguments after \"-wokwidget\" and connect +to remote wok-controller. Arguments are: + - wok-widget-name + - wok-controller-host + - wok-controller-port" + (if (equal switch "-wokwidget") + (progn + (setq wok-widget-name + (car command-line-args-left)) + (setq wok-controller-host + (cadr command-line-args-left)) + (setq wok-controller-port + (string-to-int (caddr command-line-args-left))) + (setq command-line-args-left + (cdddr command-line-args-left)) + (wok-connect-to-controller wok-controller-host wok-controller-port)))) + + +(defun wok-connect-to-controller (host port) + "Establish a connection to a remote wok-controller on HOST port PORT. +This function is a command only for testing purposes." + (interactive (list (read-string "To host: " "localhost") + (string-to-int (read-string "Port: " + wok-default-port)))) + (if wok-controller-process + ;; there must not be two controllers + (error "Wok-Controller already running on host %s port %s" + wok-controller-host wok-controller-port) + ;; set up process and associated variables + (progn + (message "trying connection to host %s port %s" + wok-controller-host wok-controller-port) + (let ((retries 0)) + (while (and (not wok-controller-process) (not (equal retries 8))) + (condition-case error (progn + (setq wok-controller-process + (open-network-stream "wok-controller-process" nil host port)) + t) + (error + (progn + (message "Retry %d failed" retries) + (sleep-for 1) + (setq retries (+ retries 1)) + (let ((mesg (car (cdr error)))) + (cond + ((string-match "^Unknown host" mesg) nil) + ((string-match "not responding$" mesg) mesg) + ((equal mesg "connection failed") + (if (equal (nth 2 error) "permission denied") + nil ; host does not exist + (nth 2 error))) + ;; Could be "Unknown service": + (setq retries (+ retries 1)) + (t (signal (car error) (cdr error)))))))))) + + (message "Connection established.") + + (if wok-controller-process + (progn + (setq wok-controller-host host) + (setq wok-controller-port port) + (wok-erase-input-buffer) + (wok-erase-return-buffer) + (set-process-filter wok-controller-process 'wok-controller-filter) + (set-process-sentinel wok-controller-process 'wok-shutdown-controller) + ;; first handshake + (wok-send-return-value "Hello widget, pleased to meet you!") + + (run-hooks 'wok-connect-hooks) + + (setq wok-controler-connectedp t) + wok-controller-process))))) + +(defun wok-shutdown-controller (&optional proc message) + "Sentinel for the connection to a remote wok-controller. +This is a command only for testing purposes. +Since the only status change is connection loss, the only action to +be done is cleaning up. +Optional arguments: PROC MESSAGE. +If PROC is nil, no message is given." + (interactive "p") + (if proc + (message "Wok-Controller on %s port %d shutdown." + wok-controller-host wok-controller-port)) + (condition-case dummy + ;; this closes the network connection. Errors must be ignored, + ;; because the connection will already be closed if this + ;; function is called as the process sentinel. + (delete-process wok-controller-process) + (error nil)) + ;; reset associated variables + (setq wok-controller-process nil) + (setq wok-controller-port nil) + (setq wok-controller-host nil) + (setq wok-controler-connectedp nil) + (if proc + ;; proc is non-nil if this function has been called as the + ;; sentinel or if the user wants it. + (ding))) + + +(defun wok-controller-filter (proc string) + "Filter for the connection to a remote wok-controller. +It relies on the messages coming in line by line, +perhaps this is a bug, we'll see." + + ;; log to buffer if requested + (wok-log-to-buffer "recv" string) + ;; collect a complete line first + (wok-queue-controller-input string) + ;; line complete? + (wok-log-to-buffer "input-line-p" (wok-complete-input-line-p)) + + (while (wok-complete-input-line-p) + (condition-case error-message + (let ((line (wok-get-input-line))) + (wok-log-to-buffer "line" line) + (if (< (length line) 5) ; including newline character + ;; line is too short + (progn (wok-erase-input-buffer) + (wok-raise-error "line too short")) + ;; The message type tokens are four characters long + (let ((token (substring line 0 4))) + ;; switch according to the type of token. + (cond ((equal token "RST:") + ;; reset communication. All input is flushed. + (setq wok-controller-input-queue "") + (wok-erase-input-buffer)) + + ((equal token "CMD:") + ;; command lines are collected in + ;; wok-controller-input-queue + (setq wok-controller-input-queue + (concat wok-controller-input-queue + (substring line 5)))) + + ((equal token "END:") + (cond ((> (length wok-controller-input-queue) 0) + ;; end of command. Now the command in + ;; wok-controller-input-queue can be executed + (let ((exp (read wok-controller-input-queue)) value) + ;; it is important to clear the input queue + ;; immmediately since the filter can be + ;; invoked in parallel + (setq wok-controller-input-queue "") + (setq value (eval exp)) + ;; write result back only if requested + (if wok-write-back-eval + (wok-send-return-value value)) + )) + ((> (length wok-controller-return-queue) 0) + (progn + (setq wok-return-value wok-controller-return-queue) + (setq wok-controller-return-queue "") + (setq wok-return-value-p 1) + )) + ;; (t + ;; (wok-raise-error "Mixed RET: and CMD: tokens")) + )) + + ((equal token "RET:") + ;; should not appear (yet). Will perhaps later be + ;; needed. + (setq wok-controller-return-queue + (concat wok-controller-return-queue + (substring line 5)))) + + ((equal token "ERR:") + ;; is error message from Wok widget + (progn + (setq wok-return-value "ERR:ERR") + (setq wok-error-msg (substring line 5 )) + (ding) + (message "Wok error: %s" + (substring line 5 )) + (setq wok-return-value-p 1) + ) + ) + + (t + ;; an unrecognized token occurred + (wok-raise-error (format "protocol error, token \"%s\"" + (substring string 0 4))) + (setq wok-controller-input-queue ""))) + ;; reset input line, this one has been processed. + (setq line "")))) + (quit + (progn (setq wok-controller-input-queue "") + (wok-erase-input-buffer) + (ding) + (message "Quit") + (wok-raise-error error-message))) + (error + ;; any error is given to controller + (progn (setq wok-controller-input-queue "") + (wok-raise-error error-message) + (if wok-signal-errors + (signal (car error-message) (cdr error-message)))))))) + + +;;; Functions to synchronize termination and redisplay + +(defun wok-kill-emacs () + "Function for Wok to shut down the WokEmacs widget. +For some unknown reason this must include the action which is already +placed in kill-emacs-hook." + (if wok-controller-process + (wok-shutdown-controller)) + ;; this must not happen twice, so reset kill-emacs-hook + (setq kill-emacs-hook nil) + (kill-emacs)) + + +(defun wok-advise-destroy-widget-on-exit () + "Advise Emacs to destroy the widget on exit. Does not yet work. +This is necessary for XfEmacs." + (setq wok-kill-widget-on-exit t)) + + +(defun wok-kill-emacs-hook () + "To be put into kill-emacs-hook in order to guarantee proper +shutdown of the WokEmacs widget." + ;; notify widget of Emacs' death + (if wok-kill-widget-on-exit + (if wok-controller-process + (wok-send-command (format "%s stopemacs; catch {destroy .}; catch {exit 0}" wok-widget-name)))) + (wok-shutdown-controller)) + + + +;;; Functions to implement the protocol between Emacs and the widget + +(defun wok-send-command (string) + "Send STRING as Tcl command to remote wok-controller." + (interactive "sSend Tcl command: ") + (progn + (setq wok-error-msg nil) + (setq wok-return-value "") + (setq wok-return-value-p 0) + (wok-send-raw-string (wok-string-format 'cmd "%s" string)) + (while (not (= wok-return-value-p 1)) (sit-for .1)) + (if (equal wok-return-value "ERR:ERR") + nil + wok-return-value) + )) + + +(defun wok-send-return-value (object) + "Send OBJECT as a return value to the wok-controller. +OBJECT can be any Lisp object." + (wok-send-raw-string (wok-string-format 'ret "%s" object))) + + +(defun wok-raise-error (message) + "Send MESSAGE as an error message to the wok-controller." + (condition-case dummy + (wok-send-raw-string (wok-string-format 'err "%s" message)) + (error nil))) + + +(defun wok-send-raw-string (string) + "Send STRING to remote wok-controller. Do not use this +unless you really know what you are doing, since this function +lies below the protocol between Emacs and the wok-controller." + (if wok-controller-process + (progn (process-send-string wok-controller-process string) + (wok-log-to-buffer "send" string)))) + + +(defun wok-string-format (type &rest format-args) + "Format string suitable for transmission to the wok widget. +TYPE may be 'ret or 'cmd or 'err, remaining FORMAT-ARGS are +processed by format." + (let ((tmp-buffer (get-buffer-create " *wok-temp-send*")) + (header (cdr (or (assoc type '((ret . "RET: ") + (cmd . "CMD: ") + (rst . "RST: ") + (err . "ERR: "))) + (error "Wrong TYPE parameter %s" type))))) + (save-excursion + ;; insert formatted string into a buffer + (set-buffer tmp-buffer) + (erase-buffer) + (insert (apply 'format format-args)) + (goto-char 0) + ;; insert appropriate header at line beginnings + (while (not (eobp)) + (insert header) + (forward-line 1)) + ;; if the last char was a newline, another header is needed + (if (bolp) + (insert header)) + (insert (if (eq type 'err) + "\n" + "\nEND:\n")) + ;; return string + (buffer-string)))) + + +(defun wok-log-to-buffer (where string) + "Log communication to buffer, if wok-log-communication is non-nil. +WHERE is \"recv\" or \"send\", STRING is the message. +See also wok-log-buffer and wok-log-buffer-name." + (if wok-log-communication + (save-excursion + (set-buffer (get-buffer-create wok-log-buffer-name)) + (goto-char (point-max)) + (insert (format "##%s: %s##\n" where string))))) + + +;;; init + +(defun wok-connectedp () + (if wok-controller-process + t + nil) + ) + + +(defun wok-initialize-communication () + "Initialize certain variables and functions for the communication +with the WokEmacs widget." + (if (not wok-comm-initialized) + (progn + ;; the "-wokwidget" switch must be parsed by wok-get-command-line-args + (setq command-switch-alist + (cons '("-wokwidget" . wok-get-command-line-args) + command-switch-alist)) + (setq wok-comm-initialized t) + (run-hooks 'wok-initialization-hooks)))) + + +;;; end of file + + + +(wok-initialize-communication) diff --git a/src/WOKTclLib/wokDeletions.tcl b/src/WOKTclLib/wokDeletions.tcl new file mode 100755 index 0000000..32b8bfb --- /dev/null +++ b/src/WOKTclLib/wokDeletions.tcl @@ -0,0 +1,110 @@ +proc wokDelete { dir location } { + global IWOK_GLOBALS + set w [string tolower .wokDelete:${location}] + if [winfo exists $w ] { + wm deiconify $w + raise $w + return + } + + toplevel $w ; wm geometry $w 517x411+453+44 + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m + $w.file.m add command -label "Close " -underline 1 -command [list wokDelete:Cancel $w] + + ;# -- label -- + frame $w.top -relief raised -bd 1 + label $w.top.lab + set img [image create compound -window $w.top.lab] + $img add space -width 10 + $img add image -image [tix getimage danger] + $img add space -width 10 + $img add text -text "Really do that ??" + pack $w.top.lab -expand 1 -fill both + ;# -- end label -- + + ;# -- paned listbox et text -- + frame $w.mid -relief raised -bd 1 + tixPanedWindow $w.mid.pane -orient vertical -paneborderwidth 0 -separatorbg gray50 + pack $w.mid.pane -side top -expand yes -fill both -padx 1 -pady 1 + set p1 [$w.mid.pane add list -min 70 -size 200] + set p2 [$w.mid.pane add text -min 70] + tixScrolledHList $p1.list ; set hlist [$p1.list subwidget hlist] + tixScrolledText $p2.text ; + set text [$p2.text subwidget text] + $text config -font $IWOK_GLOBALS(font) + pack $p1.list -expand yes -fill both -padx 1 -pady 1 + pack $p2.text -expand yes -fill both -padx 1 -pady 1 + ;# -- paned listbox et text -- + + ;# -- bouton confirm -- + frame $w.bot -relief raised -bd 1 + tixButtonBox $w.bot.but -orientation horizontal -relief flat -padx 0 -pady 0 + pack $w.bot.but -expand yes -fill both -padx 1 -pady 1 + $w.bot.but add confirm -text "Confirm" + + $w.bot.but subwidget confirm config -state active -comm \ + [list wokDelete:Confirm $hlist $text $w $w.bot.but] + $w.bot.but add cancel -text "Cancel" ; + $w.bot.but subwidget cancel config -state active -comm [list wokDelete:Cancel $w] + ;# -- end bouton confirm -- + + tixForm $w.file + tixForm $w.top -top $w.file -left 2 -right %99 + tixForm $w.mid -top $w.top -left 2 -right %99 -bottom $w.bot + tixForm $w.bot -left 2 -right %99 -bottom %99 + + tixBusy $w on + update + if [wokinfo -x $location] { + set lrm {} + foreach x [wokFind $location] { + set type [wokinfo -t $x] + if {"$type" == "factory"} {set cmd "frm $x"} + if {"$type" == "workshop"} {set cmd "srm $x"} + if {"$type" == "workbench"} {set cmd "wrm $x"} + if {"$type" == "devunit"} {set cmd "urm $x"} + $hlist add $cmd -text $cmd -data [list $cmd $type] -state disabled + } + } + $w.top.lab config -image $img + tixBusy $w off + return +} + +proc wokDelete:Confirm { hlist text tpl but } { + tixBusy $tpl on + update + $but subwidget cancel configure -state disabled + msgsetcmd wokMessageInText $text + set listdel {} + foreach itm [$hlist info children] { + set data [$hlist info data $itm] + set cmd [lindex $data 0] + set typ [lindex $data 1] + if ![ catch { eval $cmd } helas ] { + $hlist delete entry $cmd + lappend listdel $data + } else { + msgprint -e "$helas" + break + } + } + set listloc {} + if { $listdel != {} } { + foreach itm $listdel { + lappend listloc [list [lindex [split [lindex $itm 0]] 1] [lindex $itm 1]] + } + } + wokNAV:Tree:Del $listloc + msgunsetcmd + tixBusy $tpl off + destroy $tpl + return +} + + +proc wokDelete:Cancel { w } { + destroy $w + return +} diff --git a/src/WOKTclLib/wokEDF.hlp b/src/WOKTclLib/wokEDF.hlp new file mode 100755 index 0000000..28a739b --- /dev/null +++ b/src/WOKTclLib/wokEDF.hlp @@ -0,0 +1,118 @@ + + Key definitions: + + [1] Clicking mouse button 1 positions the insertion cursor just before the character underneath + the mouse cursor, sets the input focus to this widget, and clears any selection in the widget. + Dragging with mouse button 1 strokes out a selection between the insertion cursor and the + character under the mouse. + + [2] Double mouse button 1 selects the word under the mouse and positions the insertion cursor at + the beginning of the word. Dragging after a double click will stroke out a selection consisting + of whole words. + + [3] Triple-clicking button 1 selects the line under the mouse and positions the insertion cursor + at the beginning of the line. Dragging after a triple click will stroke out a selection which + consists of whole lines. + + [4] The ends of the selection can be adjusted by dragging with mouse button 1 while the Shift + key is down; this will adjust the end of the selection that was nearest to the mouse cursor when + button 1 was pressed. + If the button is double-clicked before dragging then the selection will be adjusted in units of + whole words; if it is triple-clicked then the selection will be adjusted in units of whole lines. + + [5] Clicking mouse button 1 with the Control key down will reposition the insertion cursor + without affecting the selection. + + [6] If any normal printing characters are typed, they are inserted at the point of the insertion + cursor. + + [7] The view in the widget can be adjusted by dragging with mouse button 2. If mouse button 2 is + clicked without moving the mouse, the selection is copied into the text at the position of the + mouse cursor. + The Insert key also inserts the selection, but at the position of the insertion cursor. + + [8] If the mouse is dragged out of the widget while button 1 is pressed, the entry will + automatically scroll to make more text visible (if there is more text offscreen on the side + where the mouse left the window). + + [9] The Left and Right keys move the insertion cursor one character to the left or right; + they also clear any selection in the text. If Left or Right is typed with the Shift key down, + then the insertion cursor moves and the selection is extended to include the new character. + Control-Left and Control-Right move the insertion cursor by words, and Control-Shift-Left and + ControlShift-Right move the insertion cursor by words and also extend the selection. + Control-b and Control-f behave the same as Left and Right, respectively. + Meta-b and Meta-f behave the same as Control-Left and ControlRight, respectively. + + [10] The Up and Down keys move the insertion cursor one line up or down and clear any selection + in the text. If Up or Right is typed with the Shift key down, then the insertion cursor moves + and the selection is extended to include the new character. + Control-Up and Control-Down move the insertion cursor by paragraphs (groups of lines separated by + blank lines), and Control-Shift-Up and Control-Shift-Down move the insertion cursor by paragraphs + and also extend the selection. + Control-p and Control-n behave the same as Up and Down, respectively. + + [11] The Next and Prior keys move the insertion cursor forward or backwards by one screenful and + clear any selection in the text. If the Shift key is held down while Next or Prior is typed, then + the selection is extended to include the new character. Control-v moves the view down one + screenful without moving the insertion cursor or adjusting the selection. + + [12] Control-Next and Control-Prior scroll the view right or left by one page without moving the + insertion cursor or affecting the selection. + + [13] Home and Control-a move the insertion cursor to the beginning of its line and clear any + selection in the widget. Shift-Home moves the insertion cursor to the beginning of the line and + also extends the selection to that point. + + [14] End and Control-e move the insertion cursor to the end of the line and clear any selection + in the widget. Shift-End moves the cursor to the end of the line and extends the selection to + that point. + + [15] Control-Home and Meta-< move the insertion cursor to the beginning of the text and clear + any selection in the widget. Control-Shift-Home moves the insertion cursor to the beginning of + the text and also extends the selection to that point. + + [16] Control-End and Meta-> move the insertion cursor to the end of the text and clear any + selection in the widget. Control-Shift-End moves the cursor to the end of the text and extends + the selection to that point. + + [17] The Select key and Control-Space set the selection anchor to the position of the insertion + cursor. They don't affect the current selection. Shift-Select and Control-Shift-Space adjust the + selection to the current position of the insertion cursor, selecting from the anchor to the + insertion cursor if there was not any selection previously. + + [18] Control-/ selects the entire contents of the widget. + + [19] Control-\ clears any selection in the widget. + + [20] The F16 key (labelled Copy on many Sun workstations) or Meta-w copies the selection in the + widget to the clipboard, if there is a selection. + + [21] The F20 key (labelled Cut on many Sun workstations) or Control-w copies the selection in the + widget to the clipboard and deletes the selection. If there is no selection in the widget then + these keys have no effect. + + [22] The F18 key (labelled Paste on many Sun workstations) or Control-y inserts the contents of + the clipboard at the position of the insertion cursor. + + [23] The Delete key deletes the selection, if there is one in the widget. + If there is no selection, it deletes the character to the right of the insertion cursor. + + [24] Backspace and Control-h delete the selection, if there is one in the widget. If there is no + selection, they delete the character to the left of the insertion cursor. + + [25] Control-d deletes the character to the right of the insertion cursor. + + [26] Meta-d deletes the word to the right of the insertion cursor. + + [27] Control-k deletes from the insertion cursor to the end of its line; if the insertion cursor + is already at the end of a line, then Control-k deletes the newline character. + + [28] Control-o opens a new line by inserting a newline character in front of the insertion cursor + without moving the insertion cursor. + + [29] Meta-backspace and Meta-Delete delete the word to the left of the insertion cursor. + + [30] Control-x deletes whatever is selected in the text widget. + + [31] Control-t reverses the order of the two characters to the right of the insertion cursor. + diff --git a/src/WOKTclLib/wokEDF.tcl b/src/WOKTclLib/wokEDF.tcl new file mode 100755 index 0000000..3a532be --- /dev/null +++ b/src/WOKTclLib/wokEDF.tcl @@ -0,0 +1,358 @@ +;# +;# charge file dans widget texte. +;# +proc wokEDF:iwok_editor { file } { + set w [wokTPL [id user][id host]$file] + if [winfo exists $w] { + wm deiconify $w + raise $w + return + } + set fnt [tix option get fixed_font] + toplevel $w + wm title $w "$file" + + tixScrolledText $w.text ; set texte [$w.text subwidget text] + $texte config -font $fnt + + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m + $w.file.m add command -label "Close " -underline 1 -command "destroy $w" + + menubutton $w.hlp -menu $w.hlp.menu -text "Help" + menu $w.hlp.menu + $w.hlp.menu add command -label "Help" -command [list wokEDF:Help $w] + + menubutton $w.edit -menu $w.edit.m -text Edit -underline 0 -takefocus 0 + menu $w.edit.m + $w.edit.m add command -label "Search" -command [list wokSEA $texte] + + frame $w.top -relief sunken -bd 1 + label $w.lab -relief raised + + if [ file writable $file] { + $w.file.m add command -label "Save" -underline 1 -command [list wokEDF:Save $texte $file] + } + + + tixForm $w.file -top 0 + tixForm $w.edit -left $w.file -top 0 + tixForm $w.hlp -right -0 -top 0 + tixForm $w.top -top $w.file -left 2 -right %99 + tixForm $w.text -left 2 -top $w.top -bottom $w.lab -right %99 + tixForm $w.lab -left 2 -right %99 -bottom %99 + + wokReadFile $texte $file 1.0 + update + return +} + +proc wokEDF:Save { text file } { + if [file writable $file] { + wokTextToFile $text $file + } + return +} +;# +;# envoie l'editeur charge par wokEDF:EDITOR +;# +proc wokEDF:EditFile { file } { + global IWOK_GLOBALS + + if ![ info exists IWOK_GLOBALS(EDF,EDITOR)] { + set IWOK_GLOBALS(EDF,EDITOR) [wokEDF:EDITOR] + } + + switch -- $IWOK_GLOBALS(EDF,EDITOR) { + + connected_emacs { + wokemacs findfile $IWOK_GLOBALS(EDF,clients) $file + } + + iwok_editor { + wokEDF:iwok_editor $file + + } + + default { + if { "file tail $IWOK_GLOBALS(EDF,EDITOR)" == "vi" } { + catch { exec xterm -T $file -e $IWOK_GLOBALS(EDF,EDITOR) $file & } + } else { + catch { eval exec $IWOK_GLOBALS(EDF,EDITOR) $file & } + } + } + + } + return +} +;# +;# Retourne de quoi editer un fichier +;# 1. connected_emacs si la session courante provient d'un emacs connecte dans ce cas +;# la variable IWOK_GLOBALS(EDF,clients) contient le numero de la connexion +;# 2. la valeur de la V.E. EDITOR si elle existe +;# 3. iwok_editor dans tous les autres cas (avec iwok_editor = widget text !!!) +;# +proc wokEDF:EDITOR { } { + global env + global IWOK_GLOBALS + global tcl_platform + set cnx [wokemacs clients] + if { $cnx != {} } { + set IWOK_GLOBALS(EDF,clients) $cnx + return connected_emacs + } else { + if { "$tcl_platform(platform)" == "unix" } { + if {[info exists env(EDITOR)]} { + return $env(EDITOR) + } else { + return iwok_editor + } + } else { + return iwok_editor + } + } +} +;# +;# Help +;# +proc wokEDF:Help { w } { + global IWOK_GLOBALS + global env + set whelp [wokHelp [set IWOK_GLOBALS(EDF,help) .wokEDFHelp] "About iwok editor"] + set texte [lindex $whelp 0] ; set label [lindex $whelp 1] + if {[info exist IWOK_GLOBALS(windows)]} { + if {[lsearch $IWOK_GLOBALS(windows) .wokEDFHelp ] == -1} { + lappend IWOK_GLOBALS(windows) .wokEDFHelp + } + } + wokReadFile $texte $env(WOK_LIBRARY)/wokEDF.hlp + wokFAM $texte <.*> { $texte tag add big first last } + + $texte tag configure big -background Bisque3 -foreground black -borderwidth 2 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-* -relief raised + + $texte configure -state disabled + update + return +} + +;# +;# +;# +proc wokEDF:Archive { file args } { + set w [wokTPL [id user][id host]$file] + if [winfo exists $w] { + wm deiconify $w + raise $w + return + } + set fnt [tix option get fixed_font] + toplevel $w + wm title $w "Contents of archive $file" + + wokButton setw [list archive $w] + + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m + $w.file.m add command -label "Close " -underline 1 -command "destroy $w" + + frame $w.top -relief sunken -bd 1 + label $w.lab -relief raised + + tixScrolledText $w.text ; set texte [$w.text subwidget text] + $texte config -font $fnt -cursor {hand2 red white} + + tixForm $w.file + tixForm $w.top -top $w.file -left 2 -right %99 + tixForm $w.text -left 2 -top $w.top -bottom $w.lab -right %99 + tixForm $w.lab -left 2 -right %99 -bottom %99 + + wokReadString $texte [exec ar tv $file] + + update + return +} +proc wokEDF:Archive:Exit { w } { + wokButton delw [list archive $w] + destroy $w + return +} +;# +;# donne la liste des .o d'une shareable et proposera nm et Cie args Adr File +;# +proc wokEDF:Shareable { file args} { + global IWOK_WINDOWS + set location $args ;# loc WOK:k3dev:ref:TKWOK:stadmfile + set ll [llength [set lc [split $location :]]] + set actloc [join [lrange $lc 0 [expr $ll - 2]] :] + set typloc [lindex $lc end] + set ud [wokinfo -n $actloc] + set objlist [wokinfo -p stadmfile:${ud}.ObjList $actloc] + if [file exists $objlist] { + set tfi [split [file tail $file] .] + set w [string tolower .[id user]:[id host]:[join $tfi :]] + if [winfo exists $w] { + wm deiconify $w + raise $w + return + } + set fnt [tix option get fixed_font] + toplevel $w + wm title $w "Objects in file $file" + + wokButton setw [list shareable $w] + + tixScrolledText $w.text ; set IWOK_WINDOWS($w,text) [$w.text subwidget text] + $IWOK_WINDOWS($w,text) config -font $fnt -cursor {hand2 red white} + + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m + $w.file.m add command -label "Close " -underline 1 -command [list wokEDF:Shareable:Exit $w] + + menubutton $w.disp -menu $w.disp.m -text Arrange -underline 0 -takefocus 0 + menu $w.disp.m + $w.disp.m add radio -label "By name" -under 1 -var IWOK_WINDOWS($w,bywhat) \ + -value byname -comm [list wokEDF:Shareable:Disp $w] + $w.disp.m add radio -label "By date" -under 1 -var IWOK_WINDOWS($w,bywhat) \ + -value bydate -comm [list wokEDF:Shareable:Disp $w] + set IWOK_WINDOWS($w,bywhat) bydate + $w.disp.m add separator + $w.disp.m add radio -label "Full path" -under 1 -var IWOK_WINDOWS($w,bywhat) \ + -value fullpa -comm [list wokEDF:Shareable:Disp $w] + set IWOK_WINDOWS($w,bywhat) fullpa + + frame $w.top -relief sunken -bd 1 + label $w.lab -relief raised + + menubutton $w.edit -menu $w.edit.m -text Edit -underline 0 -takefocus 0 + menu $w.edit.m + $w.edit.m add command -label "Search" -command [list wokSEA $IWOK_WINDOWS($w,text)] + + tixForm $w.file ; tixForm $w.disp -left $w.file ; tixForm $w.edit -left $w.disp + tixForm $w.top -top $w.file -left 2 -right %99 + tixForm $w.text -left 2 -top $w.top -bottom $w.lab -right %99 + tixForm $w.lab -left 2 -right %99 -bottom %99 + + set IWOK_WINDOWS($w,listo) [wokUtils:FILES:FileToList $objlist] + wokEDF:Shareable:Disp $w + set solen [llength $IWOK_WINDOWS($w,listo)] + set sodat [string range [fmtclock [file mtime $file]] 4 18] + $w.lab configure -text "$solen objects." + update + } + return +} + +proc wokEDF:Shareable:Exit { w } { + wokButton delw [list shareable $w] + destroy $w + return +} + +proc wokEDF:Shareable:Disp { w } { + global IWOK_WINDOWS + set ll $IWOK_WINDOWS($w,listo) + set l1 {} + if { "$IWOK_WINDOWS($w,bywhat)" == "fullpa" } { + wokReadList $IWOK_WINDOWS($w,text) $IWOK_WINDOWS($w,listo) + return + } + tixBusy $w on + update + foreach e $ll { + catch {unset m} + file lstat $e m + lappend l1 [list [file tail $e] $m(mtime) $m(size)] + } + + switch -- $IWOK_WINDOWS($w,bywhat) { + byname { + set l2 [lsort -command wokEDF:Shareable:byname $l1] + } + + bydate { + set l2 [lsort -decreasing -command wokEDF:Shareable:bydate $l1] + } + } + set l3 {} + foreach e $l2 { + set str [lindex $e 0] + set dat [string range [fmtclock [lindex $e 1]] 4 18] + set siz [lindex $e 2] + lappend l3 [format "%15s %-10s %s" $dat $siz $str] + } + wokReadList $IWOK_WINDOWS($w,text) $l3 + tixBusy $w off + return +} +;# +;# Ordre alphab sur le path ou le full path +;# +proc wokEDF:Shareable:byname { a b } { + return [string compare [lindex $a 0] [lindex $b 0] ] +} + +;# +;# dernier modifie d'abord +;# +proc wokEDF:Shareable:bydate { a b } { + return [expr [lindex $a 1] - [lindex $b 1] ] +} +;# +;# +;# +proc wokEDF:Zfile { file args } { + return +} + +proc wokEDF:ofile { file args } { + return +} + +;# +;# comment recuperer les extensions de shareable ?? +;# +proc wokEDF:InitAdequateCommand { } { + global IWOK_GLOBALS + set IWOK_GLOBALS(EDF,EDITOR) [wokEDF:EDITOR] + set IWOK_GLOBALS(EDF,.a) wokEDF:Archive + set IWOK_GLOBALS(EDF,.so) wokEDF:Shareable + set IWOK_GLOBALS(EDF,.sl) wokEDF:Shareable + set IWOK_GLOBALS(EDF,.Z) wokEDF:Zfile + set IWOK_GLOBALS(EDF,.o) wokEDF:ofile + return +} +;# +;# +;# +proc wokEDF:AdequateCommand { path args } { + global IWOK_GLOBALS + set ext [file extension $path] + if [info exists IWOK_GLOBALS(EDF,$ext)] { + $IWOK_GLOBALS(EDF,$ext) $path $args + } else { + wokEDF:EditFile $path + } + return +} +;# +;# +;# +proc wokEDF:InitExtension { } { + global IWOK_GLOBALS + set IWOK_GLOBALS(EXT,package,ext) {.cdl .cxx .hxx .c .h} + set IWOK_GLOBALS(EXT,nocdlpack,ext) {.cxx .hxx .c .h} + set IWOK_GLOBALS(EXT,interface,ext) {.cdl .cxx .hxx} + set IWOK_GLOBALS(EXT,client,ext) {.cdl .cxx .hxx} + set IWOK_GLOBALS(EXT,toolkit,ext) {} + set IWOK_GLOBALS(EXT,engine,ext) {.cdl .cxx .hxx} + set IWOK_GLOBALS(EXT,executable,ext) {.cdl .cxx .hxx} + set IWOK_GLOBALS(EXT,schema,ext) {.cdl .cxx .hxx} + set IWOK_GLOBALS(EXT,ccl,ext) {.ccl .us .fr} + set IWOK_GLOBALS(EXT,frontal,ext) {} + set IWOK_GLOBALS(EXT,documentation,ext) {} + set IWOK_GLOBALS(EXT,resource,ext) {.o .xwd .dat .tcl .el .csh} + set IWOK_GLOBALS(EXT,delivery,ext) {} + set IWOK_GLOBALS(EXT,all) {.cdl .cxx .hxx .gxx .lxx .pxx .c .h .edl .tcl} + return +} diff --git a/src/WOKTclLib/wokMainHelp.hlp b/src/WOKTclLib/wokMainHelp.hlp new file mode 100755 index 0000000..964ba7a --- /dev/null +++ b/src/WOKTclLib/wokMainHelp.hlp @@ -0,0 +1,104 @@ + Menu: + + + + + Ends the iwok session. The session was started by typing the iwok command. + You may also type iwok -f but in this case the exploration starts at the root with the session. + + + + Displays the name of all the created windows with the selected one first. + You may choose to hide or show all the created windows. + + + + 'Contents of' window: + + + This window displays the name of the entity being explored. + Click on the 'pointed finger'icon to go there (i.e. wokcd). + This address becomes the current entity of the Tcl session and the application buttons are + activated according to the type of entity. + The arrow located to the right of the field 'Contents of' lists all the last visited addresses; you + may perform your selection directly in this list. + + + + Display management buttons: + + + + + Items are displayed in one column in alphabetical order. + + + + Items are displayed in one column with the last modified items first. + For each item, the modification date and the size are provided. + + + + Items are displayed in one column in alphabetical order. + For each item, the modification date and the size are provided. + + + + Items are displayed in rows in alphabetical order on one line. + + + + Goes up one level and displays the contents of the entity. + Example: If the current address is in a workbench, the list of all the workbenches in the + workshop is displayed. + + + + Runs the wokcd command with the contents of the location window as an argument. + + + + Click on the Matra Datavision logo to stretch the window and display the contents of the + selected entity. If the window has already been stretched, it is closed. + Double-click on the displayed element to explore its contents. In the case of a file, it is + loaded into an editor. + + The editor is either: + - emacs where you have created a *woksh* buffer, + - an editor defined by the environment variable EDITOR, + - the default editor provided with IWOK in all other cases. + + + + WOK applications buttons: + + + The buttons are activated according to the type of entity where you performed the wokcd command. + + + + + Gives access to the WOK command wprepare which compares the workbench with the root workbench of + the workshop. + + + + + Gives access to the WOK command umake and all umake options. + + + + + Allows consultation and possible edition of the session parameters. + + + + + Allows consultation of the CDL translation results in the current Tcl session. + + + + + + + diff --git a/src/WOKTclLib/wokNAV.tcl b/src/WOKTclLib/wokNAV.tcl new file mode 100755 index 0000000..d97a62b --- /dev/null +++ b/src/WOKTclLib/wokNAV.tcl @@ -0,0 +1,697 @@ +# +# Ouvre une entry dans le tree. (Double Click) +# +proc wokNAV:Tree:Open { w dir } { + global IWOK_WINDOWS + if {[$IWOK_WINDOWS($w,NAV,hlist) info children $dir] != {}} { + foreach kid [$IWOK_WINDOWS($w,NAV,hlist) info children $dir] { + $IWOK_WINDOWS($w,NAV,hlist) show entry $kid + } + set data [$IWOK_WINDOWS($w,NAV,hlist) info data $dir] + set loc [lindex $data 0] + wokUpdateLayout $loc + wokCWD writenocallback $loc + } else { + tixBusy $w on + update + wokNAV:Tree:Fill $w $dir + tixBusy $w off + } + + return +} + +# +# Appele par Open. +# +proc wokNAV:Tree:Fill { w dir } { + global IWOK_WINDOWS + set data [$IWOK_WINDOWS($w,NAV,hlist) info data $dir] + set loc [lindex $data 0] + set type [lindex $data 1] + + switch -glob $type { + + factory { + wokNAV:Tree:Updateworkshop $w $loc $dir + } + + workshop { + wokNAV:Tree:Updateworkbench $w $loc $dir + } + + warehouse { + wokNAV:Tree:Updatewarehouse $w $loc $dir + } + + parcel { + wokNAV:Tree:Updateparcel $w $loc $dir + } + + workbench { + wokNAV:Tree:Updatedevunit $w $loc $dir + } + + session { + wokNAV:Tree:Updatefactory $w $loc $dir + } + + stuff_* { + wokNAV:Tree:Updatestufflist $w $loc $dir $type + } + + parcel_* { + wokNAV:Tree:Updateparcelstufflist $w $loc $dir $type + } + + parcelstuff_* { + wokNAV:Tree:Updatestufflist $w $loc $dir $type + } + + devunit_* { + wokNAV:Tree:Updatedevunitstuff $w $loc $dir + } + + default { + puts "type = $type = for $loc is unknown" + return + } + } + wokCWD write $loc + return +} +# +# +# +proc wokNAV:Tree:Show { w dir } { + global IWOK_WINDOWS + $IWOK_WINDOWS($w,NAV,hlist) anchor clear + $IWOK_WINDOWS($w,NAV,hlist) anchor set $dir + $IWOK_WINDOWS($w,NAV,hlist) selection clear + $IWOK_WINDOWS($w,NAV,hlist) selection set $dir + $IWOK_WINDOWS($w,NAV,hlist) see $dir + return +} +# +# Charge un terminal/trigger en fonction de son type. (Simple Click) +# +proc wokNAV:Tree:Browse { w dir } { + global IWOK_WINDOWS + set data [$IWOK_WINDOWS($w,NAV,hlist) info data $dir] + set type [lindex $data 1] + if { [regexp {trig_(.*)} $type all trig] } { + switch -- $trig { + terminal { + wokNAV:Tree:terminal $w [lindex $data 0] $dir + } + + Repository { + wokUpdateRepository [lindex $data 0] + } + + Queue { + wokWaffQueue [lindex $data 0] + } + } + } + return +} + +# +# Hilight l'entry correspondante et l'ouvre sauf si c'est un "trigger" (appelee par bind canvas) +# +proc wokNAV:Tree:Focus { w dir } { + global IWOK_WINDOWS + set data [$IWOK_WINDOWS($w,NAV,hlist) info data $dir] + set type [lindex $data 1] + if { [regexp {trig_(.*)} $type all trig] } { + switch -- $trig { + terminal { + wokNAV:Tree:terminal $w [lindex $data 0] $dir + } + + Repository { + wokUpdateRepository [lindex $data 0] + } + + Queue { + wokWaffQueue [lindex $data 0] + } + + } + + } else { + wokNAV:Tree:Open $w $dir + $IWOK_WINDOWS($w,NAV,tree) setmode $dir close + } + wokNAV:Tree:Show $w $dir + return +} +# +# +# +proc wokNAV:Tree:SeeMe { w loc dir } { + wokNAV:tlist:Set $w $loc $dir + wokCWD write $loc + wokNAV:Tree:Focus $w $dir + return +} +# +# +# +proc wokNAV:Tree:UpdateSession { w user } { + global IWOK_WINDOWS + set disp [list 18 18 600 30 16 1.4] + set fdate wokGetsessiondate + $IWOK_WINDOWS($w,NAV,hlist) add ^ -text $user -data [list : session $user {} $fdate $disp] + wokNAV:Tree:Fill $w ^ + wokNAV:tlist:Set $w : ^ + return +} +# +# ici dir = ^ +# +proc wokNAV:Tree:Updatefactory { w loc dir } { + global IWOK_WINDOWS + global IWOK_GLOBALS + wokNAV:Initfactory + set disp $IWOK_GLOBALS(factory,disp) + set fdate $IWOK_GLOBALS(factory,fdate) + 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] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}$name open + } + wokNAV:tlist:Set $w $loc $dir + return +} +# +# loc est une adresse de factory +# +proc wokNAV:Tree:Updateworkshop { w loc dir } { + global IWOK_WINDOWS + global IWOK_GLOBALS + wokNAV:Initworkshop + + set disp $IWOK_GLOBALS(workshop,disp) + set fdate $IWOK_GLOBALS(workshop,fdate) + 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] + $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] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open + } + wokNAV:tlist:Set $w $loc $dir + return +} +;# +;# loc est une adresse de workshop +;# +proc wokNAV:Tree:Updateworkbench { w loc dir } { + global IWOK_WINDOWS + global IWOK_GLOBALS + wokNAV:Initworkbench + set disp $IWOK_GLOBALS(workbench,disp) + set fdate $IWOK_GLOBALS(workbench,fdate) + set image $IWOK_GLOBALS(workbench,image) + + if { [wokIntegre:BASE:GetType $loc] != {} } { + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^_Queue] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^_Queue \ + -itemtype imagetext -text Queue \ + -image [tix getimage queue] \ + -data [list ${loc}:Queue trig_Queue Queue [tix getimage queue] $fdate $disp] + } + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^_Reposit] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^_Reposit \ + -itemtype imagetext -text Repository \ + -image [tix getimage reposit] \ + -data [list ${loc}:Repository trig_Repository Repository [tix getimage reposit] $fdate $disp] + } + } + + foreach name [sinfo -w $loc] { + $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 + return +} +;# +;# +;# +proc wokNAV:Tree:Updatedevunit { w loc dir } { + global IWOK_WINDOWS + global IWOK_GLOBALS + wokNAV:Initdevunit $loc + foreach d [lsort -command wokSortUnit [w_info -a $loc]] { + set name [lindex $d 1] + set type [lindex $d 0] + 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] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open + } + wokNAV:tlist:Set $w $loc $dir + return +} +;# +;# +;# +proc wokSortUnit { a b } { + return [string compare [lindex $a 1] [lindex $b 1]] +} +proc wokSortPath { a b } { + return [string compare [file tail $a] [file tail $b]] +} +;# +;# +;# +proc wokNAV:Tree:Updatedevunitstuff { w loc dir } { + global IWOK_WINDOWS + global IWOK_GLOBALS + wokNAV:Initdevunitstuff + set fdate $IWOK_GLOBALS(devunitstuff,fdate) + set disp $IWOK_GLOBALS(devunitstuff,disp) + + catch { unset TLOC } + foreach f [uinfo -Fpl $loc] { + set t [lindex $f 0] + set p [lindex $f 2] + if [info exists TLOC($t)] { + set l $TLOC($t) + lappend l $p + set TLOC($t) $l + } else { + set TLOC($t) $p + } + } + + + 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] + $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] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open + set IWOK_WINDOWS($w,NAV,tree,uinfo,${loc}:${name},$name) $TLOC($name) + } + } + wokNAV:tlist:Set $w ${loc} $dir + + return +} +;# +;# +;# +proc wokNAV:Tree:Updatestufflist { w loc dir stuff_type } { + global IWOK_WINDOWS + + set image [tix getimage textfile] + set type [lindex [split $stuff_type _] 1] + + 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] + } + wokNAV:tlist:Set $w ${loc} $dir + return +} +# +# data /adv_23/WOK/k2dev/ref/src/NWOK/COMPONENTS terminal +# +proc wokNAV:Tree:terminal { w loc dir } { + global IWOK_WINDOWS + set data [$IWOK_WINDOWS($w,NAV,hlist) info data $dir] + wokEDF:AdequateCommand [lindex $data 4] $loc + return +} +# +# loc est une adresse de factory +# +proc wokNAV:Tree:Updatewarehouse { w loc dir } { + global IWOK_WINDOWS + set disp [list 18 18 600 30 12 1.4] + set fdate wokGetparceldate + set image [tix getimage parcel] + foreach itm [Winfo -p $loc] { + if ![$IWOK_WINDOWS($w,NAV,hlist) info exists ${dir}^${itm}] { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir}^${itm} -itemtype imagetext \ + -text $itm -image $image \ + -data [list ${loc}:${itm} parcel ${itm} $image $fdate $disp] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${itm} open + } + } + wokNAV:tlist:Set $w $loc $dir + return +} +# +# loc est une adresse de parcel (WOK:BAG:NWOK-K2-1) +# +proc wokNAV:Tree:Updateparcel { w loc dir } { + global IWOK_WINDOWS + set disp [list 18 18 600 30 12 1.4] + set fdate wokGetparcelunitdate + 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] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open + } + wokNAV:tlist:Set $w $loc $dir + return +} +# +# +# +proc wokNAV:Tree:Updateparcelstufflist { w loc dir stuff_type } { + global IWOK_WINDOWS + ;#puts "Updateparcelstufflist : $loc $dir $stuff_type" + + set isource [tix getimage source] + set icell [tix getimage cell] + + set disp [list 18 18 600 18 10 1.2] + set fdate wokGetparcelunitstuffdate + + catch { unset TLOC } + foreach f [uinfo -Fpl $loc] { + set t [lindex $f 0] + set p [lindex $f 2] + if [info exists TLOC($t)] { + set l $TLOC($t) + lappend l $p + set TLOC($t) $l + } else { + set TLOC($t) $p + } + } + + 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] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open + set IWOK_WINDOWS($w,NAV,tree,uinfo,${loc}:${name},$name) $TLOC($name) + } + wokNAV:tlist:Set $w ${loc} $dir + return +} +# +# Sauve l'adresse( dans la hlist ) de ce qui a ete affiche +# +proc wokNAV:tlist:Set { w loc dir } { + global IWOK_WINDOWS + set IWOK_WINDOWS($w,NAV,tlist,$loc) $dir + ;#puts "set IWOK_WINDOWS($w,NAV,tlist,$loc) = $dir" + return +} +# +# +# +proc wokNAV:tlist:Get { w loc } { + global IWOK_WINDOWS + if [info exists IWOK_WINDOWS($w,NAV,tlist,$loc)] { + return $IWOK_WINDOWS($w,NAV,tlist,$loc) + } else { + ;#puts "wokNAV:tlist:Get pas d'info pour $loc" + return {} + } +} +# +# horreur 1: tout ca pour ce petit cheri de wokinfo +# on pourrait scanner tous les noeuds et chercher la data qui correspond... +proc wokNAV:tlist:locTodir { loc } { + set l [split $loc :] + if {"[lindex $l 0]" == {} } { + return [join $l ^] + } else { + return ^[join $l ^] + } +} +# +# +# +proc wokNAV:tlist:Type { w loc } { + global IWOK_WINDOWS + if [info exists IWOK_WINDOWS($w,NAV,tlist,$loc)] { + return [lindex [$IWOK_WINDOWS($w,NAV,hlist) info data $IWOK_WINDOWS($w,NAV,tlist,$loc)] 1] + } else { + return {} + } +} +# +# Recupere les info associees a loc +# +proc wokNAV:tlist:GetData { w loc } { + global IWOK_WINDOWS + set hlist $IWOK_WINDOWS($w,NAV,hlist) + set ll {} + set dir [wokNAV:tlist:Get $w $loc] + if [$hlist info exists $dir] { + if { [$hlist info children $dir] != {} } { + foreach kid [$IWOK_WINDOWS($w,NAV,hlist) info children $dir] { + lappend ll [linsert [$hlist info data $kid] 0 $kid] + } + } + } + return $ll +} +# +# Idem qu'au dessus : utilise pour un terminal. +# +proc wokNAV:tlist:TermData { w dir } { + global IWOK_WINDOWS + set hlist $IWOK_WINDOWS($w,NAV,hlist) + if [$hlist info exists $dir] { + return [$hlist info data $dir] + } +} + +proc wokNAV:tlist:Display { w loc } { + global IWOK_WINDOWS + if [info exists IWOK_WINDOWS($w,NAV,tlist,$loc) ] { + return [lindex [$IWOK_WINDOWS($w,NAV,hlist) info data $IWOK_WINDOWS($w,NAV,tlist,$loc)] end] + } +} + +proc wokNAV:tlist:date { w loc } { + global IWOK_WINDOWS + if [info exists IWOK_WINDOWS($w,NAV,tlist,$loc) ] { + set i [expr [llength [$IWOK_WINDOWS($w,NAV,hlist) info data $IWOK_WINDOWS($w,NAV,tlist,$loc)]] -2] + return [lindex [$IWOK_WINDOWS($w,NAV,hlist) info data $IWOK_WINDOWS($w,NAV,tlist,$loc)] $i] + } +} +# +# Recupere l'adresse (loc) du pere +# +proc wokNAV:Tlist:Dad { w loc } { + global IWOK_WINDOWS + if [info exists IWOK_WINDOWS($w,NAV,tlist,$loc) ] { + set dir $IWOK_WINDOWS($w,NAV,tlist,$loc) + set dad [$IWOK_WINDOWS($w,NAV,hlist) info parent $dir] + return [lindex [$IWOK_WINDOWS($w,NAV,hlist) info data $dad] 0] + } else { + return {} + } +} +# +# imprime tout ce qu'il y a dans hli ( Hlist ) +# +proc wokNAV:DBG { {root {}} } { + global IWOK_GLOBALS + global IWOK_WINDOWS + set w $IWOK_GLOBALS(toplevel) + set hli $IWOK_WINDOWS($w,NAV,hlist) + foreach c [$hli info children $root] { + puts "$c : data <[$hli info data $c]>" + wokNAV:DBG $c + } + return +} +proc wokDUMP { } { + global IWOK_GLOBALS + global IWOK_WINDOWS + parray IWOK_WINDOWS $IWOK_GLOBALS(toplevel),NAV,tlist,* + return +} +# +# Ajoute l'entry de type $type correspondant a loc a l'adresse fdir du tree . +# +# +proc wokNAV:Tree:Add { fdir loc name type } { + global IWOK_GLOBALS + global IWOK_WINDOWS + set w $IWOK_GLOBALS(toplevel) + if { [$IWOK_WINDOWS($w,NAV,hlist) info children $fdir] != {} } { + wokNAV:Init${type} $loc + if { [info exists IWOK_GLOBALS($type,disp)] } { + set disp $IWOK_GLOBALS($type,disp) + set fdate $IWOK_GLOBALS($type,fdate) + set image $IWOK_GLOBALS($type,image) + set dir ${fdir}^${name} + if { ![$IWOK_WINDOWS($w,NAV,hlist) info exists $dir] } { + $IWOK_WINDOWS($w,NAV,hlist) add ${dir} \ + -itemtype imagetext -text $name \ + -image $image \ + -data [list $name $type $name $image $fdate $disp] + $IWOK_WINDOWS($w,NAV,tree) setmode ${dir} open + wokNAV:tlist:Set $w ${loc} $dir + ;# si l'entry pere a ete depliee puis repliee ne pas afficher, sera fait a l'ouverture + if { "[$IWOK_WINDOWS($w,NAV,tree) getmode $fdir]" == "open" } { + ;#puts "on cache car $fdir n est pas open" + $IWOK_WINDOWS($w,NAV,hlist) hide entry ${dir} + } + ;# si l'adresse est celle affiche dans le canvas : mettre a jour + if { "[wokCWD read]:${name}" == "$loc" } { + wokCWD write [wokCWD read] + } + } else { + puts stderr "Entry $dir already exists. not done" + } + } else { + puts stderr "Unable to read IWOK_GLOBALS($type,disp)" + } + } else { + ;# n'a pas ete encore affichee => sera updatee par WOK a la prochaine ouverture. + } + return +} +# +# Vire les entry de lstdir du tree. listloc = { ... {$loc $type} ... } +# Comme on ne connait pas l'etat du tree on fait info exists... +# meme chose pour l'historique dans la ComboBox. +# +proc wokNAV:Tree:Del { listloc } { + global IWOK_WINDOWS + global IWOK_GLOBALS + set w $IWOK_GLOBALS(toplevel) + set update 0 + set layout [wokListLayout] + foreach itm $listloc { + set loc [lindex $itm 0] + set typ [lindex $itm 1] + set dir [wokNAV:tlist:locTodir $loc] + if { [$IWOK_WINDOWS($w,NAV,hlist) info exists $dir] } { + set actloc [lindex [$IWOK_WINDOWS($w,NAV,hlist) info data $dir] 0] + $IWOK_WINDOWS($w,NAV,hlist) delete entry ${dir} + if [info exists IWOK_WINDOWS($w,NAV,tlist,$actloc)] { + unset IWOK_WINDOWS($w,NAV,tlist,$actloc) + } + ;# faudra t-il mettre a jour le canvas ? + if { [lsearch $layout $actloc] != -1 } { + set update 1 + } + wokCWD deletefromhistory $actloc + } + } + ;# Un des elements detruits etait dans le canvas. On met a jour. + ;# On monte d'un cran si en pointant dans la hlist on detruit l'element affiche (CWD read) + ;# tout ca est un peu complique. + if { $update == 1 } { + set displayed [wokCWD read] + set dir [wokNAV:tlist:locTodir $displayed] + if [$IWOK_WINDOWS($w,NAV,hlist) info exists $dir] { + wokCWD write $displayed + } else { + wokCWD write [wokinfo -N $displayed] + } + } + return +} + +proc wokNAV:Initfactory { args } { + global IWOK_GLOBALS + if ![info exists IWOK_GLOBALS(factory,initdone)] { + set IWOK_GLOBALS(factory,initdone) 1 + set IWOK_GLOBALS(factory,disp) [list 18 18 600 30 16 1.8] + set IWOK_GLOBALS(factory,fdate) wokGetfactorydate + set IWOK_GLOBALS(factory,image) [tix getimage factory] + } + return +} + +proc wokNAV:Initworkshop { args } { + global IWOK_GLOBALS + if ![info exists IWOK_GLOBALS(workshop,initdone)] { + set IWOK_GLOBALS(workshop,initdone) 1 + set IWOK_GLOBALS(workshop,disp) [list 18 18 600 30 14 1.5] + set IWOK_GLOBALS(workshop,fdate) wokGetworkshopdate + set IWOK_GLOBALS(workshop,image) [tix getimage workshop] + } + return +} + +proc wokNAV:Initworkbench { args } { + global IWOK_GLOBALS + if ![info exists IWOK_GLOBALS(workbench,initdone)] { + set IWOK_GLOBALS(workbench,initdone) 1 + set IWOK_GLOBALS(workbench,disp) [list 18 18 600 30 12 1.4] + set IWOK_GLOBALS(workbench,fdate) wokGetworkbenchdate + set IWOK_GLOBALS(workbench,image) [tix getimage workbench] + } + return +} + +proc wokNAV:Initdevunit { args } { + global IWOK_GLOBALS + ;# [ucreate -P $args] + if ![info exists IWOK_GLOBALS(devunit,initdone)] { + set IWOK_GLOBALS(devunit,initdone) 1 + foreach t $IWOK_GLOBALS(ucreate-P) { + set x [lindex $t 1] + set IWOK_GLOBALS($x,disp) [list 18 18 600 18 10 1.2] + set IWOK_GLOBALS($x,fdate) wokGetdevunitdate + set IWOK_GLOBALS($x,image) [tix getimage $x] + eval "proc wokNAV:Init${x} { args } {global IWOK_GLOBALS ; set IWOK_GLOBALS($x,disp) \"$IWOK_GLOBALS($x,disp)\" ;set IWOK_GLOBALS($x,fdate) $IWOK_GLOBALS($x,fdate) ;set IWOK_GLOBALS($x,image) $IWOK_GLOBALS($x,image);return }" + } + } + return +} + +proc wokNAV:Initdevunitstuff { args } { + global IWOK_GLOBALS + if ![info exists IWOK_GLOBALS(devunitstuff,initdone)] { + set IWOK_GLOBALS(devunitstuff,initdone) 1 + set IWOK_GLOBALS(devunitstuff,disp) [list 18 18 600 18 10 1.2] + set IWOK_GLOBALS(devunitstuff,fdate) wokGetdevunitstuffdate + set IWOK_GLOBALS(devunitstuff,source) [tix getimage source] + set IWOK_GLOBALS(devunitstuff,cell) [tix getimage cell] + } + return +} diff --git a/src/WOKTclLib/wokOUC.tcl b/src/WOKTclLib/wokOUC.tcl new file mode 100755 index 0000000..3c2c8e7 --- /dev/null +++ b/src/WOKTclLib/wokOUC.tcl @@ -0,0 +1,481 @@ + +proc wokOUC:DBG { {root {}} } { + global IWOK_GLOBALS + global IWOK_WINDOWS + set w .oucewokk4dev + set hli $IWOK_WINDOWS($w,OUC,hlist) + foreach c [$hli info children $root] { + puts "$c : data <[$hli info data $c]>" + wokOUC:DBG $c + } + return +} + + + +############################################################################# +# +# O U C +# _____ +# +############################################################################# +proc wokOUC:Exit { w } { + global IWOK_WINDOWS + destroy $w + wokButton delw [list ouce $w] + foreach var [array names IWOK_WINDOWS $w,OUC,*] { + unset IWOK_WINDOWS($var) + } + return +} + +proc wokOUC:Help { w } { + return +} + +proc wokOUC:Create { {loc {}} } { + global IWOK_WINDOWS + global IWOK_GLOBALS + + if { $loc == {} } { + set verrue [wokCWD readnocell] + } else { + regexp {(.*):OUCE} $loc all verrue + } + + if ![wokinfo -x $verrue] { + wokDialBox .wokcd {Unknown location} "Location $verrue is unknown" {} -1 OK + return + } + set fshop [wokinfo -s $verrue] + + set w [wokTPL ouce${verrue}] + if [winfo exists $w ] { + wm deiconify $w + raise $w + return + } + + toplevel $w + wm title $w "OUCE of $fshop" + wm geometry $w 880x555+515+2 + + wokButton setw [list ouce $w] + + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m + $w.file.m add command -label "Exit " -underline 1 -command [list wokOUC:Exit $w] + + menubutton $w.help -menu $w.help.m -text Help -underline 0 -takefocus 0 + menu $w.help.m + $w.help.m add command -label "Help" -underline 1 -command [list wokOUC:Help $w] + + frame $w.top -relief sunken -bd 1 + + tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50 + pack $w.top.pane -side top -expand yes -fill both -padx 10 -pady 10 + + set p1 [$w.top.pane add tree -min 70 -size 200] + set p2 [$w.top.pane add text -min 70] + + set tree [tixTree $p1.tree -options {hlist.separator "^" hlist.selectMode single }] + set text [tixScrolledText $p2.text ] ; $text subwidget text config -font $IWOK_GLOBALS(font) + + $tree config -opencmd [list wokOUC:Tree:Open $w] -browsecmd [list wokOUC:Tree:Browse $w] + + pack $p1.tree -expand yes -fill both -padx 1 -pady 1 + pack $p2.text -expand yes -fill both -padx 1 -pady 1 + + set IWOK_WINDOWS($w,OUC,tree) $tree + set IWOK_WINDOWS($w,OUC,hlist) [$tree subwidget hlist] + set IWOK_WINDOWS($w,OUC,text) [$text subwidget text] + set IWOK_WINDOWS($w,OUC,label) [label $w.lab] + set IWOK_WINDOWS($w,OUC,shop) $fshop + set IWOK_WINDOWS($w,OUC,root) [wokOUC:GetRootName $fshop] + set IWOK_WINDOWS($w,OUC,dupstyle) [tixDisplayStyle imagetext -fg orange] + + tixButtonBox $w.act -orientation horizontal -relief flat -padx 0 -pady 0 + + + tixForm $w.file ; tixForm $w.help -right -2 + tixForm $w.act -top $w.file -left 2 + tixForm $w.top -top $w.act -left 2 -right %99 -bottom $w.lab + tixForm $w.lab -left 2 -right %99 -bottom %99 + + bind $IWOK_WINDOWS($w,OUC,hlist) { + wokOUC:Tree:diff [winfo toplevel %W] + } + bind $IWOK_WINDOWS($w,OUC,hlist) { + wokOUC:Tree:diff [winfo toplevel %W] + } + wokOUC:Tree:Fill $w + + return +} + +proc wokOUC:Tree:diff { w } { + global IWOK_WINDOWS + if ![info exists IWOK_WINDOWS($w,OUC,v1)] { + set IWOK_WINDOWS($w,OUC,v1) [$IWOK_WINDOWS($w,OUC,hlist) info anchor] + } else { + if ![info exists IWOK_WINDOWS($w,OUC,v2)] { + set IWOK_WINDOWS($w,OUC,v2) [$IWOK_WINDOWS($w,OUC,hlist) info anchor] + set pth1 [lindex [lindex [$IWOK_WINDOWS($w,OUC,hlist) info data $IWOK_WINDOWS($w,OUC,v1)] 1] 2] + set pth2 [lindex [lindex [$IWOK_WINDOWS($w,OUC,hlist) info data $IWOK_WINDOWS($w,OUC,v2)] 1] 2] + if { [file exists $pth1] && [file exists $pth2] } { + wokDiffInText $IWOK_WINDOWS($w,OUC,text) $pth1 $pth2 + if [wokUtils:EASY:INPATH xdiff] { + } + } + } + } + return +} +#;> +# Pour iwok Ecrit la table dans un tree +#;< +proc wokOUC:Tree:Fill { w } { + global IWOK_WINDOWS + tixBusy $w on + set fshop $IWOK_WINDOWS($w,OUC,shop) + set root $IWOK_WINDOWS($w,OUC,root) + set hlist $IWOK_WINDOWS($w,OUC,hlist) + set filima [tix getimage textfile] + foreach e [lsort [readdir $root]] { + set ldup [llength [set lem [wokUtils:FILES:FileToList $root/$e]]] + if { $lem != {} } { + if { $ldup == 1 } { + $hlist add $e -itemtype imagetext -text $e \ + -image $filima \ + -data [list HEADER [list $ldup $lem]] + } else { + $hlist add $e -itemtype imagetext -text $e -style $IWOK_WINDOWS($w,OUC,dupstyle) \ + -image $filima \ + -data [list HEADER [list $ldup $lem]] + } + $IWOK_WINDOWS($w,OUC,tree) setmode $e open + update + } else { + unlink $root/$e + } + } + tixBusy $w off + return +} + + +proc wokOUC:Tree:Open { w dir } { + global IWOK_WINDOWS + global IWOK_GLOBALS + if {[$IWOK_WINDOWS($w,OUC,hlist) info children $dir] != {}} { + foreach kid [$IWOK_WINDOWS($w,OUC,hlist) info children $dir] { + $IWOK_WINDOWS($w,OUC,hlist) show entry $kid + } + } else { + tixBusy $w on + set lem [lindex [lindex [$IWOK_WINDOWS($w,OUC,hlist) info data $dir] 1] 1] + set upd {} + foreach f $lem { + set lf [split $f] + if { [file exists [lindex $lf 2]] } { + lappend upd $f + set adr [lindex $lf 0] + $IWOK_WINDOWS($w,OUC,hlist) add ${dir}^${adr} -itemtype imagetext \ + -text [join [lrange [split $adr :] 2 3] :] \ + -image $IWOK_GLOBALS(image,[lindex $lf 1]) \ + -data [list PATH [list $adr [lindex $lf 1] [lindex $lf 2]]] + } + } + update + if { $upd != {} } { + wokUtils:FILES:ListToFile $upd $IWOK_WINDOWS($w,OUC,root)/$dir + } else { + unlink $IWOK_WINDOWS($w,OUC,root)/$dir + } + tixBusy $w off + } + return +} + +proc wokOUC:Tree:Browse { w dir } { + global IWOK_WINDOWS + + ;# parce qu'elle est aussi appelee dans le bind + if { [info exists IWOK_WINDOWS($w,OUC,v1)] && [info exists IWOK_WINDOWS($w,OUC,v2)] } { + unset IWOK_WINDOWS($w,OUC,v1) IWOK_WINDOWS($w,OUC,v2) + return + } + + set data [$IWOK_WINDOWS($w,OUC,hlist) info data $dir] + set type [lindex $data 0] + + switch -- $type { + + PATH { + set dd [lindex $data 1] + set adr [lindex $dd 0] + set typ [lindex $dd 1] + set pth [lindex $dd 2] + wokReadFile $IWOK_WINDOWS($w,OUC,text) $pth + } + + HEADER { + } + } + + return +} + +# +#;> +# Ajoute une entry pour lname { nam1 nam2 ..} a l'adresse adr +# wokOUC:Add WOK:k4dev k4dev:adnk4:WOKAPI package /adv_23/WOK/k4dev/adnk4/src/WOKAPI WOKAPI_Command.c +# Dans le cad d'une duplication update GetDupName +#;< +proc wokOUC:Add { fshop adr typ dir lname } { + set root [wokOUC:GetRootName $fshop 1] + set dupl [wokOUC:GetDupName $fshop 1] + foreach name $lname { + set entry $root/$name + if { [file exists $entry] == 1 } { + set lem [wokUtils:FILES:FileToList $entry] + set new {} + set add 1 + set nbe 0 + foreach f $lem { + set lf [split $f] + set a [lindex $lf 0] + set t [lindex $lf 1] + set p [lindex $lf 2] + if { [file exist $p] } { + lappend new $f + incr nbe + } + if { "$a" == "$adr" && "$t" == "$typ" && "$p" == "$dir"} { + set add 0 + } + } + if { $add } { + lappend new "$adr $typ $dir/$name" + } + wokUtils:FILES:ListToFile $new $entry + if { $nbe > 1 } { + wokUtils:FILES:touch $dupl/$name + } + } else { + wokUtils:FILES:ListToFile [list "$adr $typ $dir/$name"] $entry + chmod 0777 $entry + } + } + return +} +#;> +# Teste si une entry existe, la detruit sinon. +# +#;< +proc wokOUC:Exists { fshop adr typ name } { + set root [wokOUC:GetRootName $fshop] + set entry $root/$name + if { [file exists $entry] } { + set lem [wokUtils:FILES:FileToList $entry] + set new {} + set x 0 + foreach f $lem { + set lf [split $f] + set a [lindex $lf 0] + set t [lindex $lf 1] + set p [lindex $lf 2] + if [file exist $p] { + lappend new $f + } + if { "$a" == "$adr" && "$t" == "$typ" } { + set x 1 + } + } + if { $new != {} } { + wokUtils:FILES:ListToFile $new $entry + } else { + set x 0 + unlink $entry + } + return $x + } else { + return 0 + } +} +#;> +# Retourne le full path du repertoire d'administration de wsee pour un ilot donne. +# 1. Si create = 1 le cree dans le cas ou il n'existe pas. +#;< +proc wokOUC:GetRootName { fshop {create 0} } { + set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/OUC_ENTRIES + if [file exists $diradm] { + return $diradm + } else { + if { $create } { + msgprint -c WOKVC -i "Creating file $diradm" + mkdir -path $diradm + chmod 0777 $diradm + return $diradm + } else { + return {} + } + } +} +proc wokOUC:GetDupName { fshop {create 0} } { + set diradm [wokparam -e %VC_ROOT $fshop]/adm/[wokinfo -n [wokinfo -s $fshop]]/OUC_DUP + if [file exists $diradm] { + return $diradm + } else { + if { $create } { + msgprint -c WOKVC -i "Creating file $diradm" + mkdir -path $diradm + chmod 0777 $diradm + return $diradm + } else { + return {} + } + } +} + +#;> +# remplit root avec le contenu de fshop sauf le workbench appele ref. +# prevoir de faire mv root ->root-sav et d'ecrire dans root neuve. +#;< +proc wokOUC:Make { fshop {wr ref} } { + set wr ref + set root [wokOUC:GetRootName $fshop 1] + foreach adr [wokFind $fshop] { + if {"[wokinfo -t $adr]" == "devunit" } { + if { "[wokinfo -n [wokinfo -w $adr]]" != "$wr" } { + set typ [uinfo -t $adr] + set dir [wokinfo -p source:. ${adr}] + set lname {} + foreach f [glob -nocomplain $dir/*] { + if { "[set n [wokOUC:Valid $f]]" != {} } { + lappend lname $n + } + } + puts "Creer les entries de $adr avec:" + ;#puts "lname = $lname" + wokOUC:Add $fshop $adr $typ $dir $lname + } + } + } + return +} + +proc wokOUC:Clean { fshop {type entries} } { + switch -- $type { + entries { + set root [wokOUC:GetRootName $fshop] + foreach f [glob -nocomplain $root/*] { + if [catch { unlink $f } status] { + puts "Clean: $status" + } + } + } + + dup { + set duproot [wokOUC:GetDupName $fshop] + foreach f [glob -nocomplain $duproot/*] { + if [catch { unlink $f } status] { + puts "Clean: $status" + } + } + } + } + return +} + +proc wokOUC:Dump { fshop {type entries} } { + switch -- $type { + + entries { + set root [wokOUC:GetRootName $fshop] + foreach f [glob -nocomplain $root/*] { + puts $f + } + } + + dup { + set duproot [wokOUC:GetDupName $fshop] + foreach f [glob -nocomplain $duproot/*] { + puts $f + } + } + } + return +} + +proc wokOUC:Valid { p } { + if { ![file isdirectory $p] } { + set e [file extension [set n [file tail $p]]] + if { ![string match {*~} $n] } { + if { ![string match {*~} $e] } { + if { ![string match {#*#} $n] } { + if { ![string match {*-sav} $e] } { + return $n + } else { + return {} + } + } else { + return {} + } + } else { + return {} + } + } else { + return {} + } + } else { + return {} + } + + +} + + + + + +#;> +# Pour la commande +#;< +proc wokOUC:Tree:Print { w } { + global IWOK_WINDOWS + global IWOK_GLOBALS + set fshop $IWOK_WINDOWS($w,OUC,shop) + set root $IWOK_WINDOWS($w,OUC,root) + set hlist $IWOK_WINDOWS($w,OUC,hlist) + set filima [tix getimage textfile] + foreach e [lsort [readdir $root]] { + set lem [wokUtils:FILES:FileToList $root/$e] + if { $lem != {} } { + $hlist add $e -itemtype imagetext -text $e \ + -image $filima \ + -data [list HEADER {}] + set upd {} + foreach f $lem { + set lf [split $f] + if { [file exists [lindex $lf 2]] } { + lappend upd $f + set adr [lindex $lf 0] + $hlist add ${e}^${adr} -itemtype imagetext \ + -text [join [lrange [split $adr :] 1 2] :] \ + -image $IWOK_GLOBALS(image,[lindex $lf 1]) \ + -data [list PATH [list $adr lindex $lf 2]] + } + } + update + if { $upd != {} } { + wokUtils:FILES:ListToFile $upd $root/$e + } else { + unlink $root/$e + } + } else { + unlink $root/$e + } + } + return +} diff --git a/src/WOKTclLib/wokPRM.hlp b/src/WOKTclLib/wokPRM.hlp new file mode 100755 index 0000000..1baf7c0 --- /dev/null +++ b/src/WOKTclLib/wokPRM.hlp @@ -0,0 +1,41 @@ +This window allows consultation of all the parameters in the current session. It contains three +options: + + + : Displays all the classes of parameters. + Open the item and click on the parameter name to get the value. + + If you do not know the precise class name, use the automatic completion in the field "Class Name" + with the space bar. Operate similarly for the parameter name. + + In any case, if more than one completion is possible, the right window indicates all the possible + completions. Double-click to select the name. + + + : Displays the directories used in the search for .edl files when evaluating a parameter. + The number in parentheses preceding the directory name indicates the order in which the + directories are scanned during parameter evaluation. + + + : Modifies a parameter. + + 1. Enter the name of the parameter in the field "Parameter Name" (if the parameter already + exists, use the space bar for automatic completion). + + 2. To modify a given value, enter a new value in the field "Current value". + To add a value to the existing one, enter this value in the field "Append". + + 3. Choose the scope where the modifications are performed (possible scopes are the development + units, the current workbench, the current workshop and the current factory). + + 3. Choose the DBMS/platforms on which the modifications are performed. By default, the current + DBMS and workstation are selected. + + 4. displays the generated EDL file. This file may be edited in the window where it is + displayed. + + 5. writes the result into the given file. + + 6. writes the result at the end of the given file. + + 7. cancels the modification. diff --git a/src/WOKTclLib/wokPROP.tcl b/src/WOKTclLib/wokPROP.tcl new file mode 100755 index 0000000..c019c3d --- /dev/null +++ b/src/WOKTclLib/wokPROP.tcl @@ -0,0 +1,1058 @@ +;# (((((((((((((((((( P R O P E R T I E S )))))))))))))))))))) +;# +;# +proc wokProperties {dir location itype } { + global IWOK_GLOBALS + + set w [wokTPL prop$location] + if [winfo exists $w ] { + destroy $w + } + + toplevel $w + wm title $w "Properties of ($location)" + wm geometry $w 684x439 + + wokButton setw [list properties $w] + + set boldfnt [tix option get bold_font] + set IWOK_GLOBALS($w,PROP,toplevel) $w + set IWOK_GLOBALS($w,PROP,location) $location + + + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m + $w.file.m add command -label "Close " -underline 0 -command [list wokPROP:Kill $w] + + set notes [tixNoteBook $w.notes -ipadx 1 -ipady 1] + tixForm $w.file + tixForm $notes -top $w.file -left 2 -right %99 -bottom %99 + + $notes.nbframe configure -backpagecolor grey51 + + if [wokinfo -x $location] { + set type [wokinfo -t $location] + set name [wokinfo -n $location] + } else { + regsub {trig_} $itype "" type + } + + ;#bind $w { if [winfo exists %W] {wokPROP:Kill %W} } + + switch $type { + + session { + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:vrs $w $notes pag1" \ + -label "WOK Version" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:NOT wokPROP:pkg $w $notes pag2" \ + -label "Packages used" -raisecmd [list wokPROP:UPD $w] + $notes add pag3 -createcmd "wokPROP:NOT wokPROP:env $w $notes pag3" \ + -label "Environment" -raisecmd [list wokPROP:UPD $w] + $notes add pag4 -createcmd "wokPROP:NOT wokPROP:pth $w $notes pag4" \ + -label "Pathes" -raisecmd [list wokPROP:UPD $w] + ;#$notes add pag5 -createcmd "wokPROP:NOT wokPROP:EDF $w $notes pag5 $location" \ + ;# -label "Editor" -raisecmd [list wokPROP:UPD $w] + $notes add pag6 -createcmd "wokPROP:NOT wokPROP:EDL $w $notes pag6 $location" \ + -label "Edl" -raisecmd [list wokPROP:UPD $w] + } + + factory { + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:factory $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:NOT wokPROP:EDL $w $notes pag2 $location" \ + -label "Edl" -raisecmd [list wokPROP:UPD $w] + } + + warehouse { + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:warehouse $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:NOT wokPROP:EDL $w $notes pag2 $location" \ + -label "Edl" -raisecmd [list wokPROP:UPD $w] + } + + parcel { + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:parcel $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:NOT wokPROP:parcelExtRef $w $notes pag2 $location" \ + -label "External References" -raisecmd [list wokPROP:UPD $w] + } + + workshop { + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:workshop $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:NOT wokPROP:workshopconfig $w $notes pag2 $location" \ + -label "Parcel Configuration" -raisecmd [list wokPROP:UPD $w] + $notes add pag3 -createcmd "wokPROP:NOT wokPROP:workbenchtree $w $notes pag3 $location" \ + -label "Workbench Tree" -raisecmd [list wokPROP:UPD $w] + $notes add pag4 -createcmd "wokPROP:NOT wokPROP:EDL $w $notes pag4 $location" \ + -label "Edl" -raisecmd [list wokPROP:UPD $w] + } + + workbench { + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:workbench $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:NOT wokPROP:workbenchtk $w $notes pag2 $location" \ + -label "Toolkits" -raisecmd [list wokPROP:UPD $w] + $notes add pag3 -createcmd "wokPROP:NOT wokPROP:EDL $w $notes pag3 $location" \ + -label "Edl" -raisecmd [list wokPROP:UPD $w] + } + + devunit { + $notes add pag1 -createcmd "wokPROP:devunit $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + $notes add pag2 -createcmd "wokPROP:arb $w $notes pag2 $name $location" \ + -label "Suppliers" -raisecmd [list wokPROP:UPD $w] + $notes add pag3 -createcmd "wokPROP:clt $w $notes pag3 $name $location" \ + -label "Clients" -raisecmd [list wokPROP:UPD $w] + $notes add pag4 -createcmd "wokPROP:NOT wokPROP:BLD $w $notes pag4 $location" \ + -label "Building steps" -raisecmd [list wokPROP:UPD $w] + $notes add pag5 -createcmd "wokPROP:NOT wokPROP:EDL $w $notes pag5 $location" \ + -label "Edl" -raisecmd [list wokPROP:UPD $w] + } + + terminal { + set data [wokNAV:tlist:TermData $IWOK_GLOBALS(toplevel) $dir] + set name [lindex $data end] + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:terminal $w $notes pag1 $name" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + } + + Repository { + set data [wokNAV:tlist:TermData $IWOK_GLOBALS(toplevel) $dir] + ;# data = WOK:k4dev:Repository trig_Repository Repository image37 wokGetworkbenchdate {params} + regsub {:Repository} [lindex $data 0] "" fshop + + } + + Queue { + set data [wokNAV:tlist:TermData $IWOK_GLOBALS(toplevel) $dir] + ;# data = WOK:k4dev:Queue trig_Queue Queue image37 wokGetworkbenchdate {params} + regsub {:Queue} [lindex $data 0] "" location + $notes add pag1 -createcmd "wokPROP:NOT wokPROP:Queue $w $notes pag1 $location" \ + -label "General" -raisecmd [list wokPROP:UPD $w] + } + + } + return +} +;# +;# ((((((( F I L E I N T E G R A T I O N ))))))) +;# +proc wokPROP:Queue { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set qdir [wokStore:Report:GetRootName $location] + if { $qdir != {} } { + set text [text $w.top.jnl -relief flat -font $IWOK_GLOBALS(font)] + $text insert end "Queue in directory: $qdir\n\n" + set journal [wokIntegre:Journal:GetName $location] + if { $journal != {} } { + set dir [file dirname $journal] + $text insert end "Journal in directory: $dir\n\n" + foreach j [wokIntegre:Journal:List $location] { + $text insert end "[format "%15s %-9d" [file tail $j] [file size $j]]\n" + } + set t [fmtclock [file mtime $journal]] + set str [format "%15s %-8d(Last modified %s)" [file tail $journal] [file size $journal] $t] + $text insert end "$str\n\n" + set scoop [wokIntegre:Scoop:Read $location] + if { $scoop != {} } { + $text insert end "Last integration: \n\n $scoop " + } + $text configure -state disabled + tixForm $text -top 2 -left 2 -bottom %99 -right %99 + } + } + return +} +;# +;# ((((((( A R B R E D E P E N D A N C E S ))))))) +;# +proc wokPROP:arb { adr nb page name location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief sunken -bd 1 + button $w.but -text "Click here to run" -command [list DependenceTree $w.top.tree $name $location] + label $w.lab + eval "proc wokPROP:LabArb {} { return $w.lab }" + tixForm $w.but -top 2 + tixForm $w.top -top $w.but -left 2 -right %99 -bottom $w.lab + tixForm $w.lab -left 2 -right %99 -bottom %99 + return +} + +;# +;# ((((((( A R B R E C L I E N T S ))))))) +;# +proc wokPROP:clt { adr nb page name location} { + global IWOK_GLOBALS ClientTree_FileName + set w [$nb subwidget $page] + + frame $w.top -relief sunken -bd 1 + button $w.but -text "Click here to run" -command [list ClientTree $w.top.treeclt $name $location $w.meter] + label $w.lab + tixMeter $w.meter -value 0. -relief flat + $w.meter config -value 0 -text " " + tixLabelEntry $w.filename -label "Header Name :" -options {entry.width 20 label.width 0 entry.textVariable ClientTree_FileName} + eval "proc wokPROP:LabClt {} { return $w.lab }" + tixForm $w.but -top 2 + tixForm $w.meter -top 4 -left $w.but -right %99 + tixForm $w.filename -top $w.but -left 2 -right %99 + tixForm $w.top -left 2 -right %99 -bottom $w.lab -top $w.filename + tixForm $w.lab -left 2 -right %99 -bottom %99 + + return +} + +proc wokPROP:Meter {meter maxrange progress} { + set can [$meter subwidget canvas] + set width [expr [winfo width $can] + 2] + $meter configure -width $width + + set step [expr {100.0 / $maxrange}] + set progress [expr {$progress + $step }] + set value [expr $progress * 0.01] + set text [expr int($progress)]% + + $meter config -value $value -text $text + + return $progress +} + +proc wokPROP:BrowseArb { location item } { + if { "[info procs wokPROP:LabArb]" != "" } { + set lab [wokPROP:LabArb] + set ud [lindex [split $item .] end] + set lud [woklocate -u $ud $location] + if { $lud != {} } { + set type [uinfo -t $lud] + $lab configure -text "Location: $lud ( $type )" + } else { + $lab configure -text "" + } + } + return +} +;# +;# ((((((( P A C K A G E S U T I L I S E S ))))))) +;# +proc wokPROP:vrs { adr nb page location} { + global IWOK_GLOBALS + global env + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + foreach name [lsort [array names env WOK*]] { + lappend lm [list $name $env($name)] + } + set vrs [file tail $env(WOKHOME)] + ;#set image [tix getimage wok] + label $w.top.ima ;#-image $image + label $w.top.vrs -font $IWOK_GLOBALS(boldfont) -text "Used: $vrs" + set txt [text $w.top.msg -relief flat -font $IWOK_GLOBALS(font)] + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.vrs -top [list $w.top.ima 10] + tixForm $w.top.msg -top [list $w.top.vrs 20] -left 2 + return +} + +proc wokPROP:pkg { adr nb page args} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + foreach name [lsort [package names]] { + lappend lm [list $name [package version $name]] + } + tixScrolledText $w.top.msg + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.msg -left 1 -top 1 -right %100 -bottom %100 + return +} +;# +;# ((((((( P A T H E S ))))))) +;# +proc wokPROP:pth { adr nb page args } { + + global env + global IWOK_GLOBALS + + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + + tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50 + pack $w.top.pane -side top -expand yes -fill both -padx 1 -pady 1 + + set p1 [$w.top.pane add tree -min 100 -size 220] + set p2 [$w.top.pane add text] + + set tree [tixTree $p1.tree] + set text [tixScrolledText $p2.text] + + pack $p1.tree -expand yes -fill both -padx 1 -pady 1 + pack $p2.text -expand yes -fill both -padx 1 -pady 1 -padx 3 + + + set hlist [$tree subwidget hlist] + $hlist config -indicator 1 -selectmode single -separator "^" -drawbranch 0 + set lab [$text subwidget text] + $lab configure -font $IWOK_GLOBALS(font) -relief flat + set pthima [tix getimage path] + set dirima [tix getimage folder] + set filima [tix getimage textfile] + set boldstyle [tixDisplayStyle imagetext -fg #000080 -font $IWOK_GLOBALS(boldfont)] + $tree config -opencmd [list wokPROP:pth:Open $dirima $filima $tree $hlist ] \ + -browsecmd [list wokPROP:pth:Browse $lab $dirima $filima $tree $hlist ] + $hlist add ^ + foreach P [lsort [array names env *PATH*]] { + $hlist add ^${P} -itemtype imagetext -style $boldstyle -text ${P} -image $pthima -data [list PATH $env($P)] + $tree setmode ^${P} open + } + return +} + +proc wokPROP:pth:Open { dirima filima tree hlist dir } { + if {[set children [$hlist info children $dir]] != {}} { + foreach kid $children { + $hlist show entry $kid + } + } else { + set type [lindex [set data [$hlist info data $dir]] 0] + switch -- $type { + PATH { + set PT [lindex $data 1] + if { [string match *:* $PT] != 0 } { + set lpp [split $PT :] + } else { + set lpp [split $PT ] + } + set i 1 + foreach cc $lpp { + if { $cc != {} } { + if {[string match *^* $cc] == 0 } { + $hlist add ${dir}^${cc} -itemtype imagetext -image $dirima \ + -text [format "#%-2s %s" $i ${cc}] -data [list PTHDIR $cc] + $tree setmode ${dir}^${cc} open + incr i + } + } + } + } + + PTHDIR { + set pdir [lindex $data 1] + if ![catch { set lfdir [readdir [glob -nocomplain $pdir]] }] { + foreach f [lsort $lfdir] { + if ![file isdirectory $pdir/$f] { + if {[string match *^* ${f}] == 0 } { + $hlist add ${dir}^${f} -itemtype imagetext -image $filima \ + -text $f -data [list TERMINAL $pdir/$f] + } + } else { + if {[string match *^* ${f}] == 0 } { + $hlist add ${dir}^${f} -itemtype imagetext -image $filima \ + -text $f -data [list PTHDIR $pdir/$f] + $tree setmode ${dir}^${f} open + } + } + } + } + } + + } + } + return +} + + +proc wokPROP:pth:Browse { lab dirima filima tree hlist dir } { + set type [lindex [set data [$hlist info data $dir]] 0] + if { "$type" == "TERMINAL" } { + set location [lindex $data 1] + if [file exists $location] { + catch { unset tt } + file lstat $location tt + if [file writable $location] { + set wrt yes + } else { + set wrt no + } + set exe no; if [file executable $location] { set exe yes } + set rea no; if [file readable $location] { set rea yes } + set lm [list \ + [list separator 1] \ + [list Location $location] \ + [list separator 1] \ + [list Size "$tt(size) (bytes)"]\ + [list Type $tt(type)]\ + [list separator 1]\ + [list Created [string range [fmtclock $tt(ctime)] 4 18]]\ + [list Modified [string range [fmtclock $tt(mtime)] 4 18]]\ + [list Accessed [string range [fmtclock $tt(atime)] 4 18]]\ + [list separator 1]\ + [list Readable $rea]\ + [list Writable $wrt]\ + [list Executable $exe]\ + ] + wokPROP:Nice $lab $lm + } + } + return +} +;# +;# ((((((( T A B L E A U E N V ))))))) +;# +proc wokPROP:env { adr nb page args} { + global IWOK_GLOBALS + global env + set w [$nb subwidget $page] + frame $w.top -relief sunken -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + tixScrolledText $w.top.text ; set text [$w.top.text subwidget text] + $text config -font $IWOK_GLOBALS(font) -relief flat + button $w.top.sea -text "Search" -command [list wokSEA $text] + tixForm $w.top.sea -top 0 -left 1 + tixForm $w.top.text -top $w.top.sea -left 1 -right %99 -bottom %99 + set maxl 0 + foreach name [array names env] { + lappend lpack $name + if {[string length $name] > $maxl} { + set maxl [string length $name] + } + } + set maxl [expr {$maxl + 1}] + foreach name [lsort [array names env]] { + $text insert end [format "%-*s = %s" $maxl $name $env($name)]\n + update + } + $text see 1.0 + return +} + +proc wokPROP:EDF { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + return +} + +proc wokPROP:EDL { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + + set p1 $w.top + set p2 $w.top + + set tree [tixTree $p1.tree] + frame $p1.fram -relief flat -bd 1 + set btn [button $p1.fram.load -text "Contents" -width 6 -command wokPROP:EDL:see -state disabled] + pack $btn -expand yes -fill both -padx 8 -pady 70 + set labatt [text $p2.text] + + tixForm $p1.tree -left 1 -top 1 -right %80 -bottom %50 + tixForm $p1.fram -left $p1.tree -top 10 -right %99 -bottom $p2.text + + tixForm $p2.text -left 2 -right %99 -bottom %99 -top $p1.tree + + $labatt configure -relief flat -font $IWOK_GLOBALS(font) + set filima [tix getimage textfile] + set pthima [tix getimage path] + set hlist [$tree subwidget hlist] + $hlist config -indicator 1 -selectmode single -separator "^" -drawbranch 1 + set boldstyle [tixDisplayStyle imagetext -fg #000080 -font $IWOK_GLOBALS(boldfont)] + set boldsimple [tixDisplayStyle imagetext -font $IWOK_GLOBALS(boldfont)] + $tree config -opencmd [list wokPROP:EDL:Open $btn $boldstyle $filima $labatt $tree $hlist] \ + -browsecmd [list wokPROP:EDL:Browse $btn $labatt $tree $hlist] + set nb 0 + foreach P [wokparam -L $location] { + if { $nb == 0 } { + $hlist add ${P} -itemtype imagetext -image $pthima -style $boldstyle -text ${P} \ + -data [list PATH $P] + } else { + $hlist add ${P} -itemtype imagetext -image $pthima -style $boldsimple -text ${P} \ + -data [list PATH $P] + } + incr nb + $tree setmode ${P} open + } + + return +} + +proc wokPROP:EDL:Open { btn boldstyle filima att tree hlist dir } { + $btn configure -state disabled + if {[set children [$hlist info children $dir]] != {}} { + foreach kid $children { + $hlist show entry $kid + } + } else { + set data [$hlist info data $dir] + set pdir [lindex $data 1] + foreach f [lsort [glob -nocomplain $pdir/*.edl]] { + set name [file tail $f] + if { [string match *_DEFAULT.edl $name] } { + $hlist add ${dir}^${f} -itemtype imagetext -image $filima -style $boldstyle \ + -text $name -data [list TERMINAL $f] + } else { + $hlist add ${dir}^${f} -itemtype imagetext -image $filima \ + -text $name -data [list TERMINAL $f] + } + } + } + return +} + +proc wokPROP:EDL:Browse { btn att tree hlist dir } { + set type [lindex [set data [$hlist info data $dir]] 0] + if { "$type" == "TERMINAL" } { + set location [lindex $data 1] + if [file exists $location] { + catch { unset tt } + file lstat $location tt + if [file writable $location] { + set wrt yes + } else { + set wrt no + } + set rea no; if [file readable $location] { set rea yes } + set lm [list \ + [list separator 1] \ + [list Location $location] \ + [list separator 1] \ + [list Size "$tt(size) (bytes)"]\ + [list Type $tt(type)]\ + [list separator 1]\ + [list Created [string range [fmtclock $tt(ctime)] 4 18]]\ + [list Modified [string range [fmtclock $tt(mtime)] 4 18]]\ + [list Accessed [string range [fmtclock $tt(atime)] 4 18]]\ + [list separator 1]\ + [list Readable $rea]\ + [list Writable $wrt]\ + ] + wokPROP:Nice $att $lm + $btn configure -state active + eval "proc wokPROP:EDL:see {} {wokEDF:EditFile $location}" + } + } + return +} +;# +;# ((((((( F A C T O R Y ))))))) +;# +proc wokPROP:factory { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + foreach tp [wokinfo -T $location] { + if { ![string match {*%File} [wokinfo -d $tp $location]] } { + lappend lm [list $tp [wokinfo -p $tp $location]] + } + } + label $w.top.ima + set img [image create compound -window $w.top.ima] + $img add image -image [tix getimage factory] ; $img add text -text " factory" + $w.top.ima config -image $img + + tixScrolledText $w.top.msg -scrollbar y + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 + return +} +;# +;# ((((((( W A R E H O U S E ))))))) +;# +proc wokPROP:warehouse { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + foreach tp [wokinfo -T $location] { + lappend lm [list $tp [wokinfo -p ${tp}:. $location]] + } + + label $w.top.ima + set img [image create compound -window $w.top.ima] + $img add image -image [tix getimage warehouse] ; $img add text -text " warehouse" + $w.top.ima config -image $img + + tixScrolledText $w.top.msg -scrollbar y + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 + return +} + +proc wokPROP:parcel { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + foreach tp [wokinfo -T $location] { + lappend lm [list $tp [wokinfo -p ${tp}:. $location]] + } + + label $w.top.ima + set img [image create compound -window $w.top.ima] + $img add image -image [tix getimage parcel] ; $img add text -text " parcel" + $w.top.ima config -image $img + + tixScrolledText $w.top.msg -scrollbar y + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 + return +} + +proc wokPROP:parcelExtRef { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + + tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50 + pack $w.top.pane -side top -expand yes -fill both -padx 1 -pady 1 + set p1 [$w.top.pane add tree -min 100 -size 240] + set p2 [$w.top.pane add text] + + set tree [tixTree $p1.tree] + set text [text $p2.text] + + pack $p1.tree -expand yes -fill both -padx 1 -pady 1 + pack $p2.text -expand yes -fill both -padx 1 -pady 1 -padx 3 + + set labatt $text + $labatt configure -relief flat -font $IWOK_GLOBALS(font) + + set hlist [$tree subwidget hlist] + $hlist config -indicator 1 -selectmode single -separator "^" -drawbranch 1 + set boldstyle [tixDisplayStyle imagetext -fg #000080 -font $IWOK_GLOBALS(boldfont)] + + $tree config -opencmd [list wokPROP:parcelExtRef:Open $labatt $tree $hlist] \ + -browsecmd [list wokPROP:parcelExtRef:Browse $labatt $tree $hlist] + + foreach unit [pinfo -a $location] { + set type [lindex $unit 0] + set name [lindex $unit 1] + set full ${location}:${name} + set path [lindex [lindex [uinfo -Fpl -TEXTERNLIB $full] 0] end] + if { "$path" != {} } { + $hlist add ${name} -itemtype imagetext -style $boldstyle -text ${name} \ + -image $IWOK_GLOBALS(image,$type) -data [list PATH $path $full] + $tree setmode ${name} open + } + } + return +} + +proc wokPROP:parcelExtRef:Open { att tree hlist dir } { + if {[set children [$hlist info children $dir]] != {}} { + foreach kid $children { + $hlist show entry $kid + } + } else { + set data [$hlist info data $dir] + set ext [wokUtils:FILES:FileToList [lindex $data 1]] + foreach p $ext { + $hlist add ${dir}^${p} -itemtype imagetext -text $p -data [list EDLSTRING $p [lindex $data 2]] + } + } + return +} +proc wokPROP:parcelExtRef:Browse { att tree hlist dir } { + global IWOK_GLOBALS + set type [lindex [set data [$hlist info data $dir]] 0] + switch -- $type { + EDLSTRING { + set edlstring [lindex $data 1] + + set adr [lindex $data 2] ; set val {} ; catch {set val [wokparam -e %${edlstring} $adr] } ; + set v1 "Value in $adr : \n $val" + set ici [wokcd] ; set wal {} ; catch {set wal [wokparam -e %${edlstring} $ici] } + set v2 "Value in $ici : \n $wal" + wokReadList $att [list $v1 {} {} $v2] + } + } + return +} +;# +;# ((((((( W O R K S H O P ))))))) +;# +proc wokPROP:workshop { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + + foreach tp [wokinfo -T $location] { + lappend lm [list $tp [wokinfo -p ${tp}:. $location]] + } + label $w.top.ima + set img [image create compound -window $w.top.ima] + $img add image -image [tix getimage workshop] ; $img add text -text " workshop" + $w.top.ima config -image $img + + tixScrolledText $w.top.msg -scrollbar y + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 + return +} +proc wokPROP:workshopconfig { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set fact [wokinfo -N $location] + + tixScrolledText $w.top.used ; set tused [$w.top.used subwidget text] + tixScrolledText $w.top.avai ; set tavai [$w.top.avai subwidget text] + + label $w.top.image + set img [image create compound -window $w.top.image] + $img add image -image [tix getimage parcel] ; $img add text -text " Parcels" + $w.top.image config -image $img + + label $w.top.iused -text "Used:" ; label $w.top.iavai -text "Available:" + + tixForm $w.top.image -top 8 -left 6 + tixForm $w.top.iused -top [list $w.top.image 20] -left 6 + tixForm $w.top.iavai -top [list $w.top.image 20] -left [list $w.top.iused 240] + tixForm $w.top.used -left 2 -top $w.top.iused -bottom %99 -right %50 + tixForm $w.top.avai -left $w.top.used -top $w.top.iused -bottom %99 -right %99 + + wokReadList $tused [sinfo -p $location] + wokReadList $tavai [lsort [Winfo -p $fact:[finfo -W $fact]]] + + $tused config -state disabled + $tavai config -state disabled + + update + return +} +;# +;# ((((((( W O R K B E N C H ))))))) +;# +proc wokPROP:workbench { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + + foreach tp [wokinfo -T $location] { + lappend lm [list $tp [wokinfo -p ${tp}:. $location]] + } + label $w.top.ima + set img [image create compound -window $w.top.ima] + $img add image -image [tix getimage workbench] ; $img add text -text " workbench" + $w.top.ima config -image $img + + tixScrolledText $w.top.msg -scrollbar y + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 + return +} + + +proc wokPROP:workbenchtree { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + set image [tix getimage workbench] + frame $w.top -relief sunken -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set tree [tixTree $w.top.tree -options {hlist.separator "^" hlist.selectMode single }] + set hli [$tree subwidget hlist] + set father [wokWbtree:LoadSons $location [wokinfo -p WorkbenchListFile $location]] + $hli add ^ + update + button $w.top.but -text "Click here to run" \ + -command [list wokWbtree:Tree $tree $hli "" $father $image] + tixForm $w.top.but -top 2 + tixForm $tree -top $w.top.but -left 2 -right %99 -bottom %99 + return +} + +proc wokPROP:workbenchtk { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + + tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50 + pack $w.top.pane -side top -expand yes -fill both -padx 1 -pady 1 + set p1 [$w.top.pane add tree -min 100 -size 160] + set p2 [$w.top.pane add text] + + set tree [tixTree $p1.tree] + set text [text $p2.text] + + pack $p1.tree -expand yes -fill both -padx 1 -pady 1 + pack $p2.text -expand yes -fill both -padx 1 -pady 1 -padx 3 + + set labatt $text + $labatt configure -relief flat -font $IWOK_GLOBALS(font) + + set hlist [$tree subwidget hlist] + $hlist config -indicator 1 -selectmode single -separator "^" -drawbranch 1 + set boldstyle [tixDisplayStyle imagetext -fg #000080 -font $IWOK_GLOBALS(boldfont)] + $tree config -opencmd [list wokPROP:workbenchtk:Open $labatt $tree $hlist] \ + -browsecmd [list wokPROP:workbenchtk:Browse $labatt $tree $hlist] + + foreach P [w_info -k $location] { + set packages [woklocate -p ${P}:PACKAGES] + $hlist add ${P} -itemtype imagetext -style $boldstyle -text ${P} \ + -image $IWOK_GLOBALS(image,toolkit) -data [list TOOLKIT $P $packages] + $tree setmode ${P} open + } + + return +} + +proc wokPROP:workbenchtk:Open { att tree hlist dir } { + if {[set children [$hlist info children $dir]] != {}} { + foreach kid $children { + $hlist show entry $kid + } + } else { + set packages [wokUtils:FILES:FileToList [lindex [$hlist info data $dir] end]] + foreach p $packages { + $hlist add ${dir}^${p} -itemtype imagetext -text $p -data [list PACKAGES $p] + } + } + return +} +proc wokPROP:workbenchtk:Browse { att tree hlist dir } { + global IWOK_GLOBALS + set type [lindex [set data [$hlist info data $dir]] 0] + switch -- $type { + TOOLKIT { + set P [lindex $data 1] + set U [woklocate -u $P] + if { "$U" != "" } { + set t [uinfo -t $U] + set location [wokinfo -p library:lib${P}.so $U] + if [file exists $location] { + catch { unset tt } + file lstat $location tt + set lm [list \ + [list $t $U] \ + [list separator 1]\ + [list File [file tail $location]] \ + [list Location [file dirname $location]] \ + [list separator 1] \ + [list Size "$tt(size) (bytes)"]\ + [list separator 1]\ + [list Created [string range [fmtclock $tt(ctime)] 4 18]]\ + [list Modified [string range [fmtclock $tt(mtime)] 4 18]]\ + [list separator 1]\ + ] + wokPROP:Nice $att $lm + } + } + } + + PACKAGES { + set p [lindex $data 1] + set u [woklocate -u $p] + if { "$u" != "" } { + set t [uinfo -t $u] + set location [wokinfo -p library:lib${p}.so $u] + if [file exists $location] { + catch { unset tt } + file lstat $location tt + set lm [list \ + [list $t $u] \ + [list separator 1]\ + [list File [file tail $location]] \ + [list Location [file dirname $location]] \ + [list separator 1] \ + [list Size "$tt(size) (bytes)"]\ + [list separator 1]\ + [list Created [string range [fmtclock $tt(ctime)] 4 18]]\ + [list Modified [string range [fmtclock $tt(mtime)] 4 18]]\ + [list separator 1]\ + ] + wokPROP:Nice $att $lm + } + } + } + } + return +} +;# +;# ((((((( D E V U N I T ))))))) +;# +proc wokPROP:devunit { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + set lm {} + + foreach tp [lsort [wokinfo -T $location]] { + set itm [wokinfo -p ${tp}:. $location] + if { [file exists $itm] } { + lappend lm [list $tp $itm] + } + } + set type [uinfo -t $location] + label $w.top.ima + set img [image create compound -window $w.top.ima] + $img add image -image $IWOK_GLOBALS(image,$type) ; $img add text -text " $type" + $w.top.ima config -image $img + + tixScrolledText $w.top.msg -scrollbar y + set txt [$w.top.msg subwidget text] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 -right %99 -bottom %99 + return +} + +proc wokPROP:BLD { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + + text $w.top.txt -fg #000080 -font $IWOK_GLOBALS(boldfont) -relief flat + foreach string [umake -S $location] { + $w.top.txt insert end $string\n + } + tixForm $w.top.txt -top 0 -left %24 -right %99 -bottom %99 + return +} +;# +;# ((((((( T E R M I N A L ))))))) +;# +proc wokPROP:terminal { adr nb page location} { + global IWOK_GLOBALS + set w [$nb subwidget $page] + frame $w.top -relief flat -bd 1 + pack $w.top -side top -expand yes -fill both -padx 1 -pady 1 + + catch { unset tt } + file lstat $location tt + + if [file writable $location] { + set wrt yes + set image [tix getimage textfile] + } else { + set wrt no + set image [tix getimage textfile_rdonly] + } + set exe no; if [file executable $location] { set exe yes } + set rea no; if [file readable $location] { set rea yes } + set lm [list \ + [list separator 1] \ + [list Location [file dirname $location]] \ + [list Name [file tail $location]] \ + [list separator 1] \ + [list Size "$tt(size) (bytes)"]\ + [list Type $tt(type)]\ + [list separator 1]\ + [list Created [string range [fmtclock $tt(ctime)] 4 18]]\ + [list Modified [string range [fmtclock $tt(mtime)] 4 18]]\ + [list Accessed [string range [fmtclock $tt(atime)] 4 18]]\ + [list separator 1]\ + [list Readable $rea]\ + [list Writable $wrt]\ + [list Executable $exe]\ + ] + + label $w.top.ima -image $image + set txt [text $w.top.msg] + $txt configure -relief flat -font $IWOK_GLOBALS(font) + wokPROP:Nice $txt $lm + tixForm $w.top.ima -top 12 -left 6 + tixForm $w.top.msg -top [list $w.top.ima 20] -left 2 + return +} +;# +;# ((((((( N O T E B O O K A D M ))))))) +;# +proc wokPROP:NOT { command adr w name args} { + tixBusy $w on + set id [after 10000 tixBusy $w off] + $command $adr $w $name $args + after cancel $id + after 0 tixBusy $w off + return +} +;# +;# +;# +proc wokPROP:Kill { w } { + + global IWOK_GLOBALS + wokButton delw [list properties $IWOK_GLOBALS($w,PROP,toplevel)] + catch { + destroy $IWOK_GLOBALS($w,PROP,toplevel) + destroy $IWOK_GLOBALS($w,PROP,help) + } + return +} +;# +;# +;# +proc wokPROP:UPD { w } { + return +} +;# +;# Retourne les Edl dans l'adm de location. Pas de test sur location +;# +proc wokPROP:GetAdmEdl { location } { + if ![catch { set pth [wokinfo -p AdmDir $location] }] { + return [lsort [glob -nocomplain $pth/*.edl]] + } else { + return {} + } +} +;# +;# +;# +proc wokPROP:Nice { text lm {state disabled} } { + set nice [wokUtils:EASY:NiceList $lm :] + $text configure -state normal + $text delete 0.0 end + foreach string [split $nice \n] { + $text insert end $string\n + } + $text see 1.0 + update + $text configure -state $state + return +} + + + diff --git a/src/WOKTclLib/wokPrepareHelp.hlp b/src/WOKTclLib/wokPrepareHelp.hlp new file mode 100755 index 0000000..841b124 --- /dev/null +++ b/src/WOKTclLib/wokPrepareHelp.hlp @@ -0,0 +1,84 @@ + + This window may be activated if the current workbench is the direct child of the reference + workbench. + It can be used to create an integration report which you can send into the integration queue. + + + Two lists are displayed: + the left list contains the UDs of your workbench, the right list contains the selected UDs. + The selection is performed vith the and buttons, as well as with . + In addition can be used to select only one type of UD. + + + Buttons: + + : selects all the UDs in the left list. + + : deselects all the UDs from the right list. + + : compares all the selected UDs (wprepare). The result is sent to the list + displayed below the buttons. The files may be marked differently: + # the file is different, diff is displayed on the right of the list. + = the file is contained in your workbench but has not been modified. + - the file is no longer contained in the UD in your workbench. + + the file is displayed in the list cotaining the UD files of your workbench. + + + Use to select a file, and the arrows to move up and down the list. (see Exclude) + + : removes the item from the report. If a UD is selected, the UD is removed. + + This may also be done via or . This operation is faster since the diffs + are not displayed for each concerned element. + + : removes all the files marked "=" (those which have not been modified) from the + report. + + : removes the unmodified files contained in your workbench. A dialog box is + displayed to confirm the deletion. This button may be used n your workbench. + A dialog box is displayed to confirm the deletion. This button may be used after + integration when the whole development has been transferred to the reference + workbench. + + : sends the file to an editor. The editor is either: + - emacs where you have created a *woksh* buffer, + - an editor defined by the environment variable EDITOR, + - the default editor provided with IWOK in all other cases. + + : this button is activated if the "xdiff" command is contained in your path. + The comparison of the files is then performed with this program. + + : allows input of comments associated with the integration. + + : writes the contents of the report onto the file ~/[user].[workbench].report, but + does not include it into the integration queue. This allows edition of the + report with an editor. + + : performs the save operation and sends the result into the integration + queue (wstore). + + The following buttons are only activated if the report being created contains one element or + more already in the integration queue. In this case, their names are displayed in orange in the + left list. + + : only displays elements of the report contained in the queue. + + : redisplays the whole list. + + To perform the diff between the file copy and the copy of the integration queue, select the file + in the left list and push . To merge the files, retrieve the file in the integration + queue with the button. + The resulting file is named "" and is found in the src directory of the concerned UD. + + + Menu: + + + + Ends the wprepare session. + + + + Checks that the files in the selected UDs can be set in the repository. + This check-up may be performed before preparing a report which will be later used with the + wintegre -ref command. diff --git a/src/WOKTclLib/wokRPR.tcl b/src/WOKTclLib/wokRPR.tcl new file mode 100755 index 0000000..acc5ffc --- /dev/null +++ b/src/WOKTclLib/wokRPR.tcl @@ -0,0 +1,731 @@ +proc wokUpdateRepository { {loc {}} } { + global IWOK_GLOBALS + global IWOK_WINDOWS + + if { $loc == {} } { + set verrue [wokCWD readnocell] + } else { + regexp {(.*):Repository} $loc all verrue + } + + if ![wokinfo -x $verrue] { + wokDialBox .wokcd {Unknown location} "Location $verrue is unknown" {} -1 OK + return + } + set fact [wokinfo -f $verrue] + set shop [wokinfo -s $verrue] + set type [wokIntegre:BASE:InitFunc $shop] + + set w [wokTPL rpr${verrue}] + if [winfo exists $w ] { + wm deiconify $w + raise $w + return + } + + toplevel $w + wm title $w "Repository of $shop ." + wm geometry $w 1124x658+135+92 + wokButton setw [list Rpr_close $w] + ;#bind $w { if [winfo exists %W] {wokRPRExit %W}} + + tixBusy $w on + update + + menubutton $w.file -menu $w.file.m -text File -underline 0 -takefocus 0 + menu $w.file.m ; $w.file.m add command -label "Close " -underline 1 -command [list wokRPRExit $w] + + menubutton $w.help -menu $w.help.m -text Help -underline 0 -takefocus 0 + menu $w.help.m + $w.help.m add command -label "Help" -underline 1 -command [list wokRPRHelp $w] + + menubutton $w.tools -menu $w.tools.m -text Tools -underline 0 -takefocus 0 + menu $w.tools.m + $w.tools.m add command -label "Check out" -state disabled -command [list wokRPRCheckout $w] + $w.tools.m add command -label "To editor" -state disabled -command [list wokRPREditor $w] + $w.tools.m add command -label "More Diff" -state disabled -command [list wokRPRxdiff $w] + $w.tools.m add command -label "Search" -state disabled -command [list wokRPRSearch $w] + + menubutton $w.marks -menu $w.marks.m -text Marks -underline 0 -takefocus 0 + menu $w.marks.m + $w.marks.m add checkbutton -label "Display" -variable IWOK_WINDOWS($w,markdisplay) + + menubutton $w.admin -menu $w.admin.m -text Admin -underline 0 -takefocus 0 + menu $w.admin.m + $w.admin.m add command -label "Show params" -underline 0 -command [list wokRPRShowVersions $w] + $w.admin.m add command -label "Check contents" -underline 0 -command [list wokRPRCheckItem $w] + $w.admin.m add command -label "Delete element" -underline 0 -command [list wokRPRDeleteItem $w] + + frame $w.top -relief sunken -bd 1 + label $w.lab -relief raised + + tixPanedWindow $w.top.pane -orient horizontal -paneborderwidth 0 -separatorbg gray50 + pack $w.top.pane -side top -expand yes -fill both -padx 1 -pady 1 + + set p0 [$w.top.pane add tree -min 70 -size 240] + set p1 [$w.top.pane add scrw -min 60 -size 180] + set p2 [$w.top.pane add text -min 70] + + set tree [tixTree $p0.tree -options {separator "^" hlist.selectMode single }] + $tree config \ + -command "wokRPRBrowse $w $tree run" \ + -browsecmd "wokRPRBrowse $w $tree browse" \ + -opencmd "wokFillUnit $w $tree" + + tixScrolledWindow $p1.scrw + set windo [$p1.scrw subwidget window] + canvas $windo.c + set canva $windo.c + + tixScrolledText $p2.text + set texte [$p2.text subwidget text] + $texte config -font $IWOK_GLOBALS(font) + + pack $p0.tree -expand yes -fill both -padx 1 -pady 1 + pack $p1.scrw -expand yes -fill both -padx 1 -pady 1 + pack $p2.text -expand yes -fill both -padx 1 -pady 1 + + tixForm $w.file ; tixForm $w.help -right -2 + tixForm $w.tools -left $w.file + tixForm $w.marks -left $w.tools + tixForm $w.admin -left $w.marks + tixForm $w.top -top $w.file -left 1 -right %99 -bottom $w.lab + tixForm $w.lab -left 1 -right %99 -bottom %99 + + set IWOK_WINDOWS($w,menu) $w.file.m + set IWOK_WINDOWS($w,tools) $w.tools.m + set IWOK_WINDOWS($w,admin) $w.admin.m + set IWOK_WINDOWS($w,label) $w.lab + set IWOK_WINDOWS($w,tree) $tree + set IWOK_WINDOWS($w,hlist) [set hlist [$tree subwidget hlist]] + set IWOK_WINDOWS($w,text) $texte + set IWOK_WINDOWS($w,canvas) $canva + set IWOK_WINDOWS($w,fact) $fact + set IWOK_WINDOWS($w,shop) $shop + set IWOK_WINDOWS($w,journal) [wokIntegre:Journal:GetName $IWOK_WINDOWS($w,shop)] + set IWOK_WINDOWS($w,qroot) [wokIntegre:BASE:GetRootName $IWOK_WINDOWS($w,shop)] + set IWOK_WINDOWS($w,data) {} + + + catch { + wokIntegre:Mark:NiceDump $IWOK_WINDOWS($w,journal) tt + wokUtils:EASY:MAD IWOK_WINDOWS $w,mark tt + set IWOK_WINDOWS($w,lmark) [array exists tt] + } + + set IWOK_WINDOWS($w,markdisplay) 0 + + set IWOK_GLOBALS(repository,popup) [tixPopupMenu $w.p -title "Select" ] + $w.p subwidget menubutton configure -font $IWOK_GLOBALS(font) + set IWOK_GLOBALS(repository,popup,menu) [$IWOK_GLOBALS(repository,popup) subwidget menu] + $IWOK_GLOBALS(repository,popup,menu) configure -font $IWOK_GLOBALS(font) + + set LB [wokIntegre:BASE:LS $IWOK_WINDOWS($w,shop)] + set V [wokIntegre:Version:Get $IWOK_WINDOWS($w,shop)] + set R $IWOK_WINDOWS($w,qroot) + + foreach d $LB { + set B [lindex $d 0] + set T [lindex $d 1] + $hlist add ${B}${T} -itemtype imagetext -text $B \ + -image $IWOK_GLOBALS(image,[string index $T 1]) \ + -data [list $R $B $T $V] + $tree setmode ${B}${T} open + } + + + set lewb {} + set llitm [linsert $IWOK_GLOBALS(ucreate-P) 0 [list All All..]] + if { "[wokinfo -t $verrue]" == "workbench" } { + set llitm [linsert $llitm 0 [list You Yours..]] + set lewb [w_info -l $verrue] + } + + foreach t $llitm { + $IWOK_GLOBALS(repository,popup,menu) add command -label [lindex $t 1]\ + -command [list wokRprFilterdevunit $tree $hlist [lindex $t 0] $LB $V $R $lewb] + } + $IWOK_GLOBALS(repository,popup) bind $hlist + tixBusy $w off + return +} +# +# met list dans hlist en filtrant avec t, V version et R root +# +proc wokRprFilterdevunit { tree hlist t list V R lewb} { + global IWOK_GLOBALS + $hlist delete all + if { "$t" != "You" } { + foreach d $list { + set B [lindex $d 0] + set T [lindex $d 1] + if { "$t" != "All" } { + set ext [lindex $d 1] + if { "$ext" == ".$t" } { + $hlist add ${B}${T} -itemtype imagetext -text $B \ + -image $IWOK_GLOBALS(image,[string index $T 1]) -data [list $R $B $T $V] + $tree setmode ${B}${T} open + } + } else { + $hlist add ${B}${T} -itemtype imagetext -text $B \ + -image $IWOK_GLOBALS(image,[string index $T 1]) -data [list $R $B $T $V] + $tree setmode ${B}${T} open + } + } + } else { + foreach d $list { + set B [lindex $d 0] + if { [lsearch $lewb $B] != -1 } { + set T [lindex $d 1] + $hlist add ${B}${T} -itemtype imagetext -text $B \ + -image $IWOK_GLOBALS(image,[string index $T 1]) -data [list $R $B $T $V] + $tree setmode ${B}${T} open + } + } + } + return +} +# +# appelee a l'ouverture d'un item: Le remplit s'il est vide et montre les fils +# +proc wokFillUnit { w tree ent } { + global IWOK_GLOBALS + global IWOK_WINDOWS + set hlist [$tree subwidget hlist] + if {[$hlist info children $ent] == {}} { + set data [$hlist info data $ent] ;# R B T V + set R $IWOK_WINDOWS($w,qroot) + ;#set R [lindex $data 0] + set B [lindex $data 1] + set T [lindex $data 2] + set V [lindex $data 3] + set dir $R/${B}${T} + set LSF [wokIntegre:BASE:List $IWOK_WINDOWS($w,shop) $B $V] + set txtima [tix getimage textfile] + foreach s $LSF { + set sfile $dir/[wokIntegre:BASE:ftos $s $V] + $hlist add ${B}${T}^${s} -itemtype imagetext -text $s -image $txtima -data $sfile + } + } + foreach kid [$hlist info children $ent] { + $hlist show entry $kid + } + return +} + +# +# appelee quand on brouze la liste. +# +proc wokRPRBrowse { w slb action args } { + global IWOK_WINDOWS + + set hlist [$slb subwidget hlist] + set ent [$hlist info anchor] + + if {$ent == ""} { + return + } + + set kid [$hlist info children $ent] + if {$kid != {} } { + ;#puts "HEADER" + ;# un Unit header pour l'instant rien a faire + return + } else { + ;# un fils donc un sfile peut aussi etre /home/wb/kl/KERNEL/SCCS/SCCS/s.BASES DBT .p {} + set sfile [$hlist info data $ent] + if { $sfile == "" || [llength $sfile] != 1 } { + return + } + } + + case $action { + "run" { + ;#double clique + } + + "browse" { + wokSetCanv $w + } + } + return +} + +proc wokRPRShowVersions { w } { + global IWOK_WINDOWS + + $IWOK_WINDOWS($w,text) delete 1.0 end + + set msg "Versions and workshops:" ; $IWOK_WINDOWS($w,text) insert end $msg\n + set msg "_______________________" ; $IWOK_WINDOWS($w,text) insert end $msg\n + $IWOK_WINDOWS($w,text) insert end \n + foreach e [wokIntegre:Version:Dump $IWOK_WINDOWS($w,shop)] { + set msg " [lindex $e 1] : [lindex $e 0]" + $IWOK_WINDOWS($w,text) insert end $msg\n + } + $IWOK_WINDOWS($w,text) insert end \n + set msg "Repository location:"; $IWOK_WINDOWS($w,text) insert end $msg\n + set msg "____________________" ; $IWOK_WINDOWS($w,text) insert end $msg\n + $IWOK_WINDOWS($w,text) insert end \n + set msg " [wokIntegre:BASE:GetRootName $IWOK_WINDOWS($w,shop)]" ; + $IWOK_WINDOWS($w,text) insert end $msg\n + $IWOK_WINDOWS($w,text) insert end \n + set msg "Administration directory:"; $IWOK_WINDOWS($w,text) insert end $msg\n + set msg "_________________________" ; $IWOK_WINDOWS($w,text) insert end $msg\n + $IWOK_WINDOWS($w,text) insert end \n + set msg " [file dirname [wokIntegre:Version:GetTableName $IWOK_WINDOWS($w,shop)]]" ; + $IWOK_WINDOWS($w,text) insert end $msg\n + $IWOK_WINDOWS($w,text) insert end \n + set msg "EDL file used for parameters:"; $IWOK_WINDOWS($w,text) insert end $msg\n + set msg "_____________________________" ; $IWOK_WINDOWS($w,text) insert end $msg\n + $IWOK_WINDOWS($w,text) insert end \n + set msg " [lindex [wokparam -F VC $IWOK_WINDOWS($w,shop)] 0]" ; + $IWOK_WINDOWS($w,text) insert end $msg\n + return +} + +;# +;# Affiche un historique en X Y +;# +proc wokUpdateHist1 { w infile XIN YIN } { + global IWOK_WINDOWS + set Canv $IWOK_WINDOWS($w,canvas) + + catch { unset FILS } + set root [wokIntegre:BASE:tree $infile FILS] + $Canv delete all + + set X $XIN + set Y $YIN + set mx 0 + set my 0 + set t 28 + + set lastitl {} + set IWOK_WINDOWS($w,vlabels) {} + lappend IWOK_WINDOWS($w,vlabels) [list 1 [expr $XIN +20 ] [expr $YIN + 10 ]] + while 1 { + set dat [lindex $root 0] + set lab [lindex $dat 0] + set nxt [lindex $root 1] + set cmt [lindex $dat 1] + + wokArtVrs + set lastitl $curitl + if ![info exists FILS($nxt)] { break } + set root [lindex $FILS($nxt) 0] + + } + lappend IWOK_WINDOWS($w,vlabels) [list 9999 9999 9999] + set IWOK_WINDOWS($w,vlablen) [expr [llength $IWOK_WINDOWS($w,vlabels)] - 1 ] + + if {$IWOK_WINDOWS($w,markdisplay) == 1} { + if { [wokCheckLabels $IWOK_WINDOWS($w,vlabels)] == 0 } { + wokDialBox .badnews {Bad news} \ + "Incoherent archive file format. Unable to place marks for this file" {} -1 OK + } else { + if { $IWOK_WINDOWS($w,lmark) == 1 } { + foreach xn [array names IWOK_WINDOWS $w,mark,*] { + set xrk [split $IWOK_WINDOWS($xn) ,] + set maxt [wokArtMark $w [lindex [split $xn ,] 2] [lindex $xrk 0] [lindex $xrk 1] ] + if { $maxt > $mx } { + set mx $maxt + } + } + } + } + } + $Canv configure -width $mx -height $my + pack $Canv + update + return +} +;# +;# verifie que list est croissante/ 1 er element. list { {a b c} {a b c }.. } Contient au moins 2 elements. +;# +proc wokCheckLabels { list } { + set ll [llength $list] + for {set i 0} {$i < $ll } {incr i 1} { + set n1 [lindex $list $i] + set n2 [lindex $list [expr $i + 1 ]] + if { $n1 != {} && $n2 != {} } { + if { [lindex $n1 0] > [lindex $n2 0] } { + return 0 + } + } + } + return 1 +} +;# +;# dessine mrk. remonte mx my pour config du canvas +;# +proc wokArtMark { w txt mrk dat} { + global IWOK_WINDOWS + set c $IWOK_WINDOWS($w,canvas) + for {set i 0} {$i < $IWOK_WINDOWS($w,vlablen)} {incr i 1} { + ;#puts "i = $i ip1 = [expr $i+1]" + set binf [lindex $IWOK_WINDOWS($w,vlabels) $i] + set bsup [lindex [lindex $IWOK_WINDOWS($w,vlabels) [expr $i+1]] 0] + ;#puts "binf = $binf bsup = $bsup" + if { [lindex $binf 0] <= $mrk && $mrk < $bsup } { + set b1 [lindex $binf 1] + set b2 [lindex $binf 2] + set ttx [$c create text $b1 $b2 -text $txt -anchor w -tag [list MRK $txt $mrk $dat]] + set bbl [$IWOK_WINDOWS($w,canvas) bbox $ttx] + set x2 [lindex $bbl 2] + $c create rectangle [lindex $bbl 0] [lindex $bbl 1] $x2 [lindex $bbl 3] -fill yellow + $c raise $ttx + set hhx [expr $x2 + 10] + set IWOK_WINDOWS($w,vlabels) \ + [lreplace $IWOK_WINDOWS($w,vlabels) $i $i [list [lindex $binf 0] $hhx [lindex $binf 2]]] + return $hhx + } + } +} +;# +;# evaluee dans wokUpdateHist1 +;# +proc wokArtVrs { } { + uplevel { + regexp {([0-9]*)\..*} $lab all bn + set col black + set itx [$Canv create text $X $Y -text $lab -fill $col -tag [list LAB $lab] -anchor n] + $Canv bind $itx {catch {%W configure -cursor {hand2 red white}}} + set lxy [$Canv bbox $itx] + set x1 [lindex $lxy 0]; set y1 [lindex $lxy 1] ; set x2 [lindex $lxy 2]; set y2 [lindex $lxy 3] + set itr [$Canv create rectangle $x1 $y1 $x2 $y2 -fill grey -tag [list RECT R${lab}]] + $Canv raise $itx + set midx [expr $x1 + ($x2-$x1)/2] + set curitl [$Canv create line $midx $y2 $midx [expr $y2 +$t] -arrow last] + if { $lastitl != {} } { + $Canv itemconfigure $lastitl -tag [list CMT $cmt] + set nbr [lindex [wokIntegre:Journal:UnMark $cmt] 1] + set nbr [lindex [split $nbr _] 0] ;# pour les vieux comments de DPE + lappend IWOK_WINDOWS($w,vlabels) [list $nbr [expr $midx + 20 ] [expr $y1 + ($y2-$y1)/2]] + } + set lastitl $curitl + set Y [expr $y2 + $t] + set mx $x2 + set my $y2 + } +} +;# +;# Configure le label, canvas et le texte pour l'item selectionne +;# +proc wokSetCanv { w } { + global IWOK_WINDOWS + global IWOK_GLOBALS + + set sfile [wokRPRGetSfile $w] ;# variable dans les bind + if { $sfile == {} } { + return + } + + set canv $IWOK_WINDOWS($w,canvas) ;# + set text $IWOK_WINDOWS($w,text) ;# constant par rapport a w + set lab $IWOK_WINDOWS($w,label) ;# + + $IWOK_WINDOWS($w,tools) entryconfigure 1 -state active + $IWOK_WINDOWS($w,tools) entryconfigure 2 -state active + $IWOK_WINDOWS($w,tools) entryconfigure 4 -state active + + $canv delete all + catch {unset v1 v2} + wokUpdateHist1 $w $sfile 14 20 + $text delete 0.0 end + wokReadString $text [wokIntegre:BASE:cat $sfile last] + set vrs [wokIntegre:BASE:vrs $sfile] + set dta [fmtclock [file mtime $sfile] "%d %h %y %R" ] + set item [wokIntegre:BASE:stof [file tail $sfile] {}] + set fmt [format "FILE: %--30s Version: %--10s Last registered: %--15s" $item $vrs $dta] + $lab configure -text $fmt -font $IWOK_GLOBALS(font) + set IWOK_WINDOWS($w,data) $vrs + bind $canv { + set w [winfo toplevel %W] + set info [%W gettags current] + set nat [lindex $info 0] + if {[string compare $nat LAB] == 0} { + set vrs [lindex $info 1] + foreach e [%W find all] { + set lt [%W gettags $e] + if {[lsearch $lt RECT] != -1} { + %W itemconfigure $e -outline black -width 1 + if {[lsearch $lt R${vrs}]!= -1} { + %W itemconfigure $e -outline red -width 2 + } + } + } + set ts [wokRPRGetSfile $w] + $IWOK_WINDOWS($w,label) configure -text "File [wokIntegre:BASE:stof $ts {} ] ($vrs)" + wokReadString $IWOK_WINDOWS($w,text) [wokIntegre:BASE:cat $ts $vrs] + set IWOK_WINDOWS($w,data) $vrs + } + + if {[string compare $nat CMT] == 0} { + tixBusy $w on + update + set _x [wokIntegre:Journal:UnMark [lindex $info 1]] + set _j [wokIntegre:Journal:GetSlice [set _n [lindex $_x 1]] $IWOK_WINDOWS($w,shop) ] + + wokReadList $IWOK_WINDOWS($w,text) \ + [wokIntegre:Journal:PickMultReport $_j ${_n} ${_n}] + wokFAM $IWOK_WINDOWS($w,text) {^-- } { $IWOK_WINDOWS($w,text) tag add big first last } + $IWOK_WINDOWS($w,text) tag configure big -background orange -foreground black -borderwidth 2 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-* -relief raised + $IWOK_WINDOWS($w,text) see end + $IWOK_WINDOWS($w,label) configure -text [$IWOK_WINDOWS($w,text) get 1.0 1.end] + catch { unset _x _n _j} + tixBusy $w off + } + + if {[string compare $nat MRK] == 0} { + wokReadList $IWOK_WINDOWS($w,text) \ + [wokIntegre:Mark:GetComment $IWOK_WINDOWS($w,journal) [lindex $info 1]] + $IWOK_WINDOWS($w,label) configure \ + -text "Mark to integration [lindex $info 2]. Placed on [fmtclock [lindex $info 3]]" + } + + } + + bind $canv { + set w [winfo toplevel %W] + set info [%W gettags current] + if ![info exists v1] { + set v1 [lindex $info 1] + foreach e [%W find all] { + set lt [%W gettags $e] + if {[lsearch $lt RECT] != -1} { + %W itemconfigure $e -outline black -width 1 + if {[lsearch $lt R${v1}]!= -1} { + %W itemconfigure $e -outline red -width 2 + } + } + } + + } else { + if ![info exists v2] { + set v2 [lindex $info 1] + foreach e [%W find all] { + if {[lsearch [%W gettags $e] R${v2}]!= -1} { + %W itemconfigure $e -outline red -width 2 + } + } + set ts [wokRPRGetSfile $w] + wokReadString $IWOK_WINDOWS($w,text) [wokIntegre:BASE:diff $ts $v1 $v2] + $IWOK_WINDOWS($w,label) configure -text "Differences ($v1) <=> ($v2)" + if [wokUtils:EASY:INPATH xdiff] { + $IWOK_WINDOWS($w,tools) entryconfigure 3 -state active + set IWOK_WINDOWS($w,data) [list $ts $v1 $v2] + } + } + unset v1 v2 + } + } + return +} +;# +;# Widget +;# + +;# +;# recupere le sfile en cours +;# +proc wokRPRGetSfile { w } { + global IWOK_WINDOWS + set hlist $IWOK_WINDOWS($w,hlist) + catch { set anchor [$hlist info anchor] } + if { $anchor != {} } { + set sfile [$hlist info data $anchor] + if [file exists $sfile] { + return $sfile + } + } + return {} +} +;# +;# Sort un fichier de la base dans le repertoire courant +;# +proc wokRPRCheckout { w } { + global IWOK_WINDOWS + set sfile [wokRPRGetSfile $w] + set vrs $IWOK_WINDOWS($w,data) + if ![ file exists $sfile ] { + return + } + set wf [pwd]/$vrs,[wokIntegre:BASE:stof [file tail $sfile] {}] + if ![catch { wokUtils:FILES:ListToFile [split [wokIntegre:BASE:cat $sfile $vrs] \n] $wf } status] { + $IWOK_WINDOWS($w,label) configure -text "File $wf has been created" + } else { + wokDialBox .nowrite {Cannot write file} $status {} -1 OK + } + return +} +;# +;# +;# +proc wokRPRSearch { w } { + global IWOK_WINDOWS + wokSEA $IWOK_WINDOWS($w,text) + return +} +;# +;# +;# +proc wokRPREditor { w } { + global IWOK_WINDOWS + set sfile [wokRPRGetSfile $w] + if [file exists $sfile] { + set f [wokIntegre:BASE:stof [file tail $sfile] {}] + set vrs $IWOK_WINDOWS($w,data) + set file "/tmp/$vrs,${f}" + wokUtils:FILES:ListToFile [split [wokIntegre:BASE:cat $sfile $vrs] \n] $file + wokEDF:EditFile $file + } + return +} + +proc wokRPRxdiff { w } { + global IWOK_WINDOWS + set ts [lindex $IWOK_WINDOWS($w,data) 0] + set f [wokIntegre:BASE:stof [file tail [lindex $IWOK_WINDOWS($w,data) 0]] {}] + set v1 [lindex $IWOK_WINDOWS($w,data) 1] + set v2 [lindex $IWOK_WINDOWS($w,data) 2] + set f1 "/tmp/$v1,$f" + set f2 "/tmp/$v2,$f" + wokUtils:FILES:ListToFile [split [wokIntegre:BASE:cat $ts $v1] \n] $f1 + wokUtils:FILES:ListToFile [split [wokIntegre:BASE:cat $ts $v2] \n] $f2 + catch {exec xdiff $f1 $f2 &} + return +} + + + +proc wokRPRDeleteItem { w } { + global IWOK_WINDOWS + set hlist $IWOK_WINDOWS($w,hlist) + + set len [llength [set lstent [split [set entry [$hlist info anchor]] ^]]] + + if { $len == 0 } { + return + } elseif { $len == 1 } { + set unit [lindex $lstent 0] + tixBusy $w on + wokIntegre:BASE:Delete $IWOK_WINDOWS($w,shop) $unit + tixBusy $w off + } elseif { $len > 1 } { + set unit [lindex $lstent 0] + 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] } + } + $hlist delete entry $entry + $IWOK_WINDOWS($w,canvas) delete all + $IWOK_WINDOWS($w,text) delete 1.0 end + return +} +proc wokRPRCheckItem { w } { + global IWOK_WINDOWS + set hlist $IWOK_WINDOWS($w,hlist) + + set len [llength [set lstent [split [set entry [$hlist info anchor]] ^]]] + + if { $len == 0 } { + return + } elseif { $len == 1 } { + set unit [lindex $lstent 0] + tixBusy $w on + update + $IWOK_WINDOWS($w,text) delete 0.0 end + set dir $IWOK_WINDOWS($w,qroot)/$unit + set lst {} + catch { set lst [readdir $dir] } + foreach sfile [lsort $lst] { + if [wokIntegre:BASE:IsElm $sfile] { + set stat [wokIntegre:BASE:check $dir/$sfile] + if { $stat != {} } { + $IWOK_WINDOWS($w,text) insert end "$stat \n" + } else { + $IWOK_WINDOWS($w,text) insert end "File OK: $dir/$sfile \n" + } + } + $IWOK_WINDOWS($w,text) see end + update + } + tixBusy $w off + } elseif { $len > 1 } { + set unit [lindex $lstent 0] + set item [lindex $lstent 1] + set data [$hlist info data [$hlist info parent $entry]] + set vrs [lindex $data 2] + $IWOK_WINDOWS($w,canvas) delete all + set sfile $IWOK_WINDOWS($w,qroot)/$unit/[wokIntegre:BASE:ftos $item $vrs] + set stat [wokIntegre:BASE:check $sfile] + if { $stat != {} } { + wokReadString $IWOK_WINDOWS($w,text) "$stat" + } else { + wokReadString $IWOK_WINDOWS($w,text) "File OK: $sfile" + } + } + return +} + +proc wokRPRExit { w } { + global IWOK_WINDOWS + destroy $w + foreach f [glob -nocomplain /tmp/jnltmp[id process].*] { + catch { unlink $f } + } + if [info exists IWOK_WINDOWS($w,help)] { + catch {destroy $IWOK_WINDOWS($w,help)} + } + wokButton delw [list Rpr_close $w] + return +} + + +proc wokPrepareCheckWithRPR { w } { + global IWOK_WINDOWS + $IWOK_WINDOWS($w,hlist) delete all + $IWOK_WINDOWS($w,text) delete 1.0 end + msgsetcmd wokMessageInText $IWOK_WINDOWS($w,text) + tixBusy $w on + update + foreach item [$IWOK_WINDOWS($w,hlist2) info children] { + set ud $IWOK_WINDOWS($w,shop):$IWOK_WINDOWS($w,WBFils):[lindex $item 1] + set root [wokIntegre:BASE:GetRootName]/[lindex $item 1].[uinfo -c ${ud}] + wcheck -diff [uinfo -plTsource $ud] -dir $root + } + tixBusy $w off + msgunsetcmd + return +} + + + +;# +;# Help du repository +;# +proc wokRPRHelp { w } { + global IWOK_GLOBALS + global IWOK_WINDOWS + global env + + set IWOK_WINDOWS($w,help) [set wh .wokRPRHelp] + if {[info exist IWOK_GLOBALS(windows)]} { + if {[lsearch $IWOK_GLOBALS(windows) $wh ] == -1} { + lappend IWOK_GLOBALS(windows) $wh + } + } + + set whelp [wokHelp $wh "About sources repository"] + set texte [lindex $whelp 0] ; set label [lindex $whelp 1] + wokReadFile $texte $env(WOK_LIBRARY)/wokRPRHelp.hlp + wokFAM $texte <.*> { $texte tag add big first last } + $texte tag configure big -background Bisque3 -foreground black -borderwidth 2 \ + -font -Adobe-Helvetica-Medium-R-Normal--*-120-* -relief raised + update + $texte configure -state disabled + return +} diff --git a/src/WOKTclLib/wokRPRHelp.hlp b/src/WOKTclLib/wokRPRHelp.hlp new file mode 100755 index 0000000..d67324d --- /dev/null +++ b/src/WOKTclLib/wokRPRHelp.hlp @@ -0,0 +1,42 @@ + + Consulting the source repository: + + For each selected item in the left list, all the recorded versions are displayed. + + Select a given version with to display the associated contents and activate the + following options in the Tools menu: + + generates a copy of the selected version in the current directory. + This version is named x.y,file.ext where x.y is the selected version and file.ext the name of + the source. + + sends this copy to an editor. + + Select the arrow between two consecutive versions with to display the integration report + containing information on the version upgrade. + + Select 2 different versions with to display the differences between both versions. + + If the xdiff programm is contained in your path, the Tools menu activates the following option: + + displays the differences. + + + The Admin menu displays the following submenus: + + + + Displays the location where to find the bases as well as the VC.edl file used for + parameterization. + + + + Checks the contents of the item selected in the left list. In the case of a UD, all the files in + the UD are checked. + + + + Deletes the item selected in the left list. In the case of a file, the file is deleted; in the + case of a UD, the UD is removed from the repository. + + diff --git a/src/WOKTclLib/wokSEA.tcl b/src/WOKTclLib/wokSEA.tcl new file mode 100755 index 0000000..5a6ce00 --- /dev/null +++ b/src/WOKTclLib/wokSEA.tcl @@ -0,0 +1,137 @@ +;# +;# Cree une boite de recherche pour le text text. +;# +proc wokSEA { text } { + global IWOK_WINDOWS + set wt $text.wokstringsearch ;# automatikli destroyed with parent !! + catch { destroy $wt } + toplevel $wt ; wm title $wt "Search" ; wm iconname $wt "Search" + + set wask [frame $wt.ask] + label $wask.noma ; label $wask.lab -text "Search : " + entry $wask.ent -textvar IWOK_WINDOWS($wt,string) -relief sunken + tixForm $wask.noma -top 4 -left 4 + tixForm $wask.lab -top [list $wask.noma 2] -left 4 + tixForm $wask.ent -left $wask.lab -top $wask.noma + + set wsens [frame $wt.sens] + radiobutton $wsens.fwd -text "Forward" -var IWOK_WINDOWS($wt,sens) \ + -relief flat -val 1 -command [list wokSEA:InitCur $wt] + radiobutton $wsens.bwd -text "Backward" -var IWOK_WINDOWS($wt,sens) \ + -relief flat -val 0 -command [list wokSEA:InitCur $wt] + checkbutton $wsens.reg -text "Regexp" -var IWOK_WINDOWS($wt,regexp) -relief flat + checkbutton $wsens.cas -text "Case " -var IWOK_WINDOWS($wt,case) -relief flat + + tixForm $wsens.cas -top 0 -left 0 + tixForm $wsens.bwd -left $wsens.cas + + tixForm $wsens.reg -top $wsens.cas -left 0 + tixForm $wsens.fwd -left $wsens.reg -top $wsens.bwd + + set wbut [frame $wt.but] + button $wbut.next -text Next -width 6 -command [list wokSEA:GO $wt] + button $wbut.canc -text Cancel -width 6 -command [list wokSEA:Exit $wt $text] + pack $wbut.next $wbut.canc -side top -pady 0 -anchor w + + tixForm $wask -top 0 -left 0 -right %80 + tixForm $wsens -top $wask -left 0 -right %80 + tixForm $wbut -left $wask -top 4 -right %99 + + set IWOK_WINDOWS($wt,noma) $wask.noma + set IWOK_WINDOWS($wt,text) $text + set IWOK_WINDOWS($wt,sens) 1 + wokSEA:InitCur $wt + + bind $wask.ent { wokSEA:GO [winfo toplevel %W] } + bind $wask.ent { wokSEA:CLR [winfo toplevel %W] } + + return +} +proc wokSEA:CLR { wt } { + global IWOK_WINDOWS + $IWOK_WINDOWS($wt,noma) configure -text "" +} + +proc wokSEA:Exit { w text } { + global IWOK_WINDOWS + $text tag remove search 0.0 end + foreach v [array names IWOK_WINDOWS $w,*] { + unset IWOK_WINDOWS($v) + } + if { [winfo exists $w] } { + destroy $w + } + return +} + +proc wokSEA:InitCur { wt } { + global IWOK_WINDOWS + if { [ info exists IWOK_WINDOWS($wt,lastmatch)] } { + set IWOK_WINDOWS($wt,cur) $IWOK_WINDOWS($wt,lastmatch) + } else { + if { $IWOK_WINDOWS($wt,sens) == 1 } { + set IWOK_WINDOWS($wt,cur) 1.0 + } else { + set IWOK_WINDOWS($wt,cur) end + } + } + return +} + +proc wokSEA:GO { wt } { + global IWOK_WINDOWS + set string $IWOK_WINDOWS($wt,string) + if { $string == "" } { return } + set text $IWOK_WINDOWS($wt,text) + set mode -exact + if { $IWOK_WINDOWS($wt,regexp) == 1 } { set mode -regexp } + set case -nocase + if { $IWOK_WINDOWS($wt,case) == 1 } { set case "" } + set sens -backward + if { $IWOK_WINDOWS($wt,sens) == 1 } { set sens -forward } + set ncur [eval $text search $mode $case $sens -count len -- $string $IWOK_WINDOWS($wt,cur)] + if {$ncur != "" } { + $IWOK_WINDOWS($wt,noma) configure -text "" + $text tag remove search 0.0 end + $text tag add search $ncur "$ncur + $len char" + $text see $ncur + $text tag configure search -relief raised -background white -foreground black -borderwidth 2 + if { $IWOK_WINDOWS($wt,sens) == 1 } { + set IWOK_WINDOWS($wt,cur) [$text index "$ncur + $len char"] + } else { + set IWOK_WINDOWS($wt,cur) [$text index "$ncur - $len char"] + } + set IWOK_WINDOWS($wt,lastmatch) $ncur + } else { + $IWOK_WINDOWS($wt,noma) configure -text "nomatch" + wokSEA:InitCur $wt + } + return +} +;#------------------------------------------ +proc wokSEA:testme { w } { + toplevel $w + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.dismiss -text Dismiss -command "destroy $w" + button $w.buttons.code -text "Search" + pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \ + -height 10 + scrollbar $w.scroll -command "$w.text yview" + pack $w.scroll -side right -fill y + pack $w.text -expand yes -fill both + $w.text insert 0.0 \ + {This window is a text widget. It displays one or more lines of text + and allows you to edit the text. Here is a summary of the things you + can do to a text widget: + + Resize the window. This widget has been configured with the "setGrid" + option on, so that if you resize the window it will always resize to an + even number of characters high and wide. Also, if you make the window + narrow you can see that long lines automatically wrap around onto + additional lines so that all the information is always visible.} + $w.text mark set insert 0.0 + $w.buttons.code configure -command [list wokSEA $w.text] + return +} diff --git a/src/WOKTclLib/wokWaffQueueHelp.hlp b/src/WOKTclLib/wokWaffQueueHelp.hlp new file mode 100755 index 0000000..414bd7e --- /dev/null +++ b/src/WOKTclLib/wokWaffQueueHelp.hlp @@ -0,0 +1,49 @@ + Managing the integration queue: + + Click on a specific report with to select it. + + When the queue contains duplicated elements, these elements are displayed in orange. + Click on two elements with to get the difference. + + + + Integrates (wintegre) the selected report into the list of reports. + This button is only active if the current user is allowed to write into the repository and + if the report has been selected. + + + + Removes the report (wstore -rm) from the selected list. + + + + Refreshes the window containing the list of reports. + + + + Consulting the integration journal: + + + + Displays the whole contents of the integration journal. + + + + Displays the list of integrations performed in the current day. + + + + Goes to the previous day in the integration journal. + + + + Goes to he next day in the integration journal. + + + + Sends the integration journal to an editor. + + + + Saves the contents of the integration journal and creates a new empty journal. This allows the + current integration journal to be maintained to a reasonable size. diff --git a/src/WOKTclLib/wokcd.xpm b/src/WOKTclLib/wokcd.xpm new file mode 100755 index 0000000..2649aa9 --- /dev/null +++ b/src/WOKTclLib/wokcd.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * hand_right_xpm[] = { +/* width height ncolors chars_per_pixel */ +"20 22 4 1", +/* colors */ +" s None c None", +". c black", +"X c wheat", +"o c sienna", +/* pixels */ +" ", +" ", +" ", +" ", +" ...... ", +" .XXXXXX. ", +" ..XXXXXXX......... ", +"..XXXXXXo.XXXXXXXXo.", +"XXXXXX.XXXXXXoooooo.", +"XXXXX.oXXXX........ ", +"XXXXX.XXXoXXXX. ", +"X.X..oXXXXoXoo. ", +"XXoooXXXoXXXX. ", +"X.XXXXXXXoXoo. ", +"o.XXXXXoXXXX. ", +"..XXXXXXoXoo. ", +" .XXXoXXX. ", +" .XXXooo. ", +" ...... ", +" ", +" ", +" "}; diff --git a/src/WOKTclLib/wokclient.tcl b/src/WOKTclLib/wokclient.tcl new file mode 100755 index 0000000..711e2b4 --- /dev/null +++ b/src/WOKTclLib/wokclient.tcl @@ -0,0 +1,153 @@ + + +set wokclient_priv(debug) 0 +set wokclient_priv(timeout) 10000 + + +proc wokclient_read { } { + + wokclient_read_server NAME; +} + + +proc wokclient_read_server {pathName } { + + global wokclient_priv; + + set readData ""; + set wokclient_priv($pathName,result) ""; + + set fileId $pathName; + + if { [eof $fileId] } { + puts "wokclient : lost controller of $pathName" + + close $fileId + + set clidx [lsearch $wokclient_priv(clients) $pathName ] + + if { $clidx != -1 } { + if { $clidx == 0 } { + set wokclient_priv(clients) {}; + } { + set wokclient_priv(clients) [lreplace $wokclient_priv(clients) $clidx $clidx] + } + } + + if { [info exists wokclient_priv($pathName)] } {unset wokclient_priv($pathName)} + if { [info exists wokclient_priv($pathName,wait)] } {unset wokclient_priv($pathName,wait)} + if { [info exists wokclient_priv($pathName,result)] } {unset wokclient_priv($pathName,result)} + if { [info exists wokclient_priv($pathName,status)] } {unset wokclient_priv($pathName,status)} + + return; + } + + + set context [scancontext create] + + scanmatch $context "CMD: (.*)$" { + set theCmd $matchInfo(submatch0); + + if {$wokclient_priv(debug)} { + puts stdout "Received Command : $theCmd"; + } + + if {[catch "$theCmd" res]} { + puts $fileId "ERR: $res" + } { + puts $fileId "RET: $res" + } + } + + scanmatch $context "ERR: (.*)$" { + set theError $matchInfo(submatch0); + + set wokclient_priv($pathName,status) 1; + set wokclient_priv($pathName,result) $theError + set wokclient_priv($pathName,wait) 0; + + if {$wokclient_priv(debug)} { + puts stdout "Received Error : $theError"; + } + } + + scanmatch $context "RET: (.*)$" { + set theReturn $matchInfo(submatch0); + + if {$wokclient_priv(debug)} { + puts stdout "Received Return : $theReturn"; + } + lappend wokclient_priv($pathName,result) $theReturn; + } + + + scanmatch $context "END:" { + if {$wokclient_priv(debug)} { + puts stdout "Received END:" + } + set wokclient_priv($pathName,wait) 0; + return; + } + + if { ! [eof $fileId] } { + scanfile $context $fileId + return; + } { + close $fileId + return; + } +} + +proc wokclient_wait {pathName} { + + global wokclient_priv; + + if {$wokclient_priv($pathName,wait)} { + after $wokclient_priv(timeout) "set wokclient_priv($pathName,wait) 0; set wokclient_priv($pathName,result) {}" + vwait wokclient_priv($pathName,wait); + } +} + +proc wokclient_connect { {host "localhost"} {port "1563"} } { + + global wokclient_priv + + set wokclient_priv(CLIENTSOCK) [socket $host $port]; + set name $wokclient_priv(CLIENTSOCK) + + set newBody [info body wokclient_read] + regsub -all NAME $newBody $name newBody + + eval "proc wokclient_read_$name \{\} \{$newBody\}" + + fconfigure $name -blocking 0 + fconfigure $name -translation {auto lf} + fileevent $name readable wokclient_read_$name +} + +proc wokclient_send { command } { + + global wokclient_priv + + if { ! [info exist wokclient_priv(CLIENTSOCK)] } { + error "tcl is not connected to a WOK server" + return; + } + + set wokclient_priv($wokclient_priv(CLIENTSOCK),wait) 1; + set wokclient_priv($wokclient_priv(CLIENTSOCK),result) ""; + set wokclient_priv($wokclient_priv(CLIENTSOCK),status) 0; + + puts $wokclient_priv(CLIENTSOCK) "CMD: $command" + puts $wokclient_priv(CLIENTSOCK) "END:" + flush $wokclient_priv(CLIENTSOCK) + + wokclient_wait $wokclient_priv(CLIENTSOCK) + + if { $wokclient_priv($wokclient_priv(CLIENTSOCK),status) } { + error $wokclient_priv($wokclient_priv(CLIENTSOCK),result) + } { + return $wokclient_priv($wokclient_priv(CLIENTSOCK),result) + } + +} diff --git a/src/WOKTclLib/wokemacs.tcl b/src/WOKTclLib/wokemacs.tcl new file mode 100755 index 0000000..57474b3 --- /dev/null +++ b/src/WOKTclLib/wokemacs.tcl @@ -0,0 +1,315 @@ + +set wokemacs_priv(SERVERPORT) 1563 +set wokemacs_priv(lispfile) [file join $env(WOK_LIBRARY) wok-comm.el] +set wokemacs_priv(debug) 0 +set wokemacs_priv(timeout) 10000 + +if { [array names wokemacs_priv initialized] == "" } { + set wokemacs_priv(initialized) 0 +} + +set client "" + +proc wokemacs_handle {} { +} + +proc wokemacs_read { } { + + wokemacs_read_data NAME; +} + +proc wokemacs_read_data {pathName } { + + global wokemacs_priv; + + set readData ""; + set wokemacs_priv($pathName,result) ""; + + set fileId $wokemacs_priv($pathName); + + if { [eof $fileId] } { + puts "wokemacs : lost controller of $pathName" + + close $fileId + + set clidx [lsearch $wokemacs_priv(clients) $pathName ] + + if { $clidx != -1 } { + if { $clidx == 0 } { + set wokemacs_priv(clients) {}; + } { + set wokemacs_priv(clients) [lreplace $wokemacs_priv(clients) $clidx $clidx] + } + } + + if { [info exists wokemacs_priv($pathName)] } {unset wokemacs_priv($pathName)} + if { [info exists wokemacs_priv($pathName,wait)] } {unset wokemacs_priv($pathName,wait)} + if { [info exists wokemacs_priv($pathName,result)] } {unset wokemacs_priv($pathName,result)} + if { [info exists wokemacs_priv($pathName,status)] } {unset wokemacs_priv($pathName,status)} + + return; + } + + + set context [scancontext create] + + scanmatch $context "CMD: (.*)$" { + set theCmd $matchInfo(submatch0); + + if {$wokemacs_priv(debug)} { + puts stdout "Received Command : $theCmd"; + } + + if {[catch "$theCmd" res]} { + puts $fileId "ERR: $res" + } { + puts $fileId "RET: $res" + } + } + + scanmatch $context "ERR: (.*)$" { + set theError $matchInfo(submatch0); + + set wokemacs_priv($pathName,status) 1; + set wokemacs_priv($pathName,result) $theError + set wokemacs_priv($pathName,wait) 0; + + if {$wokemacs_priv(debug)} { + puts stdout "Received Error : $theError"; + } + } + + scanmatch $context "RET: (.*)$" { + set theReturn $matchInfo(submatch0); + + if {$wokemacs_priv(debug)} { + puts stdout "Received Return : $theReturn"; + } + lappend wokemacs_priv($pathName,result) $theReturn; + } + + scanmatch $context "END:" { + if {$wokemacs_priv(debug)} { + puts stdout "Sending END:" + } + puts $fileId "END:" + flush $fileId + set wokemacs_priv($pathName,wait) 0; + return; + } + + if { ! [eof $fileId] } { + scanfile $context $fileId + return; + } { + close $fileId + return; + } +} + +proc wokemacs_wait {pathName} { + + global wokemacs_priv; + + if {$wokemacs_priv($pathName,wait)} { + after $wokemacs_priv(timeout) "set wokemacs_priv($pathName,wait) 0; set wokemacs_priv($pathName,result) {}" + vwait wokemacs_priv($pathName,wait); + } +} + +proc wokemacs_send_command {pathName cmd} { + + global wokemacs_priv + + + set fileId $wokemacs_priv($pathName) + + if { [eof $fileId] } { + error "wokemacs : tried to access a closed socket" + } + + puts $fileId "CMD: $cmd" + puts $fileId "END:" + flush $fileId + + set wokemacs_priv($pathName,wait) 1; + set wokemacs_priv($pathName,result) ""; + set wokemacs_priv($pathName,status) 0; + + wokemacs_wait $pathName + + if { $wokemacs_priv($pathName,status) } { + error $wokemacs_priv($pathName,result) + } { + return $wokemacs_priv($pathName,result) + } +} + + + +proc wokemacs_accept {name address clientport} { + + global wokemacs_priv + + set newBody [info body wokemacs_read] + + + regsub -all NAME $newBody $clientport newBody + + eval "proc wokemacs_read_$name \{\} \{$newBody\}" + + if {$wokemacs_priv(debug)} { + puts stdout "Name : $name" + puts stdout "address : $address" + puts stdout "clientport : $clientport" + } + + set wokemacs_priv($clientport) $name + + fconfigure $name -blocking 0 + fconfigure $name -translation {auto lf} + fileevent $name readable wokemacs_read_$name + lappend wokemacs_priv(clients) $clientport + close $wokemacs_priv(SERVERSOCK) + return; +} + + +proc wokemacs_create_server_sock { port } { + + global wokemacs_priv + puts $port + set wokemacs_priv(SERVERPORT) $port + set wokemacs_priv(SERVERSOCK) [socket -server wokemacs_accept $port]; +} + +proc wokemacs_init { port } { + + global wokemacs_priv + + puts $port + + set wokemacs_priv(SERVERPORT) $port + set wokemacs_priv(SERVERSOCK) [socket -server wokemacs_accept $port]; + set wokemacs_priv(clients) ""; + set wokemacs_priv(initialized) 1; +} + +proc wokemacs_create {} { + + global wokemacs_priv + + if { ! $wokemacs_priv(initialized) } { + error "wokemacs is not initialized" + } + + set nbclients [llength $wokemacs_priv(clients)] + + set newCommand "emacs" + append newCommand { -rn WOKEMACS -l $wokemacs_priv(lispfile) -wokwidget WOKEMACS localhost $wokemacs_priv(SERVERPORT)} ; + + eval "exec $newCommand &" + + after $wokemacs_priv(timeout) "set wokemacs_priv(clients) $wokemacs_priv(clients);" + vwait wokemacs_priv(clients) + + if { $nbclients == [llength $wokemacs_priv(clients)] } { + error "wokemacs : new emacs could not be created" + } { + return [lindex $wokemacs_priv(clients) [expr [llength $wokemacs_priv(clients)] -1]] + } +} + + +proc wokclient_connect { {host "localhost"} {port "1563"} } { + + global wokemacs_priv + + set wokemacs_priv(CLIENTSOCK) [socket $host $port]; + set name $wokemacs_priv(CLIENTSOCK) + + set newBody [info body wokemacs_read_server_name] + regsub -all NAME $newBody $name newBody + + eval "proc wokemacs_read_$name \{\} \{$newBody\}" + + fileevent $name readable wokemacs_read_$name +} + +proc wokclient_send { command } { + + global wokemacs_priv + + if { ! [info exist wokemacs_priv(CLIENTSOCK)] } { + error "tcl is not connected to a WOK server" + return; + } + + puts $wokemacs_priv(CLIENTSOCK) "CMD: $command" + puts $wokemacs_priv(CLIENTSOCK) "END:" + flush $wokemacs_priv(CLIENTSOCK) + + wokemacs_wait $wokemacs_priv(CLIENTSOCK) + + return $wokemacs_priv($wokemacs_priv(CLIENTSOCK),result) +} + +proc wokemacs {args} { + + global wokemacs_priv; + + if { [llength $args] == 0} { + puts "usage : wokemacs \[init|create|clients...\]" + error; + } + set minorCommand [lindex $args 0] + + case $minorCommand { + + {init} { + if { $wokemacs_priv(initialized) } { + error "wokemacs is already initialized" + } + if { [llength $args] == 2 } { + puts "[lindex $args 2]"; + wokemacs_init [lindex $args 2]; + } { + wokemacs_init $wokemacs_priv(SERVERPORT); + } + } + {newserver} { + wokemacs_create_server_sock 1563 + } + {create} { + if { ! $wokemacs_priv(initialized) } { + error "wokemacs is not initialized" + } + return [wokemacs_create]; + } + {clients} { + if { ! $wokemacs_priv(initialized) } { + return {} + } + return $wokemacs_priv(clients) + } + {sendcmd} { + if { ! $wokemacs_priv(initialized) } { + error "wokemacs is not initialized" + } + if { [llength $args] != 3} { + error "missing args" + } + return [wokemacs_send_command [lindex $args 1] [lindex $args 2]] + } + {findfile} { + if { ! $wokemacs_priv(initialized) } { + error "wokemacs is not initialized" + } + if { [llength $args] != 3} { + error "missing args" + } + set thecmd "(find-file \"[lindex $args 2]\")" + return [wokemacs_send_command [lindex $args 1] $thecmd] + } + } +} diff --git a/src/WOKTclLib/wokinit.tcl b/src/WOKTclLib/wokinit.tcl new file mode 100755 index 0000000..56f01ec --- /dev/null +++ b/src/WOKTclLib/wokinit.tcl @@ -0,0 +1,14 @@ + + +auto_load wok_cd_proc +auto_load wok_exit_proc +auto_load wokemacs + +if { [info commands tcl_exit_proc] == "" } { + rename exit tcl_exit_proc + rename wok_exit_proc exit +} + + +set tcl_prompt1 {if {[info commands wokcd] != ""} then {puts -nonewline stdout "[wokcd]> "} else {puts -nonewline stdout "tclsh> "}} + diff --git a/src/WOKTclLib/wokprocs.tcl b/src/WOKTclLib/wokprocs.tcl new file mode 100755 index 0000000..ad6313f --- /dev/null +++ b/src/WOKTclLib/wokprocs.tcl @@ -0,0 +1,272 @@ + + +proc wok_cd_cmd { format dir } { + + switch $format { + csh { + return [list "cd $dir\n" ] + } + tcl { + return [list "cd $dir\n" ] + } + ksh { + return [list "cd $dir\n" ] + } + emacs { + return [list "(progn (shell-cd \"$dir\") (shell-dirstack-message))";] + } + cmd { + return [list "cd $dir\n" ] + } + default { + error "Invalid format $format" + } + } + +} + + +proc wok_exit_cmd { format } { + + switch $format { + csh { + return [list "exit\n"] + } + tcl { + return [list "exit\n"] + } + ksh { + return [list "exit\n"] + } + emacs { + return [list "(save-buffers-kill-emacs)"] + } + cmd { + return [list "exit\n"] + } + default { + error "Invalid format $format" + } + } +} + +proc wok_setenv_cmd { format var value } { + + switch $format { + csh { + return [list "setenv $var \"$value\"\n"] + } + tcl { + return [list "global env \n set env($var) \"$value\"\n"] + } + ksh { + return [list "$var=\"$value\"\nexport $var\n"] + } + sh { + return [list "$var=\"$value\"\nexport $var\n"] + } + emacs { + return [list "(setenv \"$var\" \"$value\")"] + } + cmd { + return [list "set $var=\"$value\"\n"] + } + default { + error "Invalid format $format" + } + } +} + + +proc wok_source_cmd { format file } { + + switch $format { + sh { + return [list ". $file\n"] + } + csh { + return [list "source $file\n"] + } + tcl { + return [list "source $file\n"] + } + ksh { + return [list ". $file\n"] + } + emacs { + return [list "(load-file \"$file\")"] + } + cmd { + return [list "call $file\n"] + } + default { + error "Invalid format $format" + } + } +} + + +proc wok_cd_proc {args} { + + global IWOK_GLOBALS + global WOK_GLOBALS + global wokemacs_priv; + + set CLIENTS ""; + + set dir "$args" + + if { $WOK_GLOBALS(cd_proc,emacs) } { + if { ! [catch {wokemacs clients} CLIENTS] } { + foreach client [wokemacs clients] { + wokemacs sendcmd $client [lindex [wok_cd_cmd emacs $dir] 0] + } + } + } + + if { $WOK_GLOBALS(cd_proc,term) } { + if { [info exists IWOK_GLOBALS(term,started)] } { + if { $IWOK_GLOBALS(term,started) } { + exp_send -i $IWOK_GLOBALS(term,term_spawn_id) [lindex [wok_cd_cmd csh $dir] 0]; + } + } + if { [info exists WOK_GLOBALS(wokinterp,csh,id)] } { + exp_send -i $WOK_GLOBALS(wokinterp,csh,id) [lindex [wok_cd_cmd csh $dir] 0]; + expect -i $WOK_GLOBALS(wokinterp,csh,id) -exact $WOK_GLOBALS(wokinterp,csh,prompt); + } + } + + + + if { $WOK_GLOBALS(cd_proc,tcl) } { + catch {eval [lindex [wok_cd_cmd tcl $dir] 0]} + } + return; +} + +proc wok_exit_proc {args} { + + global wokemacs_priv; + global IWOK_GLOBALS + global WOK_GLOBALS + + + # + ## Close term connection + # + if { [info exists IWOK_GLOBALS(term,started)] } { + if { $IWOK_GLOBALS(term,started) } { + close -i $IWOK_GLOBALS(term,term_spawn_id) + } + } + + # + ## Close Emacs connection + # + set CLIENTS ""; + if { ! [catch {wokemacs clients} CLIENTS] } { + + foreach client $CLIENTS { + puts "Closing client $client" + close $wokemacs_priv($client) + } + } + if { $args == "" } { + tcl_exit_proc 0; + } { + tcl_exit_proc $args + } +} + + +proc wok_setenv_proc {var value} { + + global IWOK_GLOBALS; + global WOK_GLOBALS; + global wokemacs_priv; + global env; + + set limit 200; + + if { $WOK_GLOBALS(setenv_proc,emacs) } { + if { ! [catch {wokemacs clients} CLIENTS] } { + foreach client [wokemacs clients] { + wokemacs sendcmd $client [lindex [wok_setenv_cmd emacs $var $value] 0] + } + } + } + + if { $WOK_GLOBALS(setenv_proc,term) } { + if { [info exists IWOK_GLOBALS(term,started)] } { + if { $IWOK_GLOBALS(term,started) } { + + # First Initialize Variable + set len [clength $value] + set debut 0 + + set i $limit + set sub [crange $value $debut $i] + set command [lindex [wok_setenv_cmd csh $var $value] 0] + exp_send -i $IWOK_GLOBALS(term,term_spawn_id) $command; + sleep .1 + incr i + update + + while { $i < $len } { + + # Then Append trailing + set debut $i + set i [expr $i + $limit] + + set sub [crange $value $debut $i] + exp_send -i $IWOK_GLOBALS(term,term_spawn_id) "setenv $var \"\${$var}$sub\"\n" + sleep .1 + incr i + update + } + } + } + } + + if { $WOK_GLOBALS(setenv_proc,tcl) } { + eval [lindex [wok_setenv_cmd tcl $var $value] 0] + } + update +} + +proc wok_source_proc {type file} { + + global IWOK_GLOBALS; + global WOK_GLOBALS; + global env; + + switch $type { + csh { + + if { [info exists WOK_GLOBALS(source_proc,term) ] } { + if { $WOK_GLOBALS(source_proc,term) } { + if { [info exists IWOK_GLOBALS(term,started)] } { + if { $IWOK_GLOBALS(term,started) } { + exp_send -i $IWOK_GLOBALS(term,term_spawn_id) [lindex [wok_source_cmd csh $file] 0]; + } + } + } + } + } + tcl { + eval [lindex [wok_source_cmd tcl $file] 0] + } + emacs { + if { $WOK_GLOBALS(setenv_proc,emacs) } { + if { ! [catch {wokemacs clients} CLIENTS] } { + foreach client [wokemacs clients] { + wokemacs sendcmd $client [lindex [wok_source_cmd emacs $file] 0] + } + } + } + } + default { + } + } + update +} diff --git a/src/WOKTclLib/woksh.el b/src/WOKTclLib/woksh.el new file mode 100755 index 0000000..bf3176f --- /dev/null +++ b/src/WOKTclLib/woksh.el @@ -0,0 +1,356 @@ +;;; woksh.el --- WOK TCL interface + +;;; Code: + +(require 'comint) +(require 'shell) +(require 'wok-comm) + +(defvar woksh-program "tclsh" + "*Name of program to invoke woksh") + +(defvar woksh-explicit-args nil + "*List of arguments to pass to woksh on the command line.") + +(defvar woksh-mode-hook nil + "*Hooks to run after setting current buffer to woksh-mode.") + +(defvar woksh-process-connection-type t + "*If non-`nil', use a pty for the local woksh process. +If `nil', use a pipe (if pipes are supported on the local system). + +Generally it is better not to waste ptys on systems which have a static +number of them. On the other hand, some implementations of `woksh' assume +a pty is being used, and errors will result from using a pipe instead.") + +(defvar woksh-directory-tracking-mode 'local + "*Control whether and how to do directory tracking in an woksh buffer. + +nil means don't do directory tracking. + +t means do so using an ftp remote file name. + +Any other value means do directory tracking using local file names. +This works only if the remote machine and the local one +share the same directories (through NFS). This is the default. + +This variable becomes local to a buffer when set in any fashion for it. + +It is better to use the function of the same name to change the behavior of +directory tracking in an woksh session once it has begun, rather than +simply setting this variable, since the function does the necessary +re-synching of directories.") + +(make-variable-buffer-local 'woksh-directory-tracking-mode) + +;; Initialize woksh mode map. +(defvar woksh-mode-map '()) +(cond + ((null woksh-mode-map) + (setq woksh-mode-map (if (consp shell-mode-map) + (cons 'keymap shell-mode-map) + (copy-keymap shell-mode-map))) + (define-key woksh-mode-map "\C-c\C-c" 'woksh-send-Ctrl-C) + (define-key woksh-mode-map "\C-c\C-d" 'woksh-send-Ctrl-D) + (define-key woksh-mode-map "\C-c\C-z" 'woksh-send-Ctrl-Z) + (define-key woksh-mode-map "\C-c\C-\\" 'woksh-send-Ctrl-backslash) + (define-key woksh-mode-map "\C-d" 'woksh-delchar-or-send-Ctrl-D) + (define-key woksh-mode-map "\C-i" 'woksh-tab-or-complete))) + + +;;(add-hook 'same-window-regexps "^\\*woksh-.*\\*\\(\\|<[0-9]+>\\)") + +(defvar woksh-history nil) + +;;;###autoload +(defun woksh (input-args &optional buffer) + "Open a woksh" + + (interactive (list + "1566" + current-prefix-arg)) + + (let* ((process-connection-type woksh-process-connection-type) + (args nil) + (buffer-name "*woksh*") + (iport (string-to-int input-args)) + proc) + + (cond ((null buffer)) + ((stringp buffer) + (setq buffer-name buffer)) + ((bufferp buffer) + (setq buffer-name (buffer-name buffer))) + ((numberp buffer) + (setq buffer-name (format "%s<%d>" buffer-name buffer))) + (t + (setq buffer-name (generate-new-buffer-name buffer-name)))) + + (setq buffer (get-buffer-create buffer-name)) + (pop-to-buffer buffer-name) + + (cond + ((comint-check-proc buffer-name)) + (t + (comint-exec buffer buffer-name woksh-program nil args) + (setq proc (get-buffer-process buffer)) + ;; Set process-mark to point-max in case there is text in the + ;; buffer from a previous exited process. + (set-marker (process-mark proc) (point-max)) + (woksh-mode) + + ;; comint-output-filter-functions is just like a hook, except that the + ;; functions in that list are passed arguments. add-hook serves well + ;; enough for modifying it. + (add-hook 'comint-output-filter-functions 'woksh-carriage-filter) + + (cd-absolute (concat comint-file-name-prefix "~/")))) + (if (not (eq iport 0)) + (if (not (wok-connectedp)) + (progn + (send-string nil (format "wokemacs_init %d\n" iport)) + (wok-connect-to-controller "localhost" iport) + (send-string nil "auto_load wok_cd_proc\n") + (erase-buffer) + ))))) + +(defun woksh-mode () + "Set major-mode for woksh sessions. +If `woksh-mode-hook' is set, run it." + (interactive) + (kill-all-local-variables) + (shell-mode) + (setq major-mode 'woksh-mode) + (setq mode-name "woksh") + (use-local-map woksh-mode-map) + (setq shell-dirtrackp woksh-directory-tracking-mode) + (make-local-variable 'comint-file-name-prefix) + (run-hooks 'woksh-mode-hook)) + +(defun woksh-directory-tracking-mode (&optional prefix) + "Do remote or local directory tracking, or disable entirely. + +If called with no prefix argument or a unspecified prefix argument (just +``\\[universal-argument]'' with no number) do remote directory tracking via +ange-ftp. If called as a function, give it no argument. + +If called with a negative prefix argument, disable directory tracking +entirely. + +If called with a positive, numeric prefix argument, e.g. +``\\[universal-argument] 1 M-x woksh-directory-tracking-mode\'', +then do directory tracking but assume the remote filesystem is the same as +the local system. This only works in general if the remote machine and the +local one share the same directories (through NFS)." + (interactive "P") + (cond + ((or (null prefix) + (consp prefix)) + (setq woksh-directory-tracking-mode t) + (setq shell-dirtrackp t) + (setq comint-file-name-prefix "")) + ((< prefix 0) + (setq woksh-directory-tracking-mode nil) + (setq shell-dirtrackp nil)) + (t + (setq woksh-directory-tracking-mode 'local) + (setq comint-file-name-prefix "") + (setq shell-dirtrackp t))) + (cond + (shell-dirtrackp + (let* ((proc (get-buffer-process (current-buffer))) + (proc-mark (process-mark proc)) + (current-input (buffer-substring proc-mark (point-max))) + (orig-point (point)) + (offset (and (>= orig-point proc-mark) + (- (point-max) orig-point)))) + (unwind-protect + (progn + (delete-region proc-mark (point-max)) + (goto-char (point-max)) + (shell-resync-dirs)) + (goto-char proc-mark) + (insert current-input) + (if offset + (goto-char (- (point-max) offset)) + (goto-char orig-point))))))) + + +;; Parse a line into its constituent parts (words separated by +;; whitespace). Return a list of the words. +(defun woksh-parse-words (line) + (let ((list nil) + (posn 0) + (match-data (match-data))) + (while (string-match "[^ \t\n]+" line posn) + (setq list (cons (substring line (match-beginning 0) (match-end 0)) + list)) + (setq posn (match-end 0))) + (store-match-data (match-data)) + (nreverse list))) + +(defun woksh-carriage-filter (string) + (let* ((point-marker (point-marker)) + (end (process-mark (get-buffer-process (current-buffer)))) + (beg (or (and (boundp 'comint-last-output-start) + comint-last-output-start) + (- end (length string))))) + (goto-char beg) + (while (search-forward "\C-m" end t) + (delete-char -1)) + (goto-char point-marker))) + +(defun woksh-send-Ctrl-C () + (interactive) + (send-string nil "\C-c")) + +(defun woksh-send-Ctrl-D () + (interactive) + (send-string nil "\C-d")) + +(defun woksh-send-Ctrl-Z () + (interactive) + (send-string nil "\C-z")) + +(defun woksh-send-Ctrl-backslash () + (interactive) + (send-string nil "\C-\\")) + +(defun woksh-delchar-or-send-Ctrl-D (arg) + "\ +Delete ARG characters forward, or send a C-d to process if at end of buffer." + (interactive "p") + (if (eobp) + (woksh-send-Ctrl-D) + (delete-char arg))) + +(defun woksh-tab-or-complete () + "Complete file name if doing directory tracking, or just insert TAB." + (interactive) + (if woksh-directory-tracking-mode + (comint-dynamic-complete) + (insert "\C-i"))) +;; + +(defun wok-command (command) + (interactive (list (read-from-minibuffer "Command : " + nil nil nil 'woksh-history))) + (save-excursion + + (if (not (wok-connectedp)) + (if (equal "yes" (completing-read "WOK not connected: connect ? (yes/no) : " + '(("yes") ("no")) nil t + '("yes" . 0) 'woksh-history)) + (woksh "1566" "*woksh*") + )) + + (if (wok-connectedp) + (progn + (set-buffer "*woksh*") + (woksh-parse-words (wok-send-command command))) + (progn + (ding) + (error "Wok controller not connected"))))) + +;; Goto Entity + +(defun wokcd ( userpath ) + "\ +Moves into a Wok entity" + (interactive (list (read-from-minibuffer "wokcd : " + nil nil nil 'woksh-history))) + + (wok-command (format "wokcd %s" userpath))) + + +(defun wcd ( Unit ) + (interactive (list (read-from-minibuffer "wcd : " + nil nil nil 'woksh-history))) + (wok-command (format "wokcd %s -PSrc" Unit))) + +;;; woksh.el ends here +(defvar woksh-entity-history nil) +(defvar woksh-type-history nil) +(defvar woksh-name-history nil) + +(defun wok-dired ( Entity Type ) + (interactive (list + (setq myent (completing-read "Entity : " + (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil + (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history)) + (completing-read "Type : " + (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil + '("source" . 0) 'woksh-type-history))) + ;; insert formatted string into a buffer + (let ((type Type)) + (if (not (string-match ":" Type)) + (setq type (format "%s:." Type))) + (set-buffer (dired + (car (wok-command (format "wokinfo -p %s %s\n" type Entity))))) + + (rename-buffer (format "%s-%s [%s] (%s)" + (car (wok-command (format "wokinfo -n %s" Entity))) + type + (car (wok-command (format "wokinfo -N %s" Entity))) + (car (wok-command (format "wokinfo -t %s" Entity))))))) + +(defun wok-findfile ( Entity Type FileName ) + (interactive (list + (setq myent (completing-read "Entity : " + (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil + (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history)) + (setq mytype (completing-read "Type : " + (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil + '("source" . 0) 'woksh-type-history)) + (completing-read "Name : " + (mapcar 'list (wok-command (format "uinfo -fT%s %s" mytype myent))) nil nil + '("" . 0) 'woksh-name-history))) + ;; insert formatted string into a buffer + (set-buffer (find-file + (car (wok-command (format "woklocate -p %s:%s:%s\n" Entity Type FileName))))) + ) + +(defun wok-locate ( Entity Type FileName ) + (interactive (list + (setq myent (completing-read "Entity : " + (mapcar 'list (wok-command (format "Sinfo -N"))) nil nil + (cons (car (wok-command "wokinfo -n [wokcd]")) 0) 'woksh-entity-history)) + (setq mytype (completing-read "Type : " + (mapcar 'list (wok-command (format "wokinfo -T %s" myent))) nil nil + '("source" . 0) 'woksh-type-history)) + (completing-read "Name : " + (mapcar 'list (wok-command (format "uinfo -fT%s %s" mytype myent))) nil nil + '("" . 0) 'woksh-name-history))) + ;; insert formatted string into a buffer + (car (wok-command (format "woklocate -p %s:%s:%s\n" Entity Type FileName))) + ) + + +(setq wok-compile-defaults '('("umake") ("umake -o obj") ("umake -o exec") ("umake -o xcpp"))) + +(defun wok-compile ( commande ) + (interactive (list + (completing-read "Command : " + wok-compile-defaults nil nil + "umake " 'woksh-history))) + (set-buffer "*woksh*") + (wok-command commande)) + +(defun concat-list-error (thelist) + (let ((res " ")) + (mapcar (lambda (x) + (setq res (concat res x " "))) + thelist) + res)) + +(defun receive-tcl-error (linearg) + (interactive) + + (kill-buffer (switch-to-buffer-other-window "*compilation*")) + (switch-to-buffer-other-window "*compilation*") + (compilation-mode) + (goto-char (point-max)) + (insert "\n\n") + (insert-file linearg) + (compile-goto-error) +) diff --git a/src/WOKTclLib/work.xpm b/src/WOKTclLib/work.xpm new file mode 100755 index 0000000..6a061ce --- /dev/null +++ b/src/WOKTclLib/work.xpm @@ -0,0 +1,54 @@ +/* XPM */ +static char * work_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 32 16 1 0 0", +/* colors */ +" s iconGray4 m white c #949494949494", +". s iconColor1 m black c black", +"X c #FFFF63634747", +"o c #707080809090", +"O c #2F2F4F4F4F4F", +"+ c #EEEE8282EEEE", +"@ c #BEBEBEBEBEBE", +"# c #DCDCDCDCDCDC", +"$ s iconColor2 m white c white", +"% c #A0A052522D2D", +"& c #E6E6E6E6FAFA", +"* c #FFFFA5A50000", +"= s iconColor6 m white c yellow", +"- c #B2B222222222", +"; c #CDCD85853F3F", +": c #D2D2B4B48C8C", +/* pixels */ +" ", +" ...... ", +" ..XXXXXX. ", +" ..ooOX++XX. ", +" .@@##$oOXXXX. ", +" .@@#$$@@oOXXX%. ", +" .@&&&@@@@@@OX%%. ", +" ..***@&@@@@oOX%%. ", +" .====*--&@@ooo.%%. ", +" .====*$**-&@ooO.%-. ", +" .====*$****-@oO..--. ", +" .====*$******-O...-..O ", +" .====*$*******O..O.-..OOO", +" .====*$*******%O.Oo....OOO", +" .;****$*******%%O.oO....OOO", +" .;:::**;;*****%%%O.O....OOOO", +" .::&&::;;****%%%;O.....OOOO ", +" .:&&&:::;;**%%%;O.....OOOO ", +" .;:&&&::::;*%%%;;O....OOOO ", +" .::&&:::::;-%%;;-....OOOO ", +" .:&&:::::::-%;;-....OOOO ", +" .;:::::::::;-;;-....OOOO ", +" ...:::::::;;-;-....OOOO ", +" .@o..::::;;%--....OOOO ", +" .O$...::;;;%--....OOOO ", +" .oO....;;;%.......OOO ", +" .O.....-.......OOOOO ", +" ............OOOOOOO ", +" .........OOOOOOOOO ", +" OOOOOOOOOOOO ", +" OOOOOOOOO ", +" OOOOO "}; diff --git a/src/WOKTclLib/workbench.xpm b/src/WOKTclLib/workbench.xpm new file mode 100755 index 0000000..7f3e2e7 --- /dev/null +++ b/src/WOKTclLib/workbench.xpm @@ -0,0 +1,34 @@ +/* XPM */ +static char * workbench_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"19 19 9 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X c #999960600000", +"o c #999940405555", +"O c #CCCC60600000", +"+ c #999960605555", +"@ c #999920205555", +"# c #CCCC20200000", +"$ c #333360605555", +/* pixels */ +" ", +" ", +" ", +" ", +" ... ", +" .Xo......XoOoX ", +" oX+X.......X@X+X ", +" .#o#o.......oOoOo.", +".........+.........", +"..Oo ..... .oXoO", +"..oX ...$... .....", +"..Oo ....... .oOoO", +"..+ . .Xo++", +"..O . .oXoO", +".. ... .", +" o.... ", +" ", +" ", +" "}; diff --git a/src/WOKTclLib/workbench_open.xpm b/src/WOKTclLib/workbench_open.xpm new file mode 100755 index 0000000..051ac0c --- /dev/null +++ b/src/WOKTclLib/workbench_open.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char * workbench_open_xpm[] = { +"19 19 9 1", +" c #FFFFFFFF0000", +". c #000000000000", +"X c #999960600000", +"o c #999940405555", +"O c #CCCC60600000", +"+ c #999960605555", +"@ c #999920205555", +"# c #CCCC20200000", +"$ c #333360605555", +" ", +" ", +" ", +" ", +" ... ", +" .Xo......XoOoX ", +" oX+X.......X@X+X ", +" .#o#o.......oOoOo.", +".........+.........", +"..Oo ..... .oXoO", +"..oX ...$... .....", +"..Oo ....... .oOoO", +"..+ . .Xo++", +"..O . .oXoO", +".. ... .", +" o.... ", +" ", +" ", +" "}; diff --git a/src/WOKTclLib/workshop.xpm b/src/WOKTclLib/workshop.xpm new file mode 100755 index 0000000..8828f77 --- /dev/null +++ b/src/WOKTclLib/workshop.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * workshop_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +"32 27 11 1 0 0", +/* colors */ +" s none m none c none", +". s iconColor1 m black c black", +"X s iconColor5 m black c blue", +"o s iconColor7 m white c cyan", +"O c #66666060AAAA", +"+ c #666680805555", +"@ c #66668080AAAA", +"# c #999980805555", +"$ s iconColor3 m black c red", +"% c #666660605555", +"& s iconColor6 m white c yellow", +/* pixels */ +" ", +" ", +" ", +" . ", +" XXXXXXXXXX.. ", +" XXXXXXXXXX.. ", +" XXXXXXXXXX.. ", +" XXXXXXXXXX.. ", +" XXXXXXXXXX.. ", +" ... XX.oooo.XX.. ", +" .. XX.oooo.XX.. ", +".... .. . XX.oooo.XX.. ", +"O+@. . .. XX.oooo.XX.. ", +"#O#. XX.oooo.XX.. ", +"@+O. $. XX......XX.. ", +"#%#. .$$ XXXXXXXXXX.. ", +" $$$. X&XXXXXXXX.. ", +"#O#... $$$$$. X&&.XXXXXX.. ", +"....... ....$. X&XXXXXXXX.. ", +"#% .... XXXXXXXXXX.. ", +"O+ .&&&&&&&.. XXXXXXXXXX.. ", +"#O &&........ XXXXXXXXXX.. ", +"@+ && . XXXXXXXXXX.. ", +"#% .. . XXXXXXXXXX.. ", +"O+ .. . XXXXXXXXXX.. ", +"#O .. XXXXXXXXXX.. ", +"................................"}; diff --git a/src/WOKTclLib/workshop_open.xpm b/src/WOKTclLib/workshop_open.xpm new file mode 100755 index 0000000..2709c4f --- /dev/null +++ b/src/WOKTclLib/workshop_open.xpm @@ -0,0 +1,41 @@ +/* XPM */ +static char * workshop_open_xpm[] = { +"32 27 11 1", +" c #FFFFFFFF0000", +". c #FFFFFFFFFFFF", +"X c #000000000000", +"o c #00000000FFFF", +"O c #0000FFFFFFFF", +"+ c #66666060AAAA", +"@ c #666680805555", +"# c #66668080AAAA", +"$ c #999980805555", +"% c #FFFF00000000", +"& c #666660605555", +" ", +" ", +" ", +" ............X ", +" .ooooooooooXX ", +" .ooooooooooXX ", +" .ooooooooooXX ", +" .ooooooooooXX ", +" .ooooooooooXX ", +" XXX .ooXOOOOXooXX ", +" ..XX .ooXOOOOXooXX ", +"XXXX XX..X .ooXOOOOXooXX ", +"+@#X X..XX .ooXOOOOXooXX ", +"$+$X . .ooXOOOOXooXX ", +"#@+X %X .ooXXXXXXooXX ", +"$&$X X%% .ooooooooooXX ", +" %%%X .o ooooooooXX ", +"$+$XXX..%%%%%X. .o XooooooXX ", +"XXXXXXX XXXX%X. .o ooooooooXX ", +"$& XXXX. .ooooooooooXX ", +"+@ X XX .ooooooooooXX ", +"$+ XXXXXXXX .ooooooooooXX ", +"#@ X .ooooooooooXX ", +"$& XX X .ooooooooooXX ", +"+@ XX X .ooooooooooXX ", +"$+ .... XX .ooooooooooXX ", +"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"}; diff --git a/src/WOKTclLib/wprepare.tcl b/src/WOKTclLib/wprepare.tcl new file mode 100755 index 0000000..945f61b --- /dev/null +++ b/src/WOKTclLib/wprepare.tcl @@ -0,0 +1,469 @@ +############################################################################# +# +# W P R E P A R E +# _______________ +# +############################################################################# +# +# Usage +# +proc wokPrepareUsage { } { + puts stderr { Usage: wprepare [-ref] [-ud ] -o [filename]} + puts stderr { Note: If your specify more than one unit, separate names with a comma.} + puts stderr { } + puts stderr { The following options allows you to select files based on time. } + puts stderr { } + puts stderr { wprepare -since markname [-ud ] -o [filename] } + puts stderr { Select in the current workbench all files modified since the date } + puts stderr { pointed to the mark markname ( See command wnews. ) } + puts stderr { } + puts stderr { wprepare -newer file [-ud ] -o [filename] } + puts stderr { Select in the current workbench all files newer than file. } + puts stderr { (The term newer refers to the modification time.) } + puts stderr { } + return +} +# +# Point d'entree de la commande +# +proc wprepare { args } { + + global wokfileid + global WOKVC_STYPE WOKVC_LTYPE + + set tblreq(-h) {} + set tblreq(-ud) value_required:list + set tblreq(-ref) {} + set tblreq(-o) value_required:file + + set tblreq(-son) value_required:string + set tblreq(-dad) value_required:string + + set tblreq(-ws) value_required:string + + set tblreq(-since) value_required:string + + set tblreq(-newer) value_required:string + + set param {} + if { [wokUtils:EASY:GETOPT param tabarg tblreq wokPrepareUsage $args] == -1 } return + + if [info exists tabarg(-h)] { + wokPrepareUsage + return + } + + if [info exists tabarg(-son)] { + set WBFils $tabarg(-son) + } else { + set WBFils [wokinfo -w] + } + + if [info exists tabarg(-dad)] { + set WBPere $tabarg(-dad) + } else { + set WBPere [lindex [w_info -A $WBFils] 1] + } + + + if [info exists tabarg(-o)] { + set wokfileid [open $tabarg(-o) w] + eval "proc wprepare_return { } { close $wokfileid ; return }" + } else { + set wokfileid stdout + eval "proc wprepare_return { } { return }" + } + + if [info exists tabarg(-ud)] { + set LUnits $tabarg(-ud) + } else { + set LUnits [w_info -l $WBFils] + } + + + if [info exists tabarg(-ws)] { + set fshop $tabarg(-ws) + } else { + set fshop [wokinfo -s [wokcd]] + } + + if [info exists tabarg(-since)] { + if { [set journal [wokIntegre:Journal:GetName $fshop]] == {} } { + msgprint -c WOKVC -e "Journal file not found in workshop $fshop." + return + } + set num [wokIntegre:Mark:Get $journal $tabarg(-since)] + set date [wokIntegre:Journal:ReportDate $journal $num] + if { $date != {} } { + wokclose -a + wokPrepare:Report:InitTypes + wokPrepare:Report:Output banner [wokinfo -n [wokinfo -s $WBFils]] $WBFils + wokPrepare:Unit:Since wokPrepare:Report:Output ${WBFils} $LUnits $date + puts $wokfileid "is" + puts $wokfileid " Author : [id user]" + puts $wokfileid " Study/CSR : " + puts $wokfileid " Debug : " + puts $wokfileid " Improvements : " + puts $wokfileid " News : Files modified since [fmtclock $date]" + puts $wokfileid " Deletions : " + puts $wokfileid " Impact : " + puts $wokfileid " Comments : " + puts $wokfileid "end;" + catch {unset wokfileid} + wprepare_return + return + } else { + msgprint -c WOKVC -e "Unknown mark. Try the command : wnews -admin." + return + } + } + + if [info exists tabarg(-newer)] { + set datf [file mtime $tabarg(-newer)] + if { [info exists datf] } { + wokclose -a + wokPrepare:Report:InitTypes + wokPrepare:Report:Output banner [wokinfo -n [wokinfo -s $WBFils]] $WBFils + wokPrepare:Unit:Since wokPrepare:Report:Output ${WBFils} $LUnits $datf + wokPrepare:Report:Output notes + catch {unset wokfileid} + wprepare_return + return + } else { + msgprint -c WOKVC -e "Unknown mark. Try the command : wnews -admin." + return + } + } + + wokclose -a + + wokPrepare:Report:InitTypes + + set SHPere [wokinfo -s $WBPere] + set SHFils [wokinfo -s $WBFils] + + wokPrepare:Report:Output banner [wokinfo -n $SHFils] $WBFils + + if { [info exists tabarg(-ref)] || [wokUtils:WB:IsRoot $WBFils] } { + wokPrepare:Unit:Ref wokPrepare:Report:Output ${WBFils} $LUnits + } else { + wokPrepare:Unit:Loop wokPrepare:Report:Output ${WBPere} ${WBFils} $LUnits + } + + wokPrepare:Report:Output notes + + catch {unset wokfileid} + wprepare_return +} +#;> +# Boucle sur une liste {type name}, ecrit dans table(name.type) = " # name etc.." +# pour tous les fichiers dont la mtime est superieur strictement a date. +# wokPrepare:Unit:Ref Mytable DEMO:Demo:Kernel {NTD AccesServer} +# Wb: un prefixe quelconque a une Ud +#;< +proc wokPrepare:Unit:Since { Fout Wb Uliste date } { + foreach e $Uliste { + set t [uinfo -t ${Wb}:${e}] + $Fout uheader "$e.$t" + foreach f [lsort [uinfo -pl -Tsource ${Wb}:${e}]] { + set mti [file mtime $f] + if { $mti > $date } { + $Fout files # [fmtclock [file mtime $f] "%d/%m/%y %R"] [file tail $f] [file dirname $f] + } + } + } + return +} +#;> +# Boucle sur une liste {type name}, ecrit dans table(name.type) = " + name etc.." +# wokPrepare:Unit:Ref Mytable DEMO:Demo:Kernel {NTD AccesServer} +# Wb: un prefixe quelconque a une Ud +#;< +proc wokPrepare:Unit:Ref { Fout Wb Uliste } { + foreach e $Uliste { + set t [uinfo -t ${Wb}:${e}] + $Fout uheader "$e.$t" + foreach f [lsort [uinfo -pl -Tsource ${Wb}:${e}]] { + $Fout files + [fmtclock [file mtime $f] "%d/%m/%y %R"] [file tail $f] [file dirname $f] + } + } + return +} + +#;> +# Boucle sur une liste {type name}, ecrit dans table le resultat de la comparaison +# wokPrepare:Unit:Loop Mytable DEMO:Demo:Kernel DEMO:Demo:FK {NTD AccesServer} +# Pere = FACT:SHOP:WBPERE , Fils: FACT:SHOP:WBFILS +#;< +proc wokPrepare:Unit:Loop { Fout Pere Fils Uliste } { + set lupere [w_info -l $Pere] + foreach e $Uliste { + set t [uinfo -t ${Fils}:${e}] + $Fout uheader "$e.$t" + set loc [uinfo -fl -Tsource ${Fils}:$e] + if { [lsearch $lupere $e] != -1 } { + wokPrepare:Unit:Diff $Fout [uinfo -fp -Tsource ${Pere}:$e] [uinfo -fp -Tsource ${Fils}:$e] $loc + } else { + wokPrepare:Unit:Diff $Fout {} [uinfo -fp -Tsource ${Fils}:$e] $loc + } + } +} + +#;> +# +# l1 liste des sources vue du pere {basename dirname} +# l2 " " vue du fils " " +# local basename des sources effectivement dans dfils +# +# retourne une liste des comparaisons +#;< +proc wokPrepare:Unit:Diff { Fout l1 l2 local } { + ;# + ;# 1. Comparaison de l1 et l2 dans wokM + ;# + catch {unset wokM} + foreach e $l1 { + set wokM([lindex $e 0]) [list - [lindex $e 1]] + } + + foreach e $l2 { + set k [lindex $e 0] + set p [lindex $e 1] + if { [info exists wokM($k)] } { + set l $wokM($k) + set wokM($k) [list # [lindex $l 1] $p] + } else { + set wokM($k) [list + $p] + } + } + ;# + ;# 2. Parcours de wokM : impression des nouveaux et des disparus + ;# + ;#parray wokM + foreach e [array names wokM] { + switch -- [lindex $wokM($e) 0] { + - { + set file [lindex $wokM($e) 1] + if [file exists $file] { + $Fout files - [fmtclock [file mtime $file] "%d/%m/%y %R"] $e [file dirname $file] + } else { + ;#msgprint -w "Unit files list should be recomputed. (umake -o src)" + } + } + + + { + set file [lindex $wokM($e) 1] + if [file exists $file] { + $Fout files + [fmtclock [file mtime $file] "%d/%m/%y %R"] $e [file dirname $file] + } else { + ;#msgprint -w "Unit files list should be recomputed. (umake -o src)" + } + } + + # { + if { [lsearch $local $e] != -1 } { + set fpere [lindex $wokM($e) 1] ; set ffils [lindex $wokM($e) 2] + set date [fmtclock [file mtime $ffils] "%d/%m/%y %R"] + if { [file isfile $fpere] && [file isfile $ffils] } { + if { [wokUtils:FILES:AreSame $fpere $ffils] } { + $Fout files = $date $e [file dirname $ffils] [file dirname $fpere] + } else { + $Fout files # $date $e [file dirname $ffils] [file dirname $fpere] + } + } + } + } + } + } + + return +} +#;> +# Lit un report et charge : +# 1. La banniere dans banner (liste de 3 elements) +# 2. les UDs dans table ( index = name(type) ) +# 3. Les ReleasesNotes dans notes (liste de n elements) +#;< +proc wokPrepare:Report:Read { name table banner notes } { + upvar $table TLOC $banner BLOC $notes NLOC + set l [wokUtils:FILES:FileToList $name] + set BLOC [lrange $l 0 2] + set is [lsearch -regexp $l (^is$) ] + set NLOC [lrange $l [expr $is+1] [expr [llength $l]-2] ] + foreach x [lrange $l 5 [expr $is -1]] { + set uheader [wokPrepare:Report:UnitHeader decode $x] + if { $uheader != {} } { + set key $uheader + set TLOC($key) {} + } else { + set l $TLOC($key) + set TLOC($key) [lappend l $x] + } + } + return +} +#;> +# ecrit station workshop workbench sur fileid +#;< +proc wokPrepare:Report:WriteInfo { station workshop workbench {fileid stdout}} { + puts $fileid [format "Station : %s" $station]; + puts $fileid [format "Workshop : %s" $workshop]; + puts $fileid [format "Workbench : %s\n" $workbench]; + return +} +#;> +# retourne station workshop workbench +#;< +proc wokPrepare:Report:ListInfo { station workshop workbench {fileid stdout}} { + return [list \ + [format "Station : %s" $station]\ + [format "Workshop : %s" $workshop]\ + [format "Workbench : %s" $workbench]\ + ] +} +#;> +# decode info (liste de 3 elements ) dans les variables qui suivent +#;< +proc wokPrepare:Report:ReadInfo { info station workshop workbench } { + upvar $station staloc $workshop wsloc $workbench wbloc + regexp {Station : (.*)} [lindex $info 0] ignore staloc + regexp {Workshop : (.*)} [lindex $info 1] ignore wsloc + regexp {Workbench : (.*)} [lindex $info 2] ignore wbloc + return +} + +#;> +# Init d'une global pour utiliser simplement les types de Wok. +# (Voir wokPrepare:Report:UnitHeader) +# +#;< +proc wokPrepare:Report:InitTypes {} { + global WOKVC_STYPE WOKVC_LTYPE + set ucreateP \ + [list {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}] + foreach itm $ucreateP { + set shrt [lindex $itm 0] + set long [lindex $itm 1] + set WOKVC_STYPE($shrt) $long + set WOKVC_LTYPE($long) $shrt + } + return +} +#;> +# Encode/decode un nom d'UD dans un report +# code "Technos.nocdlpack" -> " * Technos (nocdlpack):" +# decode " * Technos (nocdlpack):" -> "Technos.nocdlpack" {} si le regexp n'est pas trouvee +# tolong "Doc.r" -> {resource Doc} +# longto {resource Doc} -> "Doc.r" +# stol et ltos self explan. +# default "Technos nocdlpack" -> Technos.nocdlpack (Utilise comme index des tables) +#;< +proc wokPrepare:Report:UnitHeader {option string} { + global WOKVC_LTYPE WOKVC_STYPE + switch $option { + code { + set uheader [regexp {(.*)\.(.*)} $string all udname type] + return [format " * %s (%s):" $udname $type] + } + + decode { + set uheader [regexp { \* (.*) \((.*)\):} $string all udname type] + if { $uheader } { + return ${udname}.$WOKVC_LTYPE($type) + } else { + return {} + } + } + + tolong { + set l [split $string .] + return [list $WOKVC_STYPE([lindex $l 1]) [lindex $l 0]] + } + + stol { + if [info exists WOKVC_STYPE($string)] { + return $WOKVC_STYPE($string) + } + } + + ltos { + if [info exists WOKVC_LTYPE($string)] { + return $WOKVC_LTYPE($string) + } + } + + + default { + return ${option}.${string} + } + } +} +#;> +# Ecrit un report avec le contenu de strlist +#;< +proc wokPrepare:Report:Skel { strlist } { +} +#;> +# +# Appele pour sortir un report sur fileid +# +#;< +proc wokPrepare:Report:Output { opt args } { + + global wokfileid + set fileid $wokfileid + + switch $opt { + + banner { + set shop [lindex $args 0] + set wb [lindex $args 1] + set buf [replicate _ 30] + set buf_path [replicate _ 61] + wokPrepare:Report:WriteInfo [id host] $shop $wb $fileid + puts $fileid [format " S Date Time Name"]; + puts $fileid [format " _ ________ _____ %s %s" $buf $buf_path]; + } + + uheader { + puts $fileid "" + puts $fileid [wokPrepare:Report:UnitHeader code $args] + puts $fileid "" + } + + files { + set flag [lindex $args 0] + set date [lindex $args 1] + set e [lindex $args 2] + switch -- $flag { + + { + set dfils [lindex $args 3] + puts $fileid [format " + %s %-30s %s" $date $e $dfils] + } + - { + set pnts "........................................" + set dpere [lindex $args 3] + puts $fileid [format " - %s %-30s %s %s" $date $e $pnts $dpere] + } + = { + set dfils [lindex $args 3] + set dpere [lindex $args 4] + puts $fileid [format " = %s %-30s %-40s %s" $date $e $dfils $dpere] + } + # { + set dfils [lindex $args 3] + set dpere [lindex $args 4] + puts $fileid [format " # %s %-30s %-40s %s" $date $e $dfils $dpere] + } + } + + } + + notes { + wokIntegre:Journal:ReleaseNotes $fileid + } + + } +} diff --git a/src/WOKTclLib/wstore_trigger.example b/src/WOKTclLib/wstore_trigger.example new file mode 100755 index 0000000..8452f0e --- /dev/null +++ b/src/WOKTclLib/wstore_trigger.example @@ -0,0 +1,30 @@ +;# +;# This proc is invoked by the command: wstore -trig +;# It should be placed in the Adm directory of the concerned shop, +;# and the file should be named wstore_trigger.tcl +;# +proc wstore_trigger { {action put} report_path } { + + set saved_wokcd [wokcd] + + switch -- $action { + + put { + ;# in this case is the full path of the report being processed. + set saved_wokcd [wokcd] + wokcd KERNEL:Ker6 + wstore $report_path + } + + rm { + ;# in this case is a digit: The queue index of the report being deleted. + } + + default { + } + } + + wokcd $saved_wokcd + wokclose -a + return +}