Hi!
Excuse me for impudence. The ruthless criticism interests only :)
README:
http://kavenchuk.at.tut.by/cltk/README
source:
http://kavenchuk.at.tut.by/cltk/cltk.lisp
zip-archive of source and small examples:
http://kavenchuk.at.tut.by/cltk/cltk.zip
kick possible and very hurt ;)
(that more so did not do)
Thanks.
--
Yaroslav Kavenchuk.
"kavenchuk" <·········@jenty.by> writes:
> Hi!
>
> Excuse me for impudence. The ruthless criticism interests only :)
>
> README:
> http://kavenchuk.at.tut.by/cltk/README
> source:
> http://kavenchuk.at.tut.by/cltk/cltk.lisp
> zip-archive of source and small examples:
> http://kavenchuk.at.tut.by/cltk/cltk.zip
>
> kick possible and very hurt ;)
> (that more so did not do)
Well, it IS heavily clisp dependant...
;; --------------------
On unix library names usually start with "lib":
(defparameter *tcl-shared-lib*
#+win32 "tcl84.dll"
#-win32 "libtcl8.4.so"
"The location of the Tcl shared library.")
(defparameter *tk-shared-lib*
#+win32 "tk84.dll"
#-win32 "libtk8.4.so"
"The location of the Tk shared library.")
;; --------------------
The only constants are numbers, characters and symbols. Trying to
defconstant any other kind of value will be harder:
WARNING: (DEFCONSTANT *INIT-TCL-COMMAND-LIST* '(AFTER LOAD INFO SET CL-EVAL))
redefines the constant *INIT-TCL-COMMAND-LIST*. Its old value was
(AFTER LOAD INFO SET CL-EVAL)
Just use DEFPARAMETER here.
(DEFPARAMETER +INIT-TCL-COMMAND-LIST+ '(AFTER LOAD INFO SET CL-EVAL))
;; --------------------
Note that the convention is to use +NAME+ for constants, and *NAME*
for variables. So your defconstant should have been:
(DEFCONSTANT +INIT-TCL-COMMAND-LIST+ ...)
and strictly speaking, my defparameter should have been:
(DEFPARAMETER *INIT-TCL-COMMAND-LIST* ...)
but I wanted to indicate that it was a parameter whose value should not
change so I wrote:
(DEFPARAMETER +INIT-TCL-COMMAND-LIST+ ...)
;; --------------------
(DEFPACKAGE :CL-TK (:NICKNAMES :TCL :TK))
The default use list is implementation dependant ==> always specify
your onw use list:
(DEFPACKAGE :CL-TK
(:NICKNAMES :TCL :TK)
(:USE "COMMON-LISP"))
;; --------------------
clisp FFI is designed to let you avoid this kind of indirections:
(DEFUN get-string-result ()
"return the result for interp as an string"
(FUNCALL Tcl_GetStringResult interp))
Just write:
(ffi:def-call-out get-string-result
(:name "Tcl_GetStringResult")
(:library #.tcl-lib)
(:RETURN-TYPE FFI:C-STRING)
(:ARGUMENTS (interp Tcl_Interp)))
and then you can call directly the foreign function:
(get-string-result)
;; --------------------
This is ludicrous:
(DEFMACRO import-widgets (&REST args)
`(LOOP FOR cmd IN ',args
IF (CONSP cmd)
DO (EVAL (MACROEXPAND (APPEND '(TK::import-widget) cmd)))
ELSE
DO (EVAL (MACROEXPAND (LIST 'TK::import-widget cmd)))))
(defmacro import-widgets (&rest commands)
`(progn
,@(mapcar (lambda (command)
(if (consp command)
`(TK::import-widget ,@command)
`(TK::import-widget ,command))) commands)))
Macro expansion is recursive!
;; --------------------
(APPEND '(TK::import-widget) cmd)
is better written:
(CONS 'TK::import-widget cmd)
Or, if you wanted to stress the parallelism:
(if (consp cmd)
(list* 'TK::import-widget cmd)
(list 'TK::import-widget cmd))
;; --------------------
(DEFMACRO import-widget (name &OPTIONAL tcl-name)
(let ((str-name (OR tcl-name (TK::val-to-str name)))
(sym-name (intern (string-upcase (string name)) :TK)))
`(progn
(when (boundp ',sym-name) (makunbound ',sym-name))
(defvar ,sym-name ,str-name)
(when (fboundp ',sym-name) (system::remove-old-definitions ',sym-name))
(defmacro ,sym-name (&REST args)
(let* ((w-str-name (APPLY 'TK::invoke (APPEND '(,str-name)
(MAP 'LIST #'TK::val-to-str args))))
(w-sym-name (intern (STRING-UPCASE w-str-name) :TK)))
`(progn
(unless (boundp ',w-sym-name)
(defvar ,w-sym-name ,w-str-name)
(unless (fboundp ',w-sym-name)
(defmacro ,w-sym-name (&REST argw)
`(progn
(APPLY 'TK::invoke (APPEND '(,,w-str-name)
(MAP 'LIST #'TK::val-to-str ',argw)))
',,w-sym-name)))))))
',sym-name)))
This looks wrong at so many levels... ("Oh my... Macros making macros!" ;-)
Macros are used to generate code, at compilation time (strictly
speaking at macro expansion time, but most of the time it means at
compilation time), Variables are used to hold values, most of the
time at run-time.
Should the widget importation be done at compilation time or at run-time?
It seems to me it should be done at run-time, so you should be
manipulating widgets only with functions, not with macros. That is,
you'd just write a generic function to invoke widgets at run-time:
(defvar *tcl-widget-names* (make-hash-table))
(defun proclaim-widget (name &optional tcl-name)
(setf tcl-name (or tcl-name (string widget)))
(tk:check-widget-exists tcl-name)
(setf (gethash widget *tcl-widget-names*) tcl-name))
(defun invoke (widget &rest arguments)
(TK:invoke (or (gethash widget *tcl-widget-names*)
(error "No widget named ~A known." widget))
(mapcar (function tk::val-to-str) arguments)))
(proclaim-widget 'tkButton "TK_Button")
(proclaim-widget '|TK_Field|)
(invoke 'tkButton "OK")
(invoke '|TK_Field| "Title" "Star Wars 3")
(when (fboundp ',sym-name) (system::remove-old-definitions ',sym-name))
(defmacro ,sym-name (&REST args)
DEFMACRO and DEFUN automatically remove the old definition.
(when (boundp ',sym-name) (makunbound ',sym-name))
(defvar ,sym-name ,str-name)
DEFPARAMETER does this automatically:
(defparameter ,sym-name ,str-name)
But it feels wrong to use the value slot of the symbol to store this
kind of information. What if the user wrote:
(defparameter scroll (make-instance 'artefact
:name "Dead Sea Scroll"
:type "Papyrus"
:idiom "Aramean"))
(import-widget scroll "TK_Scroll")
The point is that the tcl/tk scroll names something that's in the
tcl/tk process while the other scroll names an object that's in a
totally different scope. It is worthwhile to allow the same name be
used in different scopes. Therefore it's better to use a hash table
to map the tcl/tk names, hence creating a new naming scope.
In the old times one would have used a property at least:
(setf (get ',sym-name :tcl-name) ,str-name)
...
(tk:invoke (get sym-name :tcl-name) ...)
;; --------------------
(DEFUN val-to-str (val &KEY keyword-case symbol-case string-case other-case)
(TYPECASE val
(KEYWORD (ICONV-TO-TCL (STRING-CASE (STRING val) (OR keyword-case *keyword-case*))))
(SYMBOL (ICONV-TO-TCL (STRING-CASE (STRING val) (OR symbol-case *symbol-case*))))
(STRING (ICONV-TO-TCL (STRING-CASE val (OR string-case *string-case*))))
(CONS (TK::val-to-str (EVAL val)))
(T (ICONV-TO-TCL (STRING-CASE (WRITE-TO-STRING val) (OR other-case *other-case*)))))))
You can set default values for keywords:
(DEFUN val-to-str (val &KEY (keyword-case *keyword-case*)
(symbol-case *symbol-case*) ...)
therfore avoiding the OR:
(KEYWORD (ICONV-TO-TCL (STRING-CASE (STRING val) keyword-case)))
(SYMBOL (ICONV-TO-TCL (STRING-CASE (STRING val) symbol-case)))
Instead of generally transporting lists to be later evaluated as:
(CONS (TK::val-to-str (EVAL val)))
you might be interested in closures. Compare:
(defun get-value (val)
(typecase val
(number val)
(string val)
(cons (eval val))))
(let ((x 1))
(get-value '(+ 2 x)))
vs.:
(defun get-value (val)
(typecase val
(number val)
(string val)
(function (funcall val))))
(let ((x 1))
(get-value (lambda () (+ 2 x))))
Also, when designing something like: (tk::invoke "cl-eval" "(! 5)")
I see little reason why lisp code should be generated by the tcl/tk
process (and big security risks). So instead of storing a s-expression
as a string into the tcl/tk process, and later using EVAL with the
problem we've seen with the above get-value, you could take a closure,
register it in a local hash table, and give the tcl/tk process only a
token:
(defparameter *tcl-closures* (make-hash-table :test (function equal)))
(defun invoke (tclfun &rest args)
(tk:invoke tclfun
(mapcar (lambda (arg)
(typecase arg
...
(function ; sustitute the closure for a token
(let ((token (string (gensym "TKCLOS"))))
(setf (gethash token *tcl-closures*) arg)
token)))) args)))
(export-to-tcl #'(LAMBDA (x) (CL:funcall (cl:gethash x *tcl-closures*)))
"cl-eval")
So now, stuff like:
(let ((x 1))
(invoke "cl-eval" (lambda () (+ 2 x))))
will work.
And of course, you can even write a macro to be able to write:
(let ((x 1))
(tcl-progn
(princ "Executing some cl-eval...")
(if (< 10 x) 1 (+ 2 x))))
(defmacro tcl-progn (&body body)
`(invoke "cl-eval" (lambda () ,@body)))
;; --------------------
(UNUSE-PACKAGE :CL)
I don't see what's to be won by this.
;; --------------------
--
__Pascal Bourguignon__ http://www.informatimago.com/
The world will now reboot. don't bother saving your artefacts.
Many thanks once again.
It was very good lesson for me.
I want state some justifications:
(excuse me bad English)
;; -------------------------------------------
clisp FFI is designed to let you avoid this kind of indirections:
(DEFUN get-string-result ()
"return the result for interp as an string"
(FUNCALL Tcl_GetStringResult interp))
Just write:
(ffi:def-call-out get-string-result
(:name "Tcl_GetStringResult")
(:library #.tcl-lib)
(:RETURN-TYPE FFI:C-STRING)
(:ARGUMENTS (interp Tcl_Interp)))
and then you can call directly the foreign function:
(get-string-result)
; ----------------------------------------------
No, in this case need
(get-string-result (interp))
Concerning "run-time macros" and scopes:
My main mind was to save syntax Tcl/Tk as much as possible without any
knowledge of parameters of tcl-commands and without coding these
parameters. An example:
(tk::button .hello -text "Hello"
-command (tk::callback (print "Hallo, World!")))
(tk::pack .hello -padx 20 -pady 10)
or
(tk::pack
(tk::button .hello -text "Hello"
-command (tk::callback (print "Hallo, World!")))
-padx 20 -pady 10)
(tk::.hello config -background red)
I could make it only on run-time macros. With use of functions this
code would be such:
(tk::button '.hello '-text "Hello"
'-command (tk::callback (print "Hallo, World!")))
(tk::pack '.hello '-padx 20 '-pady 10)
it is not so beautiful, but it is compiled... I am deep in thought :)
And thanks once again.
--
WBR, Yaroslav Kavenchuk.
"kavenchuk" <·········@jenty.by> writes:
> Concerning "run-time macros" and scopes:
> My main mind was to save syntax Tcl/Tk as much as possible without any
> knowledge of parameters of tcl-commands and without coding these
> parameters. An example:
>
> (tk::button .hello -text "Hello"
> -command (tk::callback (print "Hallo, World!")))
> (tk::pack .hello -padx 20 -pady 10)
>
> or
>
> (tk::pack
> (tk::button .hello -text "Hello"
> -command (tk::callback (print "Hallo, World!")))
> -padx 20 -pady 10)
> (tk::.hello config -background red)
>
> I could make it only on run-time macros. With use of functions this
> code would be such:
>
> (tk::button '.hello '-text "Hello"
> '-command (tk::callback (print "Hallo, World!")))
> (tk::pack '.hello '-padx 20 '-pady 10)
>
> it is not so beautiful, but it is compiled... I am deep in thought :)
Well a macro can be defined as syntactic suggar. The problem is not
so much "macros making macros" as the use of EVAL and MACROEXPAND: it
would be better to set up thing to let the compiler expand all the
macros at compilation time.
--
__Pascal Bourguignon__ http://www.informatimago.com/
The rule for today:
Touch my tail, I shred your hand.
New rule tomorrow.
attempt 2
All in the same place:
README:
http://kavenchuk.at.tut.by/cltk/README
source:
http://kavenchuk.at.tut.by/cltk/cltk.lisp
zip-archive of source and small examples:
http://kavenchuk.at.tut.by/cltk/cltk.zip
Thanks!
--
WBR, Yaroslav Kavenchuk.
"kavenchuk" <·········@jenty.by> writes:
> attempt 2
>
> All in the same place:
>
> README:
> http://kavenchuk.at.tut.by/cltk/README
> source:
> http://kavenchuk.at.tut.by/cltk/cltk.lisp
> zip-archive of source and small examples:
> http://kavenchuk.at.tut.by/cltk/cltk.zip
>
> Thanks!
Seems OK.
Since I don't like the extended form of LOOP very much, I'd rather
write this loops:
(LOOP FOR command IN commands
IF (CONSP command) DO (APPLY 'TK::import-widget command)
ELSE DO (import-widget command))
as:
(dolist (command commands)
(if (consp command)
(apply 'tk::import-widget command)
(import-widget command)))
but that's just me.
--
__Pascal Bourguignon__ http://www.informatimago.com/
In deep sleep hear sound,
Cat vomit hairball somewhere.
Will find in morning.