Re: Problems with STklos

From: Erick Gallesio <eg_at_kaolin.unice.fr>
Date: Mon, 29 Aug 1994 19:05:39 +0100

Hi,

> 1. My menus don't do anything.
> I can create several menues in a menubar, which all look
> okay. However, when I select a menuentry the corresponding action
> is _not_ invoked.
>
> (menu-add m-file 'command :label "Print"
> :command '(print-issue-file) :underline 0)

This is because your menu are not a descendant of their Menu-button. This is a
Tk constraint for giving the focus to a menu. You have to do

        (define mb (make <Menu-button> :text "A Menu button"))
        (define m (make <Menu> :parent mb))
                                ^^^^^^^^^^^
        (set! (menu-of mb) m)

Last line, as you used it, is for attaching the menu to its menubutton.
However, this code is redundant with the parent specififcation and we can
avoid it by doing

(define-method initialize ((self <Menu>) initargs)
  ;; Do normal initialization
  (next-method)
  ;; If a parent is specified, modify the parent menu-button to point self
  (let ((parent (get-keyword :parent initargs #f)))
    (if (and parent (eq? (class-of parent) <Menu-button>))
        (slot-set! parent 'menu (Id self)))))

In fact, this seems general enough and I will add it to the file Menu.stk.
What do you think about.


> 2. When I invoke the add-button several times, stk abort with a
> segmentation fault under Linux.
>
> The sequence is add btn, cancel btn, add btn, cancel btn, add btn,
> segmentation fault.
>
> Am I doing something fundamentally wrong?

Obviously it is me who is doing somethin wrong :->
Can you find a precise sequence which does it, so I can reproduce it.

> 3. The grab command doesn't work for me.
> Currentlty I use tkwait in the routine add-issue, but somehow I
> can't find the right invokation of the grab, to grab the screen
> created in add-issue.

The problem is that add-issue do
     (define (add-issue)
        ...
        <toplevel t creation>
        ...
        (grab t)
        (catch (destroy t)))

Grab doesn't block execution. So, the destroy is immediatly done before the Tk
finds time to map it (insert a "after" followed by an "update" to see it).
So add-issue must be something like

     (define (add-issue)
        ...
        <toplevel t creation>
        ...
        .... (make <Button> :text "OK"
                             :command (catch (destroy ,(address-of t)))
        (grab t))

Here, clicking the OK button will destroy t and ungrab the screen. Note the
usage of the function address-of.

Herafter is the modified code for add-issue.


                -- Erick

-------------------------------------------------------------

(define add-issue
  (lambda ()
    (let* ((t (make <Toplevel>))
           (t-lbl ())
           (t-d-p ())
           (t-d-p-date ())
           (t-d-p-prio ())
           (t-short ())
           (t-sb ())
           (t-sb-stat ())
           (t-sb-cat ())
           (t-btn ())
           (t-btn-ok ())
           (t-btn-can ())
           (t-btn-hlp ()))
      
      ; The Label above all
      (define t-lbl (make <Label> :text "Inital Issue Specification"
                          :borderwidth 10 :parent t))
      (pack t-lbl :fill "x" :expand "t" :side "top")
      ; The Date and the Prio fields
      (set! t-d-p (make <Frame> :parent t :borderwidth 5))
      (pack t-d-p :side "top" :fill "x")
      (set! t-d-p-date (make <Labeled-entry>
                             :parent t-d-p :title "Date:" :width 10))
      (pack t-d-p-date :side "left")
; (let ((date (get-decoded-time))
; (date-string #f))
; (set! date-string (string-append
; (number->string (vector-ref date 3))
; "."
; (number->string (+ 1 (vector-ref date 4)))
; "."
; (number->string (vector-ref date 5))))
; (text-insert t-d-p-date date-string 0))

      (set! t-d-p-prio (make <Labeled-entry>
                             :parent t-d-p :title "Prio (1-99):" :width 3))
      (pack t-d-p-prio :side "right")
      ; The Short description
      (define t-short (make <Labeled-entry>
                          :parent t :title "Short Description:" :width 40))
      (pack t-short :side "top")
      ; Two Scrollboxes for Status and Category
      (set! t-sb (make <Frame> :parent t))
      (pack t-sb :side "top" :fill "x")
      (set! t-sb-stat (make <Scroll-listbox>
                            :parent t-sb :scroll-side "right"
                            :geometry "10x5" :setgrid 1 :borderwidth 5))
      (pack t-sb-stat :side "left" :expand "t")
      (map (lambda (n)
             (insert t-sb-stat "end"
                     (car n))) possible-stati)
      (set! t-sb-cat (make <Scroll-listbox>
                           :parent t-sb :scroll-side "right"
                           :geometry "10x5" :setgrid 1 :borderwidth 5))
      (pack t-sb-cat :side "right" :expand "t")
      ; The Buttons at the bottom
      (define t-btn (make <Frame> :parent t))
      (pack t-btn :side "bottom" :fill "x")
      (define t-btn-ok (make <Button> :text "OK"
                            :parent t-btn))
      (define t-btn-can (make <Button> :text "Cancel"
                            :command `(catch (destroy ,(address-of t)))
                            :parent t-btn))
      (define t-btn-hlp (make <Button> :text "Help"
                            :parent t-btn))
      (pack t-btn-ok t-btn-can t-btn-hlp
            :side "left" :fill "x" :expand "t")

      (wm 'title t "Add a new issue")

      (grab t)

      )))
Received on Mon Aug 29 1994 - 19:05:40 CEST

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST