Re: 3.99.2 bug

From: Erick Gallesio <eg_at_unice.fr>
Date: Sun, 26 Jul 1998 11:22:21 +0200 (CEST)

Andrew Dorrell writes:
> > Andrew Dorrell <dorrell_at_ihf.uts.edu.au> writes:
> >
> > > (require "Tk-classes")
> > > (pack (make <choice-box>))
> > >
> > > Press mouse button 1 in the entry box, hit tab then space to activate
> > > the menu button then press either the left or right cursor key.
> > >
> > > Result: CPU goes 100% and the application stops responding.
>
> OK.. have tracked the problem down to the file menu.stk, function
> Tk:menu-next-menu. The problem arises in the following (L658-676):
>

I have finally corrected this problem. It arrives in a piece of code
from which I'm not very proud. In fact the file menu.stk is a direct
rewriting of the menu.tcl file. This file, and all the files which
define the default behavior of standard widget are written in a very
imperative way which is difficult to convert in Scheme...

Hereafter, is a patch



--- menu.stk.old Sun Jul 26 11:17:02 1998
+++ menu.stk Sun Jul 26 11:04:44 1998
_at_@ -15,7 +15,7 @@
 ;;;;
 ;;;; Author: Erick Gallesio [eg_at_unice.fr]
 ;;;; Creation date: 17-May-1993 12:35
-;;;; Last file update: 27-Apr-1998 12:34
+;;;; Last file update: 26-Jul-1998 11:04
 ;;;;
 
 (select-module Tk)
_at_@ -659,23 +659,25 @@
       ;; Can't traverse into or out of a cascaded menu. Go to the next
       ;; or previous menubutton, if that makes sense.
       (let* ((buttons (winfo 'children [winfo 'parent tk::posted-mb]))
- (len (length buttons)))
- (let loop ((i (- count (length (member tk::posted-mb buttons)))))
- (while (< i 0) (set! i (+ i len)))
-
- (while (>= i len) (set! i (- i len)))
-
+ (len (length buttons))
+ (i (do ((i 0 (+ i 1)))
+ ((eq? tk::posted-mb (list-ref buttons i)) i)
+ 'nothing)))
+ (let loop ((i (modulo (+ i count) len))
+ (cnt 0))
           (let ((mb (list-ref buttons i)))
- (unless (and (string=? [winfo 'class mb] "Menubutton")
+ (if (or (and (string=? [winfo 'class mb] "Menubutton")
                          (not (string=? [tk-get mb :state] "disabled"))
                          (tk-get mb :menu)
                          (not (equal? ((tk-get mb :menu) 'index 'last) "none")))
- (when (eq? mb tk::posted-mb)
- (set! continue #f))))
- (loop (+ i count))))
- (when continue
- (Tk:menu-button-post mb)
- (Tk:menu-first-entry (tk-get mb :menu))))))
+ (eq? mb tk::posted-mb))
+ ;; found a menu to post
+ (begin
+ (Tk:menu-button-post mb)
+ (Tk:menu-first-entry (tk-get mb :menu)))
+ ;; no menu, search another one, if possible
+ (if (< cnt len)
+ (loop (modulo (+ i count) len) (+ cnt 1))))))))))
 
 ;; Tk:menu-next-entry --
 ;; Activate the next higher or lower entry in the posted menu,




                -- Erick
Received on Sun Jul 26 1998 - 11:40:15 CEST