Jason Miller | 27 Jun 22:19 2014

Patches

Hi All,

I submitted a few patches to the list a while back; any comments on
them?

-Jaosn

Joshua Kordani | 16 Dec 20:16 2013

Cross platform distribution?

Greetings all,

I've been very interested in locating an easy to distribute, cross platform gui library that will allow for gui development in common lisp.  After finding out about tclkits and seeing how small they are, I get the impression that this goal is reachable via distribution of the platform specific tclkit along with a common lisp image (with ltk configured to locate the supplied tclkit).  I didn't find an archive of this list, and from what I've read in ltk docs, it seems like this concept is easily supported, but I am rather new to common lisp and tcl/tk.  Given that I am new to common lisp, I don't necessarily know what part of the ltk code I need to read in order to figure out how to invoke a local instance of tcl/tk (let alone make a connection to a remote-tcl).

I am open to anything, if someone has walked this path before and knows of some documentation that might be illuminating, I'm all ears.  In addition, if anyone has any suggestions about how I might go about this whole cross platform gui common lisp development effort more easily, I'm also all ears.

My short term goal is to produce enough material to run the ltkdemo (or at least, my own hello world code) from a lisp image that references a supplied tclkit on at least osx and windows.

Cheers!
-- Joshua Kordani LSA Autonomy
Josef Wolf | 14 Dec 20:58 2013
Picon

No dialog-box in ltk?

Hello,

I can't find the dialog widget in ltk. I can find message-box, ask-yesno,
ask-okcancel and do-msg. But I can't find a dialog box where I can put e.g an
entry to ask the user for additional information.

Am I missing something? Any hints?

--

-- 
Josef Wolf
jw <at> raven.inka.de

Josef Wolf | 12 Dec 12:59 2013
Picon

Example of scrollbar available?

Hello folks,

are there any examples of scrollbar usage available? I have a hard time to
grasp how to use them, and I can't find any examples in the documentation.

Thanks!

--

-- 
Josef Wolf
jw <at> raven.inka.de

Jason Miller | 14 Nov 22:43 2013

patch to make children actually do something

For treeviews:
#'(setf children) will set the children, but #'children issues the
command without reading the value!  This fixes that 
diff --git a/ltk.lisp b/ltk.lisp
index 127e309..af9b1a5 100644
--- a/ltk.lisp
+++ b/ltk.lisp
 <at>  <at>  -2638,10 +2638,16  <at>  <at>  bind ~a <Configure> [list resetScroll ~a]

 (defgeneric children (tree item))
 (defmethod children ((tree treeview) item)
-  (format-wish "~a children ~a" (widget-path tree) item))
+  (format-wish "senddatastrings [~a children ~a]" (widget-path tree) item)
+  (let ((names (read-data))
+        (items (items tree)))
+    (mapcar (lambda (name)
+              (find name items :key #'name :test #'equal))
+            names)))

 (defmethod children ((tree treeview) (item treeitem))
-  (format-wish "~a children ~a" (widget-path tree) (name item)))
+  (children tree (name item)))
+  ;(format-wish "~a children ~a" (widget-path tree) (name item)))

 (defgeneric (setf children) (val tree item))
 (defmethod (setf children) (val (tree treeview) item)
edgar | 18 Oct 01:33 2013
Picon

Re: How is ":serve-event t" meant to be used?


Jason Miller <jason <at> milr.com> wrote:

> The solution is to catch the tag:
> (catch *wish* (exit-wish))

Sorry, but that's not a solution, that's a wacky workaround.

If that's the only solution, then this is a clear indicator
that the implementation of :serve-event is buggy.

But it works, so ... thanks a lot :-)

This is only for a toy project, see:

http://www.lispforum.com/viewtopic.php?f=2&t=4182

If I find a better solution I will tell it here on the list.

Thanks,

- edgar

edgar | 17 Oct 21:00 2013
Picon

Re: How is ":serve-event t" meant to be used?


Jason Miller <jason <at> milr.com> wrote:

> On 18:26 Wed 16 Oct     , edgar wrote:
>> Hi all on the LTK list,
>> 
>> I'm trying to open a scrolled-canvas widget in the Tk main window
>> and then interactively drawing a line on the canvas (details in the
>> REPL transcripts below), but LTK is throwing nothing but errors at
>> me.
>> 
>> The questions are:
>> 
>> 1. Am I doing something fundamentally wrong in the examples below?  

> Yes

