From: cas <cas@opencascade.com>
Date: Mon, 6 Mar 2000 17:10:47 +0000 (+0000)
Subject: Initial revision
X-Git-Url: http://git.dev.opencascade.org/gitweb/?a=commitdiff_plain;h=edec5262a8988f97efafde247bcc6a121628c113;p=occt-wok.git

Initial revision
---

diff --git a/src/WOKTclLib/BrowserSearch.tcl b/src/WOKTclLib/BrowserSearch.tcl
new file mode 100755
index 0000000..73de795
--- /dev/null
+++ b/src/WOKTclLib/BrowserSearch.tcl
@@ -0,0 +1,326 @@
+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"
+		}
+	    }
+	}
+    }
+}
+
+
+
diff --git a/src/WOKTclLib/arb.tcl b/src/WOKTclLib/arb.tcl
new file mode 100755
index 0000000..f5e2cdb
--- /dev/null
+++ b/src/WOKTclLib/arb.tcl
@@ -0,0 +1,236 @@
+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
+		}
+	    }
+	}
+    }
+}
diff --git a/src/WOKTclLib/news_cpwb.tcl b/src/WOKTclLib/news_cpwb.tcl
new file mode 100755
index 0000000..ad77a8d
--- /dev/null
+++ b/src/WOKTclLib/news_cpwb.tcl
@@ -0,0 +1,110 @@
+;# 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
+}
diff --git a/src/WOKTclLib/wok.tcl b/src/WOKTclLib/wok.tcl
new file mode 100755
index 0000000..61a7810
--- /dev/null
+++ b/src/WOKTclLib/wok.tcl
@@ -0,0 +1,130 @@
+
+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
+}
diff --git a/src/WOKTclLib/wokCreations.tcl b/src/WOKTclLib/wokCreations.tcl
new file mode 100755
index 0000000..3804406
--- /dev/null
+++ b/src/WOKTclLib/wokCreations.tcl
@@ -0,0 +1,478 @@
+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 {}
+}
diff --git a/src/WOKTclLib/wokinterp.tcl b/src/WOKTclLib/wokinterp.tcl
new file mode 100755
index 0000000..77e67aa
--- /dev/null
+++ b/src/WOKTclLib/wokinterp.tcl
@@ -0,0 +1,355 @@
+
+
+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; 
+}