--- /dev/null
+proc BrowserSearch {where} {
+ global Browser_Expression Browser_KindOfSearch
+
+ if {$Browser_KindOfSearch == 1} {
+ # search classes
+ #
+ BrowserSearchClasses $where $Browser_Expression
+ } elseif {$Browser_KindOfSearch == 2} {
+ # search methods
+ #
+ BrowserSearchMethods $where $Browser_Expression
+ }
+}
+
+proc BrowserSearchDestroyWin {win} {
+ global Browser_Menu Browser_packinfo
+
+ destroy $win
+ $Browser_Menu.windows.options delete $Browser_packinfo(wsearch)
+}
+
+proc BrowserSearchSetClasses {entry} {
+ global Browser_KindOfSearch
+
+ set Browser_KindOfSearch 1
+ $entry configure -label "Classes :"
+}
+
+proc BrowserSearchSetMethods {entry} {
+ global Browser_KindOfSearch
+
+ set Browser_KindOfSearch 2
+ $entry configure -label "Methods :"
+}
+
+proc BrowserSetKindOfSearch {n} {
+ global Browser_SearchListbox
+
+ $Browser_SearchListbox delete 0 end
+
+ set lstpk [msinfo -p]
+ set lstpk [lsort $lstpk]
+
+ set doublefor 0
+
+ if {$n < 4} {
+ set doublefor 1
+ set opt "-c"
+ if {$n == 1} {
+ set test "stdclass"
+ } elseif {$n == 2} {
+ set test "instclass"
+ } elseif {$n == 3} {
+ set test "genclass"
+ }
+ } else {
+ if {$n == 4} {
+ set opt "-P"
+ } elseif {$n == 5} {
+ set opt "-a"
+ } elseif {$n == 6} {
+ set opt "-e"
+ } elseif {$n == 7} {
+ set opt "-p"
+ } elseif {$n == 8} {
+ set opt "-x"
+ } elseif {$n == 9} {
+ set opt "-i"
+ }
+ }
+
+ foreach p $lstpk {
+ set lsttype [mspkinfo $opt $p]
+ set lsttype [lsort $lsttype]
+
+ foreach t $lsttype {
+ if {$doublefor} {
+ if {[msclinfo -t "${p}_$t"] == $test} {
+ $Browser_SearchListbox insert end "${p}_$t"
+ }
+ } else {
+ $Browser_SearchListbox insert end "${p}_$t"
+ }
+ }
+ }
+}
+
+# return a listbox
+#
+proc BrowserSearchBuildWindow {win searchtype} {
+ if {[winfo exist $win.wsearch] == 1} {
+ BrowserSearchDestroyWin $win.wsearch
+ }
+
+ global Browser_Menu Browser_packinfo Browser_Expression Browser_KindOfSearch Browser_SearchListbox
+
+ toplevel $win.wsearch
+ $Browser_Menu.windows.options add command -label "Search" -command "raise $win.wsearch"
+ set Browser_packinfo(wsearch) [$Browser_Menu.windows.options index last]
+ wm title $win.wsearch "Search"
+ wm geometry $win.wsearch 400x400+100+100
+ set Browser_KindOfSearch 1
+
+ tixScrolledListBox $win.wsearch.result
+ set Browser_SearchListbox [$win.wsearch.result subwidget listbox]
+ $Browser_SearchListbox configure -exportselection 0
+
+ if {$searchtype == 1} {
+ tixLabelEntry $win.wsearch.expr -label "Classes :" -options {entry.width 20 label.width 0 entry.textVariable Browser_Expression}
+ } elseif {$searchtype == 2} {
+ tixOptionMenu $win.wsearch.expr -command BrowserSetKindOfSearch -label "Type : " -options {menubutton.width 8}
+ $win.wsearch.expr add command 1 -label "Standard Class"
+ $win.wsearch.expr add command 2 -label "Instantiation"
+ $win.wsearch.expr add command 3 -label "Generic Class"
+ $win.wsearch.expr add command 4 -label "Primitive"
+ $win.wsearch.expr add command 5 -label "Alias"
+ $win.wsearch.expr add command 6 -label "Enumeration"
+ $win.wsearch.expr add command 7 -label "Pointer"
+ $win.wsearch.expr add command 8 -label "Exception"
+ $win.wsearch.expr add command 9 -label "Imported"
+ }
+
+ button $win.wsearch.menubar -state disabled -relief raise
+ menubutton $win.wsearch.menubar.menu1 -menu $win.wsearch.menubar.menu1.options -text "File"
+ menu $win.wsearch.menubar.menu1.options
+
+ if {$searchtype == 1} {
+ $win.wsearch.menubar.menu1.options add command -label "Classes" -command "BrowserSearchSetClasses $win.wsearch.expr"
+ $win.wsearch.menubar.menu1.options add command -label "Methods" -command "BrowserSearchSetMethods $win.wsearch.expr"
+ }
+
+ $win.wsearch.menubar.menu1.options add command -label "Close" -command "BrowserSearchDestroyWin $win.wsearch"
+ tixForm $win.wsearch.menubar -top 2 -left 0 -right -0
+ tixForm $win.wsearch.menubar.menu1 -left 0 -top 0
+ tixForm $win.wsearch.expr -top $win.wsearch.menubar -left 0 -right -0
+ tixForm $win.wsearch.result -top $win.wsearch.expr -left 0 -right -0 -bottom -0
+
+
+ if {$searchtype == 1} {
+ bind [$win.wsearch.expr subwidget entry] <Return> {
+ global Browser_KindOfSearch
+ set tt [winfo toplevel %W]
+ [$tt.result subwidget listbox] delete 0 end
+ BrowserSearch [$tt.result subwidget listbox]
+ }
+ }
+
+ bind [$win.wsearch.result subwidget listbox] <ButtonRelease-1> {
+ global Browser_win Browser_KindOfSearch
+
+ if {$Browser_KindOfSearch == 1} {
+ set win [winfo toplevel %W]
+ set hlist [$win.result subwidget listbox]
+ set ind [$hlist curselection]
+
+ if {$ind != ""} {
+ set class [$hlist get $ind]
+ catch {
+ if {[msclinfo -t $class] != ""} {
+ Browser_UpdateAll $class
+ }
+ }
+ }
+ } elseif {$Browser_KindOfSearch == 2} {
+ set win [winfo toplevel %W]
+ set hlist [$win.result subwidget listbox]
+ set ind [$hlist curselection]
+
+ if {$ind != ""} {
+ set meth [$hlist get $ind]
+ set pos [expr {[string first ":" $meth] - 1}]
+ set class [string range $meth 0 $pos]
+ Browser_UpdateAll $class
+ DisplayMethodInfo $meth
+ }
+ }
+ }
+
+
+ return $win.wsearch.result.listbox
+}
+
+proc BrowserSearchClasses {where lookingfor} {
+ set lstpk [msinfo -p]
+ set lstpk [lsort $lstpk]
+
+ foreach p $lstpk {
+ set lstcl [mspkinfo -c $p]
+ set lstcl [lsort $lstcl]
+
+ foreach c $lstcl {
+ if {[string match $lookingfor $c]} {
+ $where insert end "${p}_$c"
+ }
+ }
+ }
+}
+
+proc BrowserSearchMethods {where lookingfor} {
+ set lstpk [msinfo -p]
+ set lstpk [lsort $lstpk]
+ set lookingformet "*:${lookingfor}(*"
+
+ foreach p $lstpk {
+ set lstcl [mspkinfo -c $p]
+ set lstcl [lsort $lstcl]
+
+ foreach c $lstcl {
+ set cl "${p}_$c"
+
+ if {[msclinfo -e $cl] == 0} {
+ set lstmet [msclinfo -m $cl]
+ foreach m $lstmet {
+ if {[string match $lookingformet $m]} {
+ $where insert end $m
+ }
+ }
+ }
+ }
+ }
+}
+
+###########################################################################
+# Search instantiations
+#
+proc BrowserSearchInstDestroyWin {win} {
+ global Browser_Menu Browser_packinfo
+
+ destroy $win
+ $Browser_Menu.windows.options delete $Browser_packinfo(winst)
+}
+
+proc BrowserSearchInst {win} {
+ global Browser_Menu Browser_packinfo Browser_SearchInstInst
+
+ if {[winfo exist $win.winst] == 0} {
+ toplevel $win.winst
+ $Browser_Menu.windows.options add command -label "Instantiations" -command "raise $win.winst"
+ set Browser_packinfo(winst) [$Browser_Menu.windows.options index last]
+ wm title $win.winst "Instantiations"
+ wm geometry $win.winst 400x600+100+100
+
+ button $win.winst.menubar -state disabled -relief raise
+ menubutton $win.winst.menubar.menu1 -menu $win.winst.menubar.menu1.options -text "File"
+ menu $win.winst.menubar.menu1.options
+ $win.winst.menubar.menu1.options add command -label "Close" -command "BrowserSearchInstDestroyWin $win.winst"
+
+ label $win.winst.lab1 -text "Generic classes :"
+ label $win.winst.lab2 -text "Instantiates :"
+ tixScrolledListBox $win.winst.gen
+ set hlist [$win.winst.gen subwidget listbox]
+ $hlist configure -exportselection 0
+ tixScrolledListBox $win.winst.inst
+ set hlist [$win.winst.inst subwidget listbox]
+ $hlist configure -exportselection 0
+
+ set Browser_SearchInstInst [$win.winst.inst subwidget listbox]
+
+ tixForm $win.winst.menubar -top 0 -left 0 -right -0
+ tixForm $win.winst.menubar.menu1 -top 0 -left 0
+ tixForm $win.winst.lab1 -top $win.winst.menubar -left 2
+ tixForm $win.winst.gen -top $win.winst.lab1 -left 2 -right -2
+ tixForm $win.winst.lab2 -left 2 -top $win.winst.gen
+ tixForm $win.winst.inst -top $win.winst.lab2 -bottom -0 -left 2 -right -2
+
+ set lstpk [msinfo -p]
+ set lstpk [lsort $lstpk]
+ set insertlist [$win.winst.gen subwidget listbox]
+ foreach p $lstpk {
+ set lsttype [mspkinfo -c $p]
+ set lsttype [lsort $lsttype]
+
+ foreach t $lsttype {
+ if {[msclinfo -t "${p}_$t"] == "genclass"} {
+ $insertlist insert end "${p}_$t"
+ }
+ }
+ }
+
+ bind [$win.winst.gen subwidget listbox] <ButtonRelease-1> {
+ set win [winfo toplevel %W]
+ set hlist [$win.gen subwidget listbox]
+ set ind [$hlist curselection]
+
+ if {$ind != ""} {
+ set class [$hlist get $ind]
+ BrowserSearchInstSearch $class
+ }
+ }
+ bind [$win.winst.inst subwidget listbox] <ButtonRelease-1> {
+ set win [winfo toplevel %W]
+ set hlist [$win.inst subwidget listbox]
+ set ind [$hlist curselection]
+
+ if {$ind != ""} {
+ set class [$hlist get $ind]
+ Browser_UpdateAll $class
+ }
+ }
+ }
+}
+
+proc BrowserSearchInstSearch {classe} {
+ global Browser_SearchInstInst
+
+ $Browser_SearchInstInst delete 0 end
+ set test "instclass"
+ set lstpk [msinfo -p]
+ set lstpk [lsort $lstpk]
+
+ foreach p $lstpk {
+ set lsttype [mspkinfo -c $p]
+ set lsttype [lsort $lsttype]
+
+ foreach t $lsttype {
+ if {[msclinfo -t "${p}_$t"] == $test} {
+ if {[msinstinfo -g "${p}_$t"] == $classe} {
+ $Browser_SearchInstInst insert end "${p}_$t"
+ }
+ }
+ }
+ }
+}
+
+
+
--- /dev/null
+proc DependenceTree {w fromud location} {
+ global arrayofud arrayoftk lsttk nbud arrayofimpl
+
+ set lsttk [w_info -k $location]
+ if {[winfo exist $w]} {
+ destroy $w
+ }
+
+ if {[info exist arrayofud]} {
+ unset arrayofud
+ }
+ if {[info exist arrayoftk]} {
+ unset arrayoftk
+ }
+
+ if {[info exist arrayofimpl]} {
+ unset arrayofimpl
+ }
+
+ set arrayofud(__uu) 0
+ set arrayoftk(__uu) 1
+ set arrayofimpl(__uu) 0
+
+ tixTree $w
+
+ set hlist [$w subwidget hlist]
+ $hlist config -indicator 1 -selectmode single -separator "." -width 30 -drawbranch 1 -indent 30
+ $hlist config -browsecmd [list DependenceTree_BrowseCommand $location] ;# Yan
+
+ tixForm $w -left 0 -right -0 -top 0 -bottom -0
+ DependenceTree_fillarb $w $fromud $fromud 0 $location
+ $w autosetmode
+ set popu [tixPopupMenu $w.poph]
+ $popu configure -postcmd [list DependenceTree_PostCommand $popu $w]
+ $popu subwidget menu configure -font [tix option get fixed_font]
+ $popu subwidget menubutton configure -font [tix option get fixed_font]
+ $popu bind $hlist
+
+ return $arrayofud(__uu)
+}
+;# Yan
+proc DependenceTree_BrowseCommand { location item } {
+ if { "[info procs wokPROP:BrowseArb]" != "" } {
+ wokPROP:BrowseArb $location $item
+ }
+ return
+}
+
+
+proc DependenceTree_PostCommand {popu w x y} {
+ global arrayofimpl arrayofud
+
+ set men [$popu subwidget menu]
+ set hlist [$w subwidget hlist]
+ $hlist anchor clear
+ $hlist selection clear
+
+ set Y [expr $y - [winfo rooty $w]]
+ set nearest [$hlist nearest $Y]
+ set last [$men index last]
+
+ if {"$last" != "none"} {
+ for {set i 0} {$i <= $last} {incr i} {
+ $men delete $i
+ }
+ }
+
+ set lstnear [split $nearest .]
+ set udname [lindex $lstnear end]
+
+ if {$udname != ""} {
+ set lstimpl $arrayofimpl($udname)
+ $popu subwidget menubutton configure -text "$udname Suppliers"
+ set txtmen ""
+ foreach allud $lstimpl {
+ if {[info exist arrayofud($allud)]} {
+ set txtmen "$allud \[$arrayofud($allud)\] "
+ } else {
+ set txtmen "$allud Suppliers"
+ }
+ $men add comm -lab $txtmen
+ }
+ } else {
+ return 0
+ }
+ update
+
+ return 1
+}
+
+proc DependenceTree_getunittk { pkname location } {
+ global lsttk arrayoftk arrayofimpl
+ set returnud ""
+
+ if {![info exist arrayoftk($pkname)]} {
+ foreach atk $lsttk {
+ if {![info exist arrayoftk($atk)]} {
+ set pkfile [woklocate -p ${atk}:PACKAGES: $location]
+ set arrayoftk($atk) 1
+ if {[clength $pkfile]} {
+ set lst {}
+ for_file udintk $pkfile {
+ set arrayoftk($udintk) $atk
+ set lst [append lst " $udintk "]
+ }
+ set arrayoftk($atk) $lst
+ set arrayofimpl($atk) $lst
+ }
+ }
+ if {[info exist arrayoftk($pkname)]} {
+ return $arrayoftk($pkname)
+ }
+ }
+ } else {
+ set returnud $arrayoftk($pkname)
+ }
+
+ return $returnud
+}
+
+proc DependenceTree_fillarb {w fromud path fromtoolkit location} {
+ global arrayofud arrayoftk arrayofimpl
+ set curud $fromud
+
+
+ set hlist [$w subwidget hlist]
+ set arrayofud($curud) [DependenceTree_getunittk $curud $location]
+ set txt ""
+ set ifile ""
+ set bug [woklocate -u $fromud $location]
+ set istoolkit ""
+ set isinithere 0
+
+ if {"$bug" != ""} {
+ set istoolkit [uinfo -t $bug]
+ }
+
+
+ if {$arrayofud($curud) != "" && $istoolkit != "toolkit" && $fromtoolkit == 0} {
+ set testtname $arrayofud($curud)
+ # puts "TOOLKIT : $testtname - $fromud"
+ if {![info exist arrayofud($testtname)]} {
+ # puts "$bug == $istoolkit - $arrayofud($curud) - $fromtoolkit"
+ set ifile $arrayoftk($testtname)
+ set curud $arrayofud($curud)
+
+ set arrayofud($curud) $curud
+ set txt $curud
+
+ # si l'ud racine est dans un toolkit
+ set tofollow ""
+ if {![$hlist info exist $path]} {
+ set tofollow $curud
+ } else {
+ set tofollow ${path}.$curud
+ }
+
+ # puts "TOOL ${tofollow} : $txt"
+ $hlist add ${tofollow} -text "$txt ($fromud)"
+ $hlist see ${tofollow}
+ update
+ incr arrayofud(__uu)
+
+ if {[llength $ifile] == 0} {
+ puts "Warning: no PACKAGES file in toolkit $curud"
+ return
+ }
+
+ foreach allud $ifile {
+ set udtxt "$allud"
+ if {$allud != ""} {
+ if {$allud == $fromud} {
+ unset arrayofud($fromud)
+ set udtxt "$udtxt *"
+ }
+ DependenceTree_fillarb $w $allud ${tofollow} 1 $location
+
+ if {![$hlist info exist ${tofollow}.$allud]} {
+ $hlist add ${tofollow}.$allud -text "$udtxt"
+ $hlist see ${tofollow}.$allud
+ update
+ incr arrayofud(__uu)
+ }
+ }
+ }
+ }
+ } else {
+ set ifile ""
+ set lstofimpl {}
+
+ if {![info exist arrayofimpl($curud)]} {
+ set ifile [woklocate -p ${curud}:stadmfile:${curud}.ImplDep $location]
+ if {$ifile != ""} {
+ for_file allud $ifile {
+ if {$allud != $curud} {
+ lappend lstofimpl $allud
+ }
+ }
+ }
+ set arrayofimpl($curud) $lstofimpl
+ } else {
+ set lstofimpl $arrayofimpl($curud)
+ }
+ set txt "$curud"
+
+ if {$curud != $path} {
+ $hlist add ${path}.$curud -text $txt
+ $hlist see ${path}.$curud
+ set tofollow ${path}.$curud
+ update
+ incr arrayofud(__uu)
+ } else {
+ $hlist add ${path} -text $txt
+ $hlist see ${path}
+ set tofollow ${path}
+ update
+ incr arrayofud(__uu)
+ }
+
+ if {$lstofimpl == {}} {
+ puts "Warning: no ImplDep file for $curud"
+ return
+ }
+
+
+ foreach allud $lstofimpl {
+ # puts "$fromud $allud $tofollow"
+
+ if {![info exist arrayofud($allud)]} {
+ if {$allud != $curud} {
+ DependenceTree_fillarb $w $allud $tofollow 0 $location
+ }
+ }
+ }
+ }
+}
--- /dev/null
+;# This procedure is called when using the command:
+;#
+;# wnews -x -from label1 -to label2 -command wnews:cpwb -usedata w1,w2,[,ulist,notes]
+;#
+;# It has been designed to update the workbench w2 from workbench w1 with units and files
+;# modified in w1 between the integrations named label1 and label2.
+;# If ulist is specified only units listed in this file are processed.
+;# If notes is specified all comments are written in this file.
+;#
+;# ((((((((((((((( W A R N I N G )))))))))))))))
+
+proc wnews:cpwb { comments table args } {
+ upvar $table MYTABLE
+
+ set userargs [split $args ,]
+ set from_wb [lindex $userargs 0] ;# The origine workbench
+ set dest_wb [lindex $userargs 1] ;# The target workbench
+ set file_ud [lindex $userargs 2] ;# The List of units to be processed in the origine workbench
+ set rnotes [lindex $userargs 3] ;# The file to receive the release notes.
+
+ if { $from_wb == {} || $dest_wb == {} } {
+ puts stderr "news:cpwb: Error : Need at least 2 workbenches name"
+ puts stderr "Append this to your command :"
+ puts stderr { -userdata fac:shop:wbfrom,fac:shop:wbto,myfile.dat }
+ return 0
+ }
+
+ if ![file exists $file_ud] {
+ set list_ud [w_info -l $from_wb]
+ msgprint -i "proc wnews:cpwb: Info : will process all units in $from_wb"
+ } else {
+ set list_ud [wokUtils:FILES:FileToList $file_ud]
+ if { $list_ud == {} } {
+ msgprint -e "wnews:cpwb File $file_ud is empty. Nothing done"
+ return
+ } else {
+ msgprint -i "wnews:cpwb Copy from $from_wb to $dest_wb units in file $file_ud "
+ }
+ }
+
+ if { $rnotes != {} } {
+ wokUtils:FILES:ListToFile [split $comments \n] $rnotes
+ msgprint -i "wnews:cpwb: Info : File $rnotes created will all comments."
+ }
+
+ if ![wokinfo -x $dest_wb] {
+ msgprint -e "wnews:cpwb: The workbench $dest_wb does not exists."
+ return
+ }
+
+ 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]
+ if { [lsearch $list_ud $name] != -1 } {
+ set type [lindex $x 1]
+ lappend l_ud $name
+ if { [lsearch $l_fab $name] == -1 } {
+ msgprint -i "ucreate -${type} ${dest_wb}:${name}"
+ 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 } {
+ if [file exists $from_src/$file] {
+ msgprint -i "Copying $from_src/$file to $dest_src/$file"
+ catch {exec cp $from_src/$file $dest_src/$file}
+ catch {exec chmod 0644 $dest_src/$file}
+ lappend l_file $file
+ } else {
+ msgprint -w "File $from_src/$file not copied. File not found"
+ }
+ }
+ }
+
+ Added {
+ 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 } {
+ if [file exists $from_src/$file] {
+ msgprint -i "Copying $from_src/$file to $dest_src/$file"
+ catch {exec cp -f $from_src/$file $dest_src/$file}
+ catch {exec chmod 0644 $dest_src/$file}
+ lappend l_file $file
+ } else {
+ msgprint -w "File $from_src/$file not copied. File not found"
+ }
+ }
+ }
+
+ Deleted {
+ }
+ }
+ }
+ }
+ }
+ return 1
+}
--- /dev/null
+
+proc iwokUsage { } {
+ puts stderr {Usage : iwok [-fh] }
+ puts stderr ""
+ puts stderr { iwok -f : Fast start. Set current location to the session }
+ puts stderr ""
+ return
+}
+
+proc iwok { args } {
+
+ global IWOK_GLOBALS
+ global env
+
+ if { [lsearch $args -h] != -1 } {
+ iwokUsage
+ return
+ }
+
+ set fast 0
+ if { [lsearch $args -f] != -1 } { set fast 1 }
+
+ catch {wokKillAll}
+
+ if {[wokparam -e %Station] == "lin"} {
+ package ifneeded Tk 8.0 "load [list /usr/lib/libtk8.0.so]"
+ }
+ package require Tk
+
+ package require Tix
+
+ set IWOK_GLOBALS(windows) {}
+ set IWOK_GLOBALS(toplevel) .wok[join [split [id user][id host] .] _]
+ set IWOK_GLOBALS(toplevel,geometry) 1200x80+10+30
+ set IWOK_GLOBALS(toplevel,closed) 1200x80
+ set IWOK_GLOBALS(toplevel,opened) 1200x800
+ set IWOK_GLOBALS(user_pwd) [pwd]
+ set IWOK_GLOBALS(windows,rect) 950x450+4000+40
+ set IWOK_GLOBALS(windows,barr) 198x971+1063+38
+ set IWOK_GLOBALS(canvas,width) 1500
+ set IWOK_GLOBALS(canvas,height) 1200
+ set IWOK_GLOBALS(order) 1
+ set IWOK_GLOBALS(term,started) 0
+ tix addbitmapdir [set IWOK_GLOBALS(maps) $env(WOK_LIBRARY)]
+ set IWOK_GLOBALS(layout) 0
+ set IWOK_GLOBALS(layout,update) 1
+ set IWOK_GLOBALS(font) [tix option get fixed_font]
+ set IWOK_GLOBALS(boldfont) [tix option get bold_font]
+
+ ;#tix addbitmapdir /adv_23/WOK/k3dev/ref/src/WOKTclLib ;# THUY EM
+ ;#tix addbitmapdir /adv_23/WOK/k3dev/iwok/src/WOKTclLib ;# THUY EM
+
+ ;# ucreate -P dans factory/workshop/ => erreur ?!!!
+ set IWOK_GLOBALS(ucreate-P) [list {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 type $IWOK_GLOBALS(ucreate-P) {
+ set st [lindex $type 0]
+ set lt [lindex $type 1]
+ set IWOK_GLOBALS(image,$st) [set IWOK_GLOBALS(image,$lt) [tix getimage $lt]]
+ set IWOK_GLOBALS(S_L,$st) $lt
+ set IWOK_GLOBALS(L_S,$lt) $st
+ }
+
+ wm withdraw .
+ toplevel $IWOK_GLOBALS(toplevel)
+ wm title $IWOK_GLOBALS(toplevel) "WOK ( [id user] ) on host [id host]"
+ wm geometry $IWOK_GLOBALS(toplevel) $IWOK_GLOBALS(toplevel,geometry)
+
+ ;#wokInitPalette black white orange blue
+ wokInitPalette
+
+ set IWOK_GLOBALS(toplevel,fg) [option get $IWOK_GLOBALS(toplevel) foreground {}]
+
+ wokEDF:InitAdequateCommand
+ wokEDF:InitExtension
+
+ eval "proc WOK_DoWhenIdle {} {update}"
+
+ auto_load wokMessageInText
+ wokBuild $fast
+ return
+}
+
+proc wokInitPalette { {bgcolor grey51} {fgcolor white} {ycolor yellow} {bkcol black} } {
+ tk_setPalette background $bgcolor foreground $fgcolor
+ option add *background $bgcolor
+ option add *activeBackground $bgcolor
+ option add *highlightBackground $bgcolor
+ option add *foreground $ycolor
+ option add *activeForeground $fgcolor
+ option add *highlightColor $fgcolor
+ option add *troughColor $bgcolor
+ option add *selectBackground $ycolor
+ option add *selectForeground $bgcolor
+ option add *insertBackground $bkcol
+}
+
+
+proc wokTPL { string } {
+ regsub -all {[:.]} $string "" w
+ return .[string tolower $w]
+}
+
+
+proc wokKillAll { } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+
+ destroy $IWOK_GLOBALS(toplevel)
+
+ msgunsetcmd
+ if [winfo exists $IWOK_GLOBALS(toplevel)] {
+ foreach child [ tixDescendants $IWOK_GLOBALS(toplevel) ] {
+ if [winfo exists $child] {
+ destroy $child
+ }
+ }
+ }
+
+ foreach ws [wokButton listw] {
+ foreach tpl [lindex $ws 1] {
+ catch { destroy $tpl }
+ }
+ }
+
+ cd $IWOK_GLOBALS(user_pwd)
+ catch { unset IWOK_WINDOWS }
+ catch { unset IWOK_GLOBALS }
+ return
+}
--- /dev/null
+proc wokCreate { dir loc {asked_type {}} } {
+ global IWOK_GLOBALS
+
+ if ![wokinfo -x $loc] return
+
+ set mw .wokcreate
+ if [winfo exists $mw] {
+ destroy $mw
+ }
+
+ toplevel $mw
+ wm geometry $mw +60+120
+
+ set ent_type {}
+ if { $asked_type == {} } {
+ set tab([set tab([set tab([set tab(factory) workshop]) workbench]) devunit]) description
+ set ent_type $tab([wokinfo -t $loc])
+ } else {
+ set ent_type $asked_type
+ }
+
+
+ set IWOK_GLOBALS(scratch) {}
+
+ tixLabelFrame $mw.f -relief raised
+ pack $mw.f -expand yes -fill both -padx 1 -pady 1
+
+ set w [$mw.f subwidget frame]
+
+ set img [label $w.img]
+
+ tixLabelEntry $w.e -label "Name: " \
+ -options {
+ entry.width 20
+ entry.textVariable IWOK_GLOBALS(scratch)
+ }
+
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 \
+ -command [list wokCreate:action $mw $dir $loc $ent_type] -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $mw" -width 6
+
+ bind [$w.e subwidget entry] <Return> {
+ focus [[[winfo toplevel %W].f subwidget frame].box subwidget ok]
+ }
+
+ switch $ent_type {
+
+ factory {
+ }
+
+ devunit {
+ $mw.f configure -label "Adding a unit in $loc."
+ tixOptionMenu $w.qt -command wokCreate:SetType -label "Type : "
+ set mbu [$w.qt subwidget menubutton]
+ foreach I [linsert $IWOK_GLOBALS(ucreate-P) end {z Zfile...}] {
+ $w.qt add command "$I $mbu" -label [lindex $I 1]
+ }
+ $w.qt subwidget menubutton configure -height 25 -width 136
+ tixForm $w.e -top 20
+ tixForm $w.qt -top $w.e -left 2 -bottom $w.box
+ }
+
+ workbench {
+ tixBusy $mw on
+ set image [tix getimage workbench]
+ $img configure -image $image
+ $mw.f configure -label "Adding a workbench in $loc."
+ set tree [tixTree $w.tree -options {hlist.separator "^" hlist.selectMode single }]
+ $tree config -browsecmd [list wokWbtree:UpdLab $tree]
+ set hli [$tree subwidget hlist]
+ set father [wokWbtree:LoadSons $loc [wokinfo -p WorkbenchListFile $loc]]
+ $hli delete all
+ $hli add ^
+ update
+ tixComboBox $w.fh -label "Father:" -variable IWOK_GLOBALS(scratch,father)
+ set IWOK_GLOBALS(scratch,father) $father
+ foreach ww [sinfo -w $loc] {
+ $w.fh insert end $ww
+ }
+ $w.box add shotree -text "Show Tree" -underline 0 -width 8 \
+ -command [list wokWbtree:Tree $tree $hli "" $father $image]
+ tixForm $w.tree -left 2 -right %99 -top 20 -bottom $w.e
+ tixForm $w.e -bottom $w.fh
+ tixForm $w.fh -bottom $w.box
+ tixBusy $mw off
+ }
+
+ workshop {
+ $img configure -image [tix getimage workshop]
+ $mw.f configure -label "Adding a workshop in $loc."
+ tixForm $img -left 2 -right %99 -top 8
+ tixForm $w.e -top $img -bottom $w.box
+ }
+
+ }
+ tixForm $w.box -left 2 -right %99 -bottom %99
+
+ return
+}
+#
+# ent est l'adresse dans la hlist
+#
+proc wokWbtree:UpdLab { tree ent } {
+ global IWOK_GLOBALS
+ set hli [$tree subwidget hlist]
+ set IWOK_GLOBALS(scratch,father) [$hli info data $ent]
+ return
+}
+
+proc wokWbtree:Tree { tree hli ent name ima } {
+ if {![$hli info exists ${ent}^${name}] } {
+ $hli add ${ent}^${name} -itemtype imagetext -text $name -image $ima -data $name
+ update
+ }
+ set lson [wokWbtree:GetSons $name]
+ foreach son $lson {
+ if { "$son" != "$name" } {
+ if {![$hli info exists ${ent}^${name}^${son}] } {
+ $hli add ${ent}^${name}^${son} -itemtype imagetext -text $son -image $ima -data $son
+ wokWbtree:Tree $tree $hli ${ent}^${name} $son $ima
+ }
+ }
+ }
+ return
+}
+
+proc wokWbtree:GetSons { wb } {
+ if { [info procs ${wb}.woksons] != {} } {
+ return [eval ${wb}.woksons]
+ } else {
+ return {}
+ }
+}
+
+proc wokWbtree:LoadSons { ent WBLIST } {
+ catch {unset TLOC}
+ if [ file exists $WBLIST ] {
+ set f [ open $WBLIST r ]
+ while {[gets $f line] >= 0} {
+ set ll [split $line]
+ set son [lindex $ll 0]
+ set dad [lindex $ll 1]
+ if { $dad != {} } {
+ if { ![info exists TLOC($dad)] } {
+ set TLOC($dad) $son
+ } else {
+ set ii $TLOC($dad)
+ lappend ii $son
+ set TLOC($dad) $ii
+ }
+ } else {
+ set TLOC($son) {}
+ set root $son
+ }
+ }
+ close $f
+ } else {
+ set root {}
+ }
+ foreach x [array names TLOC] {
+ eval "proc $x.woksons {} { return [list $TLOC($x)] }"
+ }
+ return $root
+}
+
+proc wokCreate:action { w dir loc cmd } {
+ global IWOK_GLOBALS
+
+ tixBusy $w on
+ update
+ if { $IWOK_GLOBALS(scratch) != {} } {
+
+ switch $cmd {
+
+ factory {
+ }
+
+ devunit {
+ if ![ catch { ucreate -$IWOK_GLOBALS(scratch,wokType) ${loc}:$IWOK_GLOBALS(scratch) } helas ] {
+ wbuild:Update
+ set s $IWOK_GLOBALS(scratch,wokType)
+ set type $IWOK_GLOBALS(S_L,$s)
+ wokNAV:Initdevunit ${loc}
+ wokNAV:Tree:Add $dir ${loc}:$IWOK_GLOBALS(scratch) $IWOK_GLOBALS(scratch) $type
+ } else {
+ puts stderr "$helas"
+ }
+ }
+
+ workbench {
+ if { [string compare $IWOK_GLOBALS(scratch,father) -] == 0 } {
+ if ![ catch { wcreate -d $IWOK_GLOBALS(scratch)} helas ] {
+ wokNAV:Tree:Add $dir ${loc}:$IWOK_GLOBALS(scratch) $IWOK_GLOBALS(scratch) $cmd
+ } else {
+ puts stderr "$helas"
+ }
+ } else {
+ set father ${loc}:$IWOK_GLOBALS(scratch,father)
+ if ![ catch { wcreate -f $father -d ${loc}:$IWOK_GLOBALS(scratch)} helas ] {
+ wokNAV:Tree:Add $dir ${loc}:$IWOK_GLOBALS(scratch) $IWOK_GLOBALS(scratch) $cmd
+ } else {
+ puts stderr "$helas"
+ }
+ }
+ }
+
+ workshop {
+ if ![ catch { screate -d ${loc}:$IWOK_GLOBALS(scratch)} helas ] {
+ wokNAV:Tree:Add $dir ${loc}:$IWOK_GLOBALS(scratch) $IWOK_GLOBALS(scratch) $cmd
+ } else {
+ puts stderr "$helas"
+ }
+ }
+
+ }
+ set IWOK_GLOBALS(scratch) {}
+ }
+ tixBusy $w off
+ destroy $w
+ return
+}
+
+proc wokCreate:SetType { string } {
+ global IWOK_GLOBALS
+ regexp {(.*) (.*) (.*)} $string ignore IWOK_GLOBALS(scratch,wokType) longname w
+ if { [string compare $IWOK_GLOBALS(scratch,wokType) z] != 0 } {
+ set img [image create compound -window $w]
+ $img add text -text $longname -underline 0
+ $img add image -image [tix getimage $longname]
+ $w config -image $img
+ } else {
+ wokCreate:Zfile $w
+ }
+ return
+}
+
+proc wokCreate:Zfile { ww } {
+ global IWOK_GLOBALS
+ global IWOK_WINDOWS
+ set w [winfo toplevel $ww]
+ foreach f [winfo children $w] {
+ destroy $f
+ }
+ set fact [Sinfo -f]
+ wm geometry $w 972x551
+ 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 wokCreate:ZKill $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 10 -pady 10
+
+ set p1 [$w.top.pane add tree -min 70 -size 250]
+ set p2 [$w.top.pane add text -min 70]
+
+ set tree [tixTree $p1.tree -options {separator "^" hlist.selectMode single}]
+ $tree config -browsecmd "wokCreate:ZBrowse $w $tree" \
+ -opencmd "wokCreate:ZOpen $w $tree" \
+ -closecmd "wokCreate:ZClose $w $tree"
+
+ tixScrolledText $p2.text ;
+ set texte [$p2.text subwidget text]
+ $texte config -font $IWOK_GLOBALS(font)
+
+ pack $p1.tree -expand yes -fill both -padx 1 -pady 1
+ pack $p2.text -expand yes -fill both -padx 1 -pady 1
+
+ tixButtonBox $w.but -orientation horizontal -relief flat -padx 0 -pady 0
+ set but [list \
+ {download "DownLoad" disabled wokCreate:DownLoad} \
+ {list "List contents" disabled wokCreate:List} ]
+
+ foreach b $but {
+ $w.but add [lindex $b 0] -text [lindex $b 1]
+ [$w.but subwidget [lindex $b 0]] configure -state [lindex $b 2] -command [list [lindex $b 3] $w]
+ }
+
+ tixForm $w.file
+ ;#tixForm $w.help -right -2
+ tixForm $w.top -top $w.file -left 2 -right %99 -bottom $w.but
+ tixForm $w.but -left 2 -bottom %99
+ tixForm $w.lab -left $w.but -right %99 -bottom %99
+
+ set IWOK_WINDOWS($w,hlist) [$tree subwidget hlist]
+ set IWOK_WINDOWS($w,text) $texte
+ set IWOK_WINDOWS($w,bag) [wokinfo -f]:[finfo -W $fact]
+ set IWOK_WINDOWS($w,curwb) [wokinfo -w]
+ set IWOK_WINDOWS($w,label) $w.lab
+ set IWOK_WINDOWS($w,button) $w.but
+
+ set hlist [$tree subwidget hlist]
+ $hlist delete all
+ set image [tix getimage parcel]
+
+ set bag $IWOK_WINDOWS($w,bag)
+ set LB [Winfo -p $bag]
+ foreach parcel $LB {
+ if ![$IWOK_WINDOWS($w,hlist) info exists ${parcel}] {
+ $IWOK_WINDOWS($w,hlist) add ${parcel} -itemtype imagetext -text $parcel -image $image \
+ -data [list P $bag $parcel]
+ $tree setmode ${parcel} open
+ }
+ }
+ return
+}
+
+proc wokCreate:ZClose { w tree ent } {
+ set hlist [$tree subwidget hlist]
+ foreach kid [$hlist info children $ent] {
+ $hlist hide entry $kid
+ }
+ $hlist entryconfigure $ent -image [tix getimage parcel]
+ return
+}
+
+proc wokCreate:ZOpen { w tree ent } {
+ global IWOK_WINDOWS
+ global IWOK_GLOBALS
+ set hlist [$tree subwidget hlist]
+
+ tixBusy $w on
+
+ update
+ if {[$hlist info children $ent] == {}} {
+ set data [$hlist info data $ent]
+ switch -- [lindex $data 0] {
+
+ P {
+ set bag [lindex $data 1]
+ set pcl [lindex $data 2]
+ foreach unit [pinfo -a ${bag}:${pcl}] {
+ set type [lindex $unit 0]
+ set name [lindex $unit 1]
+ $hlist add ${ent}^${name} -itemtype imagetext -text $name \
+ -image $IWOK_GLOBALS(image,$type) \
+ -data $bag:${pcl}:$name
+ }
+ }
+ }
+ }
+ foreach kid [$hlist info children $ent] {
+ $hlist show entry $kid
+ }
+ $hlist entryconfigure $ent -image [tix getimage delivery]
+ tixBusy $w off
+ return
+}
+
+proc wokCreate:ZBrowse { w tree args } {
+ global IWOK_WINDOWS
+ set hlist [$tree subwidget hlist]
+ set sc [split $args ^]
+ set lsc [llength $sc]
+
+ if { $lsc == 1 } {
+ return
+ }
+
+ set ent [$hlist info anchor]
+ if {$ent == ""} {
+ return
+ }
+
+ set kid [$hlist info children $ent]
+ if {$kid == {} } {
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ set Zf [wokCreate:Zsearch [uinfo -Fp -Tsource [$hlist info data $ent]]]
+ if { [set IWOK_WINDOWS($w,Zpath) $Zf] != {} } {
+ set IWOK_WINDOWS($w,Zpath) $Zf
+ if [info exists IWOK_WINDOWS($w,Zwork)] {
+ catch {unlink $IWOK_WINDOWS($w,Zwork)}
+ }
+ set IWOK_WINDOWS($w,Zwork) [wokUtils:FILES:SansZ $IWOK_WINDOWS($w,Zpath)]
+ $IWOK_WINDOWS($w,button) subwidget download configure -state active
+ $IWOK_WINDOWS($w,button) subwidget list configure -state active
+ } else {
+ $IWOK_WINDOWS($w,label) configure -text "This unit has no Z file"
+ $IWOK_WINDOWS($w,button) subwidget download configure -state disabled
+ $IWOK_WINDOWS($w,button) subwidget list configure -state disabled
+ }
+ }
+ return
+}
+
+proc wokCreate:DownLoad { w } {
+ global IWOK_GLOBALS
+ global IWOK_WINDOWS
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ tixBusy $w on
+ update
+ msgsetcmd wokMessageInText $IWOK_WINDOWS($w,text)
+ if ![info exists IWOK_WINDOWS($w,Zwork)] {
+ set IWOK_WINDOWS($w,Zwork) [wokUtils:FILES:SansZ $IWOK_WINDOWS($w,Zpath)]
+ }
+ set Z $IWOK_WINDOWS($w,Zwork)
+ set lnam [split [file tail $Z] .]
+ set udname [lindex $lnam 0]
+ set tyname [lindex $lnam 1]
+ set l_units [w_info -l $IWOK_WINDOWS($w,curwb)]
+ if { [lsearch $l_units $udname] != -1 } {
+ set retval [wokDialBox .wokcd {Already exists } \
+ "The $tyname $udname already exists in $IWOK_WINDOWS($w,curwb)" \
+ warning 1 {Overwrite} {Abort}]
+ if { $retval } {
+ $IWOK_WINDOWS($w,label) configure -text "Abort..."
+ msgunsetcmd
+ tixBusy $w off
+ return
+ }
+ }
+
+ if ![info exists retval] {
+ msgprint -i "Creating $tyname $udname in $IWOK_WINDOWS($w,curwb)"
+ if [catch { ucreate -$IWOK_GLOBALS(L_S,$tyname) $IWOK_WINDOWS($w,curwb):$udname }] {
+ msgprint -e "Unable to create $tyname $udname in $IWOK_WINDOWS($w,curwb)"
+ msgunsetcmd
+ tixBusy $w off
+ return
+ }
+ }
+
+ set savloc [wokcd]
+ wokcd $IWOK_WINDOWS($w,curwb):$udname
+ catch { upack -v -r $Z }
+ msgunsetcmd
+ wokcd $savloc
+
+ if [info exists IWOK_WINDOWS($w,Zwork)] {
+ catch {unlink $IWOK_WINDOWS($w,Zwork)}
+ unset IWOK_WINDOWS($w,Zwork)
+ }
+
+ tixBusy $w off
+ return
+}
+
+proc wokCreate:List { w } {
+ global IWOK_WINDOWS
+ $IWOK_WINDOWS($w,text) delete 1.0 end
+ if [info exists IWOK_WINDOWS($w,Zwork)] {
+ tixBusy $w on
+ update
+ puts "1"
+ msgsetcmd wokMessageInText $IWOK_WINDOWS($w,text)
+ puts "2 $IWOK_WINDOWS($w,Zwork)"
+ upack -l $IWOK_WINDOWS($w,Zwork)
+ puts "3"
+ msgunsetcmd
+ $IWOK_WINDOWS($w,label) configure -text "Contents of file $IWOK_WINDOWS($w,Zpath)"
+ tixBusy $w off
+ }
+ return
+}
+
+proc wokCreate:ZKill { w } {
+ global IWOK_WINDOWS
+ if [info exists IWOK_WINDOWS($w,Zwork)] {
+ catch {unlink $IWOK_WINDOWS($w,Zwork)}
+ }
+ foreach v [array names IWOK_WINDOWS $w,*] {
+ unset IWOK_WINDOWS($v)
+ }
+ destroy $w
+ return
+}
+
+proc wokCreate:Zsearch { l } {
+ foreach f $l {
+ if { "[file extension [lindex $f 1]]" == ".Z" } {
+ return [lindex $f 2]
+ }
+ }
+ return {}
+}
--- /dev/null
+
+
+proc wok_interp_command { format } {
+
+ switch $format {
+ csh {
+ return [list "/usr/bin/csh -f" ]
+ }
+ tcl {
+ return [list "/usr/tcltk/bin/tclsh" ]
+ }
+ ksh {
+ return [list "/usr/bin/ksh" ]
+ }
+ sh {
+ return [list "/usr/bin/sh" ]
+ }
+ cmd {
+ return [list "cmd.exe" ]
+ }
+ default {
+ error "Invalid format $format"
+ }
+ }
+
+}
+
+
+proc wok_interp_setprompt_cmd { format string } {
+
+ switch $format {
+ csh {
+ return [list "set prompt = \"$string\"\n" ]
+ }
+ tcl {
+ return [list "set tcl_prompt1 {puts -nonewline stdout \"$string\"}\n"]
+ }
+ ksh {
+ return [list "PS1=$string\n" ]
+ }
+ sh {
+ return [list "PS1=$string\n" ]
+ }
+ cmd {
+ ## Don't know how to do this
+ return [list "PROMPT $string\n"]
+ }
+ default {
+ error "Invalid format $format"
+ }
+ }
+}
+
+
+
+proc wokinterp_create_shell {format} {
+ global WOK_GLOBALS spawn_id ;
+
+ eval spawn [lindex [wok_interp_command $format] 0]
+
+ set WOK_GLOBALS(wokinterp,$format,id) $spawn_id
+
+ set WOK_GLOBALS(wokinterp,$format,prompt) [format "%s: " $format]
+
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) -- [lindex [wok_interp_setprompt_cmd $format $WOK_GLOBALS(wokinterp,$format,prompt)] 0];
+
+ expect {
+ -i $WOK_GLOBALS(wokinterp,$format,id)
+ -re "$WOK_GLOBALS(wokinterp,$format,prompt)$" {}
+ -re "." {puts -nonewline stdout $expect_out(0,string);exp_continue}
+ }
+
+ wokinterp_follow_wokcd $format;
+}
+
+proc wok_end_shell {format} {
+ global WOK_GLOBALS
+ catch {close $WOK_GLOBALS(wokinterp,$format,id)}
+ unset WOK_GLOBALS(wokinterp,$format,id);
+ unset WOK_GLOBALS(wokinterp,$format,prompt);
+}
+
+proc wokinterp_follow_wokcd {format} {
+ global WOK_GLOBALS
+
+ set WOK_GLOBALS(wokinterp,$format,prompt) [format "%s %s\> " [wokcd] $format]
+
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) -- [lindex [wok_interp_setprompt_cmd $format $WOK_GLOBALS(wokinterp,$format,prompt)] 0];
+ expect -i $WOK_GLOBALS(wokinterp,$format,id) -re "$WOK_GLOBALS(wokinterp,$format,prompt)$" {} -re "." {exp_continue};
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) -- "\n"
+}
+
+proc woksh_usage {} {
+
+ puts stderr "woksh [-format <csh|...>] -setenv"
+}
+
+proc @@ {args} {
+
+ global env;
+
+# if [info exists env(EMACS)] {
+# woksh_emacs [list $args]
+# } {
+ woksh_csh [list $args]
+# }
+}
+proc woksh {args} {
+
+ global env;
+
+# if [info exists env(EMACS)] {
+# woksh_emacs [list $args]
+# } {
+ woksh_csh [list $args]
+# }
+}
+
+proc woksh_csh {args} {
+
+ global WOK_GLOBALS spawn_id user_spawn_id interact_out auto_index
+ if { [llength $args] == 0 } {
+ set format "csh"
+ } {
+ set format [lindex $args 0]
+ }
+
+ log_user 0
+
+ set tblreq(-h) {}
+ set tblreq(-format) value_required:list
+ set tblreq(-setenv) default
+ set tblreq(-view) {}
+
+ ;# Parameters
+ ;#
+ set param {}
+
+ if { [wokUtils:EASY:GETOPT param table tblreq woksh_usage $args] == -1 } return
+
+ if { [info exists table(-h)] } {
+ woksh_usage
+ return
+ }
+
+ if { [info exists table(-format)] } {
+ set format $table(-format)
+ } {
+ set format "csh"
+ }
+
+ set launched "/tmp/wokenv_[id process]_ToLaunch"
+ set LAUNCH [lindex [wok_interp_command $format] 0]
+
+ if { [info exists table(-setenv)] } {
+
+ set thefile "/tmp/wokenv_[id process]_tcl"
+ wokenv -f $thefile -t tcl
+ source $thefile
+
+ set thefile "/tmp/wokenv_[id process]_$format"
+ wokenv -f $thefile -t $format
+
+ if { [catch { set Template [ open $thefile r ] } errout] == 0 } {
+ if { [catch { set Launched [ open $launched w ] } errin] == 0 } {
+ puts $Launched "\#\!/usr/bin/csh -v"
+ copyfile $Template $Launched
+ puts $Launched "[lindex [wok_interp_setprompt_cmd $format [concat [wokcd] $format >]] 0]"
+ puts $Launched "[lindex [wok_interp_command $format] 0]"
+ close $Launched
+ close $Template
+ chmod a+x $launched
+ set LAUNCH $launched
+ }
+ }
+ unlink $thefile
+ }
+
+ msgprint -w -c "woksh_csh" "Emacs mode disabled : use exit to return to tcl"
+ log_user 1
+
+ spawn $LAUNCH
+
+ set WOK_GLOBALS(wokinterp,$format,id) $spawn_id
+
+ exp_send -i $spawn_id -- "\r\n"
+ wokinterp_follow_wokcd $format
+
+ interact $spawn_id {
+ eof {
+ exp_send_user -- "\n"
+ }
+ }
+ wok_end_shell $format
+ unlink $launched
+ return;
+}
+
+
+proc woksh_emacs {args} {
+
+ global WOK_GLOBALS spawn_id user_spawn_id interact_out auto_index
+
+ if { [llength $args] == 0 } {
+ set format "csh"
+ } {
+ set format [lindex $args 0]
+ }
+ log_user 0
+ set tblreq(-h) {}
+ set tblreq(-format) value_required:list
+ set tblreq(-setenv) default
+ set tblreq(-view) {}
+
+ ;# Parameters
+ ;#
+ set param {}
+
+ if { [wokUtils:EASY:GETOPT param table tblreq woksh_usage $args] == -1 } return
+
+ if { [info exists table(-h)] } {
+ woksh_usage
+ return
+ }
+
+ if { [info exists table(-format)] } {
+ set format $table(-format)
+ } {
+ set format "csh"
+ }
+
+ if { ! [info exists WOK_GLOBALS(wokinterp,$format,id)] } then {
+ msgprint -i -c "woksh_emacs" "Emacs mode enabled : use @@ to return to tcl"
+ wokinterp_create_shell $format
+ } {
+ msgprint -i -c "woksh_emacs" "Returning to csh\n"
+ wokinterp_follow_wokcd $format;
+ }
+
+ log_user 1;
+
+ if { [info exists table(-setenv)] } {
+
+ set thefile "/tmp/wokenv_[id process]_tcl"
+
+ wokenv -f $thefile -t tcl
+
+ source $thefile
+
+ unlink $thefile
+
+ set thefile "/tmp/wokenv_[id process]_$format"
+
+ wokenv -f $thefile -t $format
+
+ if { [catch { set Template [ open $thefile r ] } errout] == 0 } {
+
+ while { ! [eof $Template] } {
+ gets $Template theline
+
+ set tooolong 0
+
+ if { [clength $theline] > 100} {
+ set tooolong 1
+
+ set thelongcmdfile "/tmp/wokenv_[id process]_${format}_long"
+
+ if { [catch { set thefd [ open $thelongcmdfile w ] } errout] == 0 } {
+ puts $thefd $theline
+ close $thefd
+ log_user 0;
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) "[lindex [wok_source_cmd $format $thelongcmdfile] 0]\n"
+ unlink $thelongcmdfile
+ }
+
+ while { [clength $theline] > 100} {
+ exp_send_user -- "[crange $theline 0 100]\\\n"
+ set theline [crange $theline 101 [clength $theline]]
+ }
+
+ exp_send_user -- "$theline\n"
+ expect -i $WOK_GLOBALS(wokinterp,$format,id) -re "$WOK_GLOBALS(wokinterp,$format,prompt)$" {} \
+ -re "." {exp_continue};
+ exp_send_user -- "$WOK_GLOBALS(wokinterp,$format,prompt)"
+ log_user 1;
+ } else {
+ log_user 1;
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) "$theline\n"
+ expect -i $WOK_GLOBALS(wokinterp,$format,id) -re "$WOK_GLOBALS(wokinterp,$format,prompt)$" {} \
+ -re "." {exp_continue};
+ }
+
+ }
+ }
+ unlink $thefile
+ }
+ log_user 0;
+
+ if { ! [info exists WOK_GLOBALS(wokinterp,$format,intertacting) ] } {
+
+ set WOK_GLOBALS(wokinterp,$format,intertacting) 1
+
+ set OLD_EMACS_CDSTAT $WOK_GLOBALS(cd_proc,emacs)
+
+ interact {
+ -output $WOK_GLOBALS(wokinterp,$format,id)
+ -exact "@@" {
+ msgprint -i -c "woksh_emacs" "Returning to tcl\n"
+ unset WOK_GLOBALS(wokinterp,$format,intertacting)
+ inter_return;
+ }
+ -exact "exit" {
+ exp_send_user "\n"
+ wok_end_shell $format;
+ unset WOK_GLOBALS(wokinterp,$format,intertacting)
+ return;
+ }
+ -re $WOK_GLOBALS(wokinterp,tclcommands) {
+ set cmd "$interact_out(0,string)"
+ set theargs ""
+ expect_user -re ".*\n" {
+ set theargs "$expect_out(0,string)"
+ }
+ if { [info exists auto_index(:$cmd)] || \
+ [info exists auto_index($cmd)] || \
+ [info commands $cmd] != "" } {
+ if { $cmd == "cd" } {
+ set WOK_GLOBALS(cd_proc,emacs) 0
+ set cmd "wok_cd_proc"
+ }
+ catch "$cmd $theargs" result
+ set WOK_GLOBALS(cd_proc,emacs) $OLD_EMACS_CDSTAT
+ if { $result != "" } {
+ puts $result;
+ }
+ wokinterp_follow_wokcd $format;
+ } {
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) -- "$cmd $theargs";
+ }
+ }
+ "\n" {
+ exp_send -i $WOK_GLOBALS(wokinterp,$format,id) -- "\n";
+ }
+ -input $WOK_GLOBALS(wokinterp,$format,id)
+ eof {
+ exp_send_user -- "\n"
+ wok_end_shell $format;
+ unset WOK_GLOBALS(wokinterp,$format,intertacting)
+ return;
+ }
+ }
+ catch "unset WOK_GLOBALS(wokinterp,$format,intertacting)"
+ }
+ return;
+}
projects / occt-wok.git / commitdiff