make-menubar

From: Jonathan Berry <berryj_at_dimacs.rutgers.edu>
Date: Tue, 5 Mar 1996 12:19:57 -0500

There are a couple of small typos in make-menubar in STklos/Tk/Menu.stk.
It was a case of malformed lists. Here's the patch:
-------------------------------------------------------
(define (make-menubar parent l)
  (define (make-menu parent items)
    (let ((m (make <Menu> :parent parent)))
      (for-each (lambda (item)
                  (cond
                   ; Separator
                   ((equal? (car item) "")
                         (menu-add m 'separator))
                   ; Normal Menu
                   ((and (= (length item) 2)
                         (procedure? (cadr item)));;;;;;;;;;;;;;;;;;;;;;;FIXED
                         (menu-add m 'command :label (car item)
                                                 :command (cadr item)));;;;;FIXED
                   ; Cascade menu
                   ((and (= (length item) 2)
                         (list? (cadr item)));;;;;;;;;;;;;;;;;;;;;;;;;;;;FIXED
                         (menu-add m 'cascade :label (car item)
                                   :menu (make-menu m (cadr item))));;;;;FIXED
                   (ELSE
                         (apply menu-add m item))))
                items)
      m))
  (let ((f (make <Frame> :parent parent)))
    ;; Store l in the f object to avoid GC problems
    (set-widget-data! (Id f)
                      `(:menu ,l ,_at_(get-widget-data (Id f))))
    (for-each (lambda (x)
                (let* ((title (if (list? (car x)) (caar x) (car x)))
                       (rest (cdr x))
                       (mb (make <Menu-button> :text title :parent f)))

                  (if (list? (car x))
                      ;; User has specified pack options. Use them.
                      (apply pack mb (cdar x))
                      ;; Pack menubutton on left and create its associated menu
                      (pack mb :side "left"))
                  (make-menu mb rest)))
            l)
    ;; Return the created frame as result
    f))
Received on Tue Mar 05 1996 - 18:22:14 CET