Error: can't read server: no such variable when using ltk remotely

Question

I am tinkering around with ltk as it provides the option of running a remote GUI. However, when trying to use the remote GUI I run into issues I do not encounter when running ltk locally:

(in-package :ltk-user)


(defun add-current-investigation-frame (master)
  (let* ((frame (make-instance 'frame :master master :width 100 :height 100))
         (topic-label (make-instance 'label :text "Current Investigation" :master frame))
         (project-label (make-instance 'entry :text "N/A" :master frame))
         (action-button (make-instance 'button
                                       :master frame
                                       :text "new investigation")))
    (setf (command action-button) (lambda ()
                                    (format t "test~%")
                                    (let ((next-project (nth (random 3) '("A" "B" "N/A"))))
                                      (setf (text project-label) next-project))))
    (pack frame)
    (pack topic-label :side :top)
    (pack project-label :side :top)
    (pack action-button :side :top)))



(defun create-main-view ()
  (let ((wrapper-frame (make-instance 'frame :master nil)))
    (pack wrapper-frame)
    (add-current-investigation-frame wrapper-frame)))


(defun create-remote-view (&optional (port 8888))
  (Ltk:with-remote-ltk port ()
                       (create-main-view)))


(defun create-local-view ()
  (with-ltk ()
    (create-main-view)))

When running (create-local-view) everything works fine and the content of the entry widget changes randomly.

When running (create-remote-view) I get the error message can't read server: no such variable. Why does this error occur and how can I fix this?

I am using the remote.tcl deployed by quicklisp:

#!/usr/bin/wish

#    This library is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser General Public
#    License as published by the Free Software Foundation; either
#    version 2.1 of the License, or (at your option) any later version.
#
#    This library is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#    Lesser General Public License for more details.

#    You should have received a copy of the GNU Lesser General Public
#    License along with this library; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


wm withdraw .
set host localhost
if {[llength $argv] == 2} {
    set host [lindex $argv 0]
    set port [lindex $argv 1]} else {
        set port [lindex $argv 0]}
#puts "connecting to $host $port"

set server [socket $host $port]
set wi [open "|wish" RDWR]
fconfigure $server -blocking 0
fconfigure $wi -blocking 0


fileevent $server readable {set txt [read $server];puts $wi "$txt";flush $wi}
fileevent $wi readable {
    if {[eof $wi]} {
        close $wi
        exit} else {        
            set txt [read $wi]; puts -nonewline $server $txt;flush $server}}

Answer 1

This is a preliminary answer as I am not entirely sure that this fix does not break anything. I will update this answer in the future to report back on encountered issues. But for now this fixes the issue.

In ltk.lisp there is a function called init-wish which requires an additional line (send-wish "set server stdout")

(defun init-wish ()
 (send-lazy
  ;; print string readable, escaping all " and \
  ;; proc esc {s} {puts "\"[regsub {"} [regsub {\\} $s {\\\\}] {\"}]\""}
  ;(send-wish "proc esc {s} {puts \"\\\"[regsub -all {\"} [regsub -all {\\\\} $s {\\\\\\\\}] {\\\"}]\\\"\"} ")
  ;(send-wish "proc escape {s} {return [regsub -all {\"} [regsub -all {\\\\} $s {\\\\\\\\}] {\\\"}]} ")
   (send-wish "package require Tk")
;;; PUT MISSING LINE HERE
   (send-wish "set server stdout")
;;; PUT MISSING LINE HERE
  (flush-wish)

  #+:tk84
  (send-wish "catch {package require Ttk}")
  #-:tk84
  (send-wish "if {[catch {package require Ttk} err]} {tk_messageBox -icon error -type ok -message \"$err\"}")


  (send-wish "proc debug { msg } {
       global server
       puts $server \"(:debug \\\"[escape $msg]\\\")\"
       flush $server
    } ")
; more code ....
))

Explanation: The function seems to set up the wish interface and actions (confirmed by inserting prints in the remote.tcl). However, as one can see server is referenced in all procs yet it is never declared if we consider all those declarations to be in their own namespace. Consequently, the missing server has to be defined. As all the output is read by fileevent $wi ... and then passed on further, defining server as stdout seemed the most sensible.

It seems to work, however I have no clue if this breaks other stuff

Answer 2

So I spent some time reading and testing the code, and it appears that it works better with remote-client.tcl than remote.tcl. When working with ltk-remote.lisp, the Lisp side creates a server that may accept multiple clients, each client being a tcl/tk interpreter.

    lisp <=== socket stream ===> [ server socket ]
                                        ^
                                        |
                                 (wish interpreter)

The lisp side expects the interpreter to maintain a global variable named server. In the case of a local interpreter, this is done in init-wish, where there is set server stdout. In the case of a remote wish, it is expected that the wish interpreter sets this variable itself.

This is the case with remote-client.tcl, and the test applications works well (e.g. ltk-remote::lrtest), except that it adds a .status widget which is never removed. It should be possible to clean up a bit the remote-client.tcl script.

In the case of remote.tcl, the interpreter opens a pair of streams to another wish process:

set wi [open "|wish" RDWR]

It also connects to a server (variable server), and copies inputs from the server to the wish process. Unfortunately, the embedded wish process does not define a server variable:

    lisp <=== socket stream ===> [ server socket ]
                                        ^
                                        |
                                 (wish interpreter 1)
                                     "server" variable
                                        |
                                       "wi" variable
                                        ^
                                        | pipe connection
                                        v
                                 (wish interpreter 2) 
                                 no "server" variable
                                        

If however you set server to stdout, as explained in the other answer, this assignment is evaluated in the second wish interpreter. The output is sent back to the first wish interpreter, which copies the answer back to the lisp server.

Instead of going through another wish interpreter, I tested locally by using a modified remote-client.tcl that doesn't add any widget:

package require Tk

set host localhost
set port 19790
set server ""

if {[llength $argv] > 0} {
    set host [lindex $argv 0]
}

if {[llength $argv] > 1} {
    set port [lindex $argv 1]
}

if {[catch {global server; global host; global port; set server [socket $host $port]}]} {
    tk_messageBox -icon error -type ok -title "Connection failed!" -message "Cannot connect to server $host port $port."
    exit
}

fconfigure $server -blocking 0 -translation binary -encoding utf-8
fileevent $server readable [list sread $server]

set buffer ""

proc getcount {s} { 
    if {[regexp {^\s*(\d+) } $s match num]} {
        return $num
    }
}

proc getstring {s} { 
    if {[regexp {^\s*(\d+) } $s match]} {
        return [string range $s [string length $match] end]
    }
}

proc process_buffer {} {
    global buffer
    global server

    set count [getcount $buffer]
    set tmp_buf [getstring $buffer]

    while {($count > 0) && ([string length $tmp_buf] >= $count)} {
        set cmd [string range $tmp_buf 0 $count]
        set buffer [string range $tmp_buf [expr $count+1] end]

        if {[catch $cmd result]>0} {
            tk_messageBox -icon error -type ok -title "Error!" -message $result
            puts $server "(error: \"$result\")"
            flush $server
            close $server
            exit
        }
        set count [getcount $buffer]
        set tmp_buf [getstring $buffer]
    }
}

proc sread {server} {
    global buffer
    if {[eof $server]} {
        tk_messageBox -icon info -type ok -title "Connection closed" -message "The connection has been closed by the server."
        close $server
        exit
    } else {
        set txt [read $server];
        set buffer "$buffer$txt"
        process_buffer
    }
}