]> OCCT Git - occt-wok.git/commitdiff
Initial revision
authorcascade <cascade@opencascade.com>
Fri, 25 Jun 2004 21:07:32 +0000 (21:07 +0000)
committercascade <cascade@opencascade.com>
Fri, 25 Jun 2004 21:07:32 +0000 (21:07 +0000)
src/WOKsite/.tclshrc [new file with mode: 0755]
src/WOKsite/interp.tcl [new file with mode: 0755]
src/WOKsite/tclshrc.tcl [new file with mode: 0755]

diff --git a/src/WOKsite/.tclshrc b/src/WOKsite/.tclshrc
new file mode 100755 (executable)
index 0000000..e339dbb
--- /dev/null
@@ -0,0 +1,2 @@
+global env
+source $env(HOME)/tclshrc_Wok
diff --git a/src/WOKsite/interp.tcl b/src/WOKsite/interp.tcl
new file mode 100755 (executable)
index 0000000..53d5a93
--- /dev/null
@@ -0,0 +1,176 @@
+## Message-Id: <199703122050.MAA13073@cs.uoregon.edu>
+## To: Jim Graham <jim@n5ial.gnt.com>
+## Subject: Re: loading of image in tk 
+## Date: Wed, 12 Mar 1997 12:50:06 -0800
+## From: Jeffrey Hobbs <jhobbs@cs.uoregon.edu>
+
+# Modified by Jim Graham...still a lot left to do, but.....  Thanks
+# to Brent Welch for the help with getting my enhancements to work,
+# as well as for flat out showing me how to do some of them.  :-)
+#
+# Thanks again to Brent Welch for helping me with yet another bug
+# (one that I looked straight at, and couldn't see...).
+
+
+proc unknown {args} {
+
+   global auto_noexec auto_noload env unknown_pending tcl_interactive
+   global errorCode errorInfo
+
+# Save the values of errorCode and errorInfo variables, since they
+# may get modified if caught errors occur below.  The variables will
+# be restored just before re-executing the missing command.
+
+   set savedErrorCode $errorCode
+   set savedErrorInfo $errorInfo
+   set name [lindex $args 0]
+   if ![info exists auto_noload] {
+#
+# Make sure we're not trying to load the same proc twice.
+#
+      if [info exists unknown_pending($name)] {
+         return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
+      }
+      set unknown_pending($name) pending;
+      set ret [catch {auto_load $name} msg]
+      unset unknown_pending($name);
+      if {$ret != 0} {
+         return -code $ret -errorcode $errorCode  "error while autoloading \"$name\": $msg"
+      }
+      if ![array size unknown_pending] {
+         unset unknown_pending
+      }
+      if $msg {
+         set errorCode $savedErrorCode
+         set errorInfo $savedErrorInfo
+         set code [catch {uplevel 1 $args} msg]
+         if {$code ==  1} {
+# Strip the last five lines off the error stack (they're
+# from the "uplevel" command).
+            set new [split $errorInfo \n]
+            set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
+            return -code error -errorcode $errorCode  -errorinfo $new $msg
+         } else {
+            return -code $code $msg
+         }
+      }
+   }
+
+# *FIND ME*
+# This is the original
+# {([info level] == 1) && ([info script] == "")  && [info exists tcl_interactive] && $tcl_interactive}
+
+   if {([info level] == 1)} {
+      if ![info exists auto_noexec] {
+         set new [auto_execok $name]
+         if {$new != ""} {
+            set errorCode $savedErrorCode
+            set errorInfo $savedErrorInfo
+            set redir ""
+            if {[info commands console] == ""} {
+               set redir ">&@stdout <@stdin"
+            }
+            return [uplevel exec $redir $new [lrange $args 1 end]]
+         }
+      }
+      set errorCode $savedErrorCode
+      set errorInfo $savedErrorInfo
+      if {$name == "!!"} {
+         set newcmd [history event]
+      } elseif {[regexp {^!(.+)$} $name dummy event]} {
+         set newcmd [history event $event]
+      } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
+         set newcmd [history event -1]
+         catch {regsub -all -- $old $newcmd $new newcmd}
+      }
+      if [info exists newcmd] {
+         tclLog $newcmd
+         history change $newcmd 0
+         return [uplevel $newcmd]
+      }
+
+      set ret [catch {set cmds [info commands $name*]} msg]
+      if {[string compare $name "::"] == 0} { set name "" }
+      if {$ret != 0} {
+         return -code $ret -errorcode $errorCode  "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
+      }
+      if {[llength $cmds] == 1} {
+         return [uplevel [lreplace $args 0 0 $cmds]]
+      }
+      if {[llength $cmds] != 0} {
+         if {$name == ""} {
+            return -code error "empty command name \"\""
+         } else {
+            return -code error  "ambiguous command name \"$name\": [lsort $cmds]"
+         }
+      }
+   }
+   return -code error "invalid command name \"$name\""
+}
+
+
+# ------------------------------  CUT HERE  ------------------------------ #
+############################################################################
+
+# Back to interp.tcl!
+
+set long_command ""
+
+if ![info exists tcl_prompt1] {
+  if {[info exists jstrackrc]} {
+      set tcl_prompt1 {puts -nonewline "JStrack ([history nextid]) % "}
+   } elseif {[info exists tk_version]} {
+      set tcl_prompt1 {puts -nonewline "wish ([history nextid]) % "}
+   } else {
+      set tcl_prompt1 {puts -nonewline "tclsh ([history nextid]) % "}
+   }
+}
+
+proc read_stdin {} {
+  global eventLoop tcl_prompt1 long_command jdg_hist_file
+  set l [gets stdin]
+  if {[eof stdin]} {
+     set eventLoop "done"     ;# terminate the vwait (eventloop)
+  } else {
+     if [string compare $l ""] {
+       append long_command "$l"
+       set l $long_command
+       if {[info complete $l]} {
+          if [catch {uplevel \#0 history add [list $l] exec} err] {
+             puts stderr $err
+          } elseif {[string compare $err ""]} {
+             puts $err
+          } else {
+              if {[info exists jdg_hist_file]} {
+                 set f [open $jdg_hist_file a]
+                 puts $f $l
+                 close $f
+              }
+           }
+           set long_command ""
+           catch $tcl_prompt1
+       } else {
+           append long_command \n
+           puts -nonewline "> "
+       }
+     } elseif {[string compare $long_command ""] == 0} {
+       catch $tcl_prompt1
+     } else {
+       puts -nonewline "> "
+     }
+  flush stdout
+  }
+}
+
+# set up our keyboard read event handler:
+# Vector stdin data to the socket
+
+fileevent stdin readable read_stdin
+
+catch $tcl_prompt1
+flush stdout
+# wait for and handle or stdin events...
+vwait eventLoop
+
+
+
diff --git a/src/WOKsite/tclshrc.tcl b/src/WOKsite/tclshrc.tcl
new file mode 100755 (executable)
index 0000000..e339dbb
--- /dev/null
@@ -0,0 +1,2 @@
+global env
+source $env(HOME)/tclshrc_Wok