>> LTK-TEST> (defun ltk-test ()
>>             (with-ltk (:serve-event t)
>>               (let ((sc (make-instance 'scrolled-canvas)))
>>                     (pack sc :expand 1 :fill :both)
>>                     (setf *canvas* (canvas sc)))))
>> LTK-TEST
>> 
>> LTK-TEST> (ltk-test)
>> ; the Tk window appears on the screen
>> NIL
>> 
>> LTK-TEST> (create-line *canvas* '(10 10 20 20))  

> with-ltk is designed for all the ltk-calls to go within it.  It
> dynamically binds ltk::*wish* only for its dynamic extent.  I have no
> idea how the serve-event interactis with dynamic bindings, as I don't
> use it.  But in any event, *wish* will not be bound at your call to
> create-line, so it will fail.
> 
> I would suggest that you not use with-ltk here, but instead run it
> manually: http://www.peter-herth.de/ltk/ltkdoc/node8.html
> you can pass serve-event to mainloop as well to still get that
> functionality.
> 
> so instead your code should look something like:
> (defun ltk-test ()
>  (start-wish)
>  (let ((sc (make-instance 'scrolled-canvas)))
>   (pack sc :expand 1 :fill :both)
>   (setf *canvas* (canvas sc)))
>  (mainloop :serve-event t))

Thank you very much, but:

a) your code is 99% the same code that I alredy wrote in the second
   example of my original mail

b) your code produces _exactly_ the same errors that I got with the
   code from the second example of my original mail

Please don't get me wrong: I'm really thankful for your help, but it
seems as if you haven't read the full text.

Here's the second example again now with your code and the errors:

------------------------- Start of REPL Transcript ---------------------

CL-USER> (defpackage :ltk-test (:use :cl :ltk))
#<PACKAGE "LTK-TEST">

CL-USER> (in-package :ltk-test)
#<PACKAGE "LTK-TEST">

LTK-TEST> (defparameter *canvas* nil)
*CANVAS*

LTK-TEST> (defun ltk-test ()
            (start-wish)
            (let ((sc (make-instance 'scrolled-canvas)))
              (pack sc :expand 1 :fill :both)
              (setf *canvas* (canvas sc)))
            (mainloop :serve-event t))
LTK-TEST

LTK-TEST> (ltk-test)
; the Tk window appears on the screen
NIL

LTK-TEST> (create-line *canvas* '(10 10 20 20))
; a line appears on the canvas
1

LTK-TEST> (setf *exit-mainloop* t)
; the Tk window doesn't disappear from the screen
T

LTK-TEST> (exit-wish)
; the Tk window disappears from the screen, but:
attempt to THROW to a tag that does not exist:
 #S(LTK::LTK-CONNECTION
    :STREAM NIL
    :CALLBACKS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9063}>
    :AFTER-IDS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9103}>
    :COUNTER 5
    :AFTER-COUNTER 1
    :EVENT-QUEUE NIL
    :CALL-WITH-CONDITION-HANDLERS-FUNCTION #<FUNCTION FUNCALL>
    :INPUT-HANDLER NIL
    :REMOTEP NIL
    :OUTPUT-BUFFER NIL
    :VARIABLES #<HASH-TABLE
    :TEST EQUAL :COUNT 0 {10068F91A3}>)
   [Condition of type SB-INT:SIMPLE-CONTROL-ERROR]

Backtrace:
  0: ("no debug information for frame")
  1: (EXIT-WISH) [tl,external]
  2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (EXIT-WISH) #<NULL-LEXENV>)
  3: (EVAL (EXIT-WISH))

-------------------------- End of REPL Transcript ----------------------

After (exit-wish) I can restart wish by calling (ltk-test) and it works,
except that I can't close the window from the REPL without getting the
error above, but if I close the Tk window by the window's "close" button
and then call (ltk-test) again, I get the following error:

------------------------- Start of REPL Transcript ---------------------

LTK-TEST> (ltk-test)

There is already an inferior wish.
   [Condition of type LTK::LTK-ERROR]

Backtrace:
  0: (LTK::LTK-ERROR "There is already an inferior wish.")
  1: (START-WISH)
  2: (LTK-TEST)
  3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (LTK-TEST) #<NULL-LEXENV>)
  4: (EVAL (LTK-TEST))

-------------------------- End of REPL Transcript ----------------------

But there is definitely no wish process in my machine anymore:

bash$ ps ax | grep wish
 6033 pts/0    S+     0:00 grep wish

How can I stop and restart wish with ":serve-event t" from the REPL
without getting errors?

Thank you,

- edgar

edgar | 16 Oct 18:26 2013
Picon

How is ":serve-event t" meant to be used?

Hi all on the LTK list,

I'm trying to open a scrolled-canvas widget in the Tk main window and
then interactively drawing a line on the canvas (details in the REPL
transcripts below), but LTK is throwing nothing but errors at me.

The questions are:

1. Am I doing something fundamentally wrong in the examples below?

2. In case the errors are based on bugs in LTK, how can I help to
   improve the situation?

I have some experience in both Tcl/Tk and Common Lisp. I'm a hardware
electrician and not a professional programmer, but I know how to use
diff to produce patches. But before starting to hack around in the
LTK code I would first like to hear an opinion of somebody who has
better insight than me into the LTK internals.

SBCL 1.1.12 on Debian 7.2 Wheezy (64-bit), LTK 0.98, Tcl/Tk 8.5

Here is what I'm doing:

------------------------- Start of REPL Transcript ---------------------

CL-USER> (ql:quickload :ltk)
; Loading "ltk"
(:LTK)

CL-USER> ltk:*ltk-version*
"0.98"

CL-USER> (defpackage :ltk-test (:use :cl :ltk))
#<PACKAGE "LTK-TEST">

CL-USER> (in-package :ltk-test)
#<PACKAGE "LTK-TEST">

LTK-TEST> (defparameter *canvas* nil)
*CANVAS*

LTK-TEST> (defun ltk-test ()
            (with-ltk (:serve-event t)
              (let ((sc (make-instance 'scrolled-canvas)))
                    (pack sc :expand 1 :fill :both)
                    (setf *canvas* (canvas sc)))))
LTK-TEST

LTK-TEST> (ltk-test)
; the Tk window appears on the screen
NIL

LTK-TEST> (create-line *canvas* '(10 10 20 20))

The value NIL is not of type STREAM.
   [Condition of type TYPE-ERROR]

Backtrace:
  0: (LTK::FLUSH-WISH)
  1: (CREATE-LINE #<CANVAS {1004C0DC13}> (10 10 20 20))
  2: (SB-INT:SIMPLE-EVAL-IN-LEXENV
       (CREATE-LINE *CANVAS* (QUOTE (10 10 20 20))) #<NULL-LEXENV>)
  3: (EVAL (CREATE-LINE *CANVAS* (QUOTE (10 10 20 20))))

;; Looking at the definition of FLUSH-WISH in ltk.lisp, the reason
;; for the error seems to be: (wish-stream *wish*) => NIL

LTK-TEST> *wish*
#S(LTK::LTK-CONNECTION
   :STREAM NIL
   :CALLBACKS #<HASH-TABLE :TEST EQUAL :COUNT 0 {1007C0E9D3}>
   :AFTER-IDS #<HASH-TABLE :TEST EQUAL :COUNT 0 {1007C0EA73}>
   :COUNTER 1
   :AFTER-COUNTER 1
   :EVENT-QUEUE NIL
   :CALL-WITH-CONDITION-HANDLERS-FUNCTION
     #<FUNCTION (LAMBDA # :IN MAKE-LTK-CONNECTION) {1007C0EDCB}>
   :INPUT-HANDLER NIL
   :REMOTEP NIL
   :OUTPUT-BUFFER ("senddata [.wc.wf create line  10 10 20 20]")
   :VARIABLES #<HASH-TABLE :TEST EQUAL :COUNT 0 {1007C0EE53}>)

-------------------------- End of REPL Transcript ----------------------

Here is what happens if I try to do the same thing manually:

------------------------- Start of REPL Transcript ---------------------

LTK-TEST> (start-wish)
; an empty Tk window appears on the screen
NIL

LTK-TEST> (mainloop :serve-event t)
NIL

LTK-TEST> (defparameter *scrolled-canvas* (make-instance
'scrolled-canvas)) *SCROLLED-CANVAS*

LTK-TEST> (pack *scrolled-canvas* :expand 1 :fill :both)
; the scrolled-canvas widget appears in the Tk window
#<SCROLLED-CANVAS {10040DEB83}>

LTK-TEST> (defparameter *canvas* (canvas *scrolled-canvas*))
*CANVAS*

LTK-TEST> (create-line *canvas* '(10 10 20 20))
; YIPPIE, a line appears on the canvas :-)
1

LTK-TEST> (setf *exit-mainloop* t)
; the Tk window doesn't disappear from the screen
T

LTK-TEST> (exit-wish)
attempt to THROW to a tag that does not exist:
 #S(LTK::LTK-CONNECTION
    :STREAM NIL
    :CALLBACKS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9063}>
    :AFTER-IDS #<HASH-TABLE :TEST EQUAL :COUNT 0 {10068F9103}>
    :COUNTER 5
    :AFTER-COUNTER 1
    :EVENT-QUEUE NIL
    :CALL-WITH-CONDITION-HANDLERS-FUNCTION #<FUNCTION FUNCALL>
    :INPUT-HANDLER NIL
    :REMOTEP NIL
    :OUTPUT-BUFFER NIL
    :VARIABLES #<HASH-TABLE
    :TEST EQUAL :COUNT 0 {10068F91A3}>)
   [Condition of type SB-INT:SIMPLE-CONTROL-ERROR]

Backtrace:
  0: ("no debug information for frame")
  1: (EXIT-WISH) [tl,external]
  2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (EXIT-WISH) #<NULL-LEXENV>)
  3: (EVAL (EXIT-WISH))

-------------------------- End of REPL Transcript ----------------------

Looking at the definition of EXIT-WISH in ltk.lisp, the reason for
the error is the line (throw *wish* nil) but I'm not sure if the
EXIT-WISH function is meant to be called in this context at all.

The question remains:

How is ":serve-event t" meant to be used in a meaningful way?

Or am I too stupid to use LTK properly?

Thanks in advance for your answers,

- edgar

Jason Miller | 16 Oct 00:49 2013

patch to add ttk-state accessor

The current create-name implementation will generate all alphabetic
strings starting with "w" which includes "wm" after only 12 new
toplevels.  This overwrites the global command "wm" which is kind of
important.

On a side-note, I personally think the encode-base-52 is a bit overengineered vs ~36R
but that's not a bug so I didn't include it in this patch.  ~36R
wouldn't have stomped on any existing globals by the happy accident of
it using UPCASED letters only.
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
 <at>  <at>  -1273,7 +1273,7  <at>  <at> 

 (defun create-name ()
   "create unique widget name, append unique number to 'w'"
-  (format nil "w~A" (encode-base-52 (get-counter))))
+  (format nil "ltk~A" (encode-base-52 (get-counter))))

Jason Miller | 16 Oct 00:41 2013

patch to add ttk-state accessor

Adds an accessor for the ttk-states.

example usage:
  (ttk-state widget :active) ; => nil  retrieves the active state
  (setf (ttk-state widget :active) t) ;sets the active sets
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
 <at>  <at>  -425,7 +425,8  <at>  <at> 
            #:treeview-identify-item
            #:treeview-set-selection
            #:items
-           #:image))
+           #:image
+           #:ttk-state))

 (defpackage :ltk-user
   (:use :common-lisp :ltk))
 <at>  <at>  -5336,6 +5337,26  <at>  <at> 
          `(configure ,w :cursor ""))
        widgets)))

+(defun (setf ttk-state) (enable widget state)
+  (unless
+      (member state '(:active :disabled :focus :pressed :selected
+             :background :readonly :alternate :invalid :hover))
+    (error "Invalid state ~A" state))
+  (format-wish "~a state ~:[!~;~]~a"
+          (widget-path widget) enable
+          (string-downcase (symbol-name state))))
+
+(defun ttk-state (widget state)
+  (unless
+      (member state '(:active :disabled :focus :pressed :selected
+             :background :readonly :alternate :invalid :hover))
+    (cerror "Invalid state ~A" state))
+  (format-wish "senddatastring [~a state]" (widget-path widget))
+  (let ((states (split (read-data) '(#\Space))) )
+    (member (string-downcase (symbol-name state))
+       states
+       :test #'string=)))
+
 (pushnew :ltk *features*)

Jason Miller | 16 Oct 00:09 2013

patch for quit

New versions of sbcl will warn on a reference to sb-ext:quit.

Since new versions of sbcl also include asdf3, I just use uiop:quit if
asdf3 is present, and the old code if not.
Index: ltk.lisp
===================================================================
--- ltk.lisp    (revision 265)
+++ ltk.lisp    (working copy)
 <at>  <at>  -5162,8 +5162,11  <at>  <at> 
   (ignore-errors
     (format *error-output* "An error of has occured: ~%")
     (print-backtrace condition *error-output*)
+    #+asdf3(uiop:quit)
+    #-asdf3
     #+sbcl (quit)
-    #+(or cmu scl) (ext:quit)))
+    #+(or cmu scl) (ext:quit)
+    #-(or cmu scl sbcl)(values)))

 (defun debugger-test (debugger-class)
   (with-ltk (:debugger-class debugger-class :debug-tcl t)

Gmane