[cells-cvs] CVS Celtk

[fgoenninger]

Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv7374

Modified Files:
	tk-interp.lisp 
Log Message:
Added/Changed: Tile is not loaded on Mac OS X. (see function tk-interp-init-ensure)

--- /project/cells/cvsroot/Celtk/tk-interp.lisp	2007/01/29 22:58:41	1.18
+++ /project/cells/cvsroot/Celtk/tk-interp.lisp	2007/11/16 10:06:50	1.19
@@ -22,13 +22,13 @@
 ;; Tcl/Tk
 
 (define-foreign-library Tcl
-    (:darwin (:framework "Tcl"))
+  (:darwin (:framework "Tcl"))
   (:windows (:or "/tcl/bin/Tcl85.dll"))
   (:unix "libtcl.so")
   (t (:default "libtcl")))
 
 (define-foreign-library Tk
-    (:darwin (:framework "Tk"))
+  (:darwin (:framework "Tk"))
   (:windows (:or "/tcl/bin/tk85.dll"))
   (:unix "libtk.so")
   (t (:default "libtk")))
@@ -42,7 +42,7 @@
 (defctype tcl-retcode :int)
 
 (defcenum tcl-retcode-values
-    (:tcl-ok    0)
+  (:tcl-ok    0)
   (:tcl-error 1))
     
 (defmethod translate-from-foreign (value (type (eql 'tcl-retcode)))
@@ -63,16 +63,17 @@
 
 (defcallback Tk_AppInit tcl-retcode
   ((interp :pointer))
-  (tk-app-init interp))
+  (unwind-protect
+    (tk-app-init interp)))
 
 (defun tk-app-init (interp)
+  (assert interp)
   (Tcl_Init interp)
   (Tk_Init interp)
-  ;;(format t "~%*** Tk_AppInit has been called.~%")
   ;; Return OK
   (foreign-enum-value 'tcl-retcode-values :tcl-ok))
 
-    ;; Tk_Main
+  ;; Tk_Main
     
 (defcfun ("Tk_MainEx" %Tk_MainEx) :void
   (argc :int)
@@ -91,7 +92,7 @@
 (defcfun ("Tcl_CreateInterp" Tcl_CreateInterp) :pointer)
 
 (defcfun ("Tcl_DeleteInterp" tcl-delete-interp) :void
-  (interp        :pointer))
+  (interp :pointer))
 
 ;;; --- windows ----------------------------------
 
@@ -113,29 +114,35 @@
   (with-foreign-string (filename-cstr filename)
     (%Tcl_EvalFile interp filename-cstr)))
 
-(defcfun ("Tcl_Eval" tcl-eval) tcl-retcode
+(defcfun ("Tcl_Eval" %Tcl_Eval) tcl-retcode
   (interp      :pointer)
   (script-cstr :string))
 
-(defcfun ("Tcl_EvalEx" tcl_evalex) tcl-retcode
+(defun tcl-eval (i s)
+  (%Tcl_Eval i s))
+
+(defcfun ("Tcl_EvalEx" %Tcl_EvalEx) tcl-retcode
   (interp      :pointer)
   (script-cstr :string)
-  (num-bytes :int)
-  (flags :int))
+  (num-bytes   :int)
+  (flags       :int))
 
 (defun tcl-eval-ex (i s)
-  (tcl_evalex i s -1 0))
+  (%Tcl_EvalEx i s -1 0))
 
-(defcfun ("Tcl_GetVar" tcl-get-var) :string (interp :pointer)(varName :string)(flags :int))
+(defcfun ("Tcl_GetVar" tcl-get-var) :string
+  (interp  :pointer)
+  (varName :string)
+  (flags   :int))
 
 (defcfun ("Tcl_SetVar" tcl-set-var) :string
-  (interp :pointer)
-  (var-name :string)
+  (interp    :pointer)
+  (var-name  :string)
   (new-value :string)
-  (flags :int))
+  (flags     :int))
 
 (defcfun ("Tcl_GetStringResult" tcl-get-string-result) :string
-  (interp      :pointer))
+  (interp :pointer))
 
 ;; ----------------------------------------------------------------------------
 ;; Tcl_CreateCommand - used to implement direct callbacks
@@ -201,12 +208,13 @@
   (unless *initialized*
     (use-foreign-library Tcl)
     (use-foreign-library Tk)
-    ;(use-foreign-library Tile)
+    #-macosx (use-foreign-library Tile)
+    #-macosx (pushnew :tile cl-user::*features*)
     (use-foreign-library Togl)
     (tcl-find-executable (argv0))
     (set-initialized)))
 
-;; Send a script to a piven Tcl/Tk interpreter
+;; Send a script to a given Tcl/Tk interpreter
 
 (defun eval-script (interp script)
   (assert interp)