[mcclim-devel] For panes, :menu-bar height is always zero. - mcclim-devel - mailman3.common-lisp.net

9 Mar 2009

      I am playing with a new mcclim, downloaded yesterday or so via
clbuild.
If I specify a :menu-bar for a pane explicitly, the height is always
zero, no matter what.  My current workaround is to use
clim-internals:make-menu-bar.
As an example, I am attaching a file, with several menubars. Moreover,
I switch the layout of the menu-bars dynamically (and can even
show/hide some bars as I want) using the movethingsaround button.
See the commented out parts in there like:
   ;;(pane2 :menu-bar :command-table 'menubarb-command-table :min-y 100
which I had to replace with clim-internals:make-menu-bar.
I am both attaching as well as including the file below.
Thanks a lot. 
-dave
-- 

;; 2009-03-08 T19:39:18-0400 (Sunday)    D. Goel
;; Some of this came from http://constantly.at/lisp/ui.html 

;;; This example manually specifies the menu-bar panes.
;; Not only that, each menu-bar's submenu is further a command-table
;; rather than a simple command.. 

;; Notice that the quit button is greyed out for mcclim because we
;; defineed it via define-command-table. We should have defined it via
;; define-frame-tag-command-table instead!

;; This method does not work for mcclim. 
;; (pane2 :menu-bar :command-table 'menubarb-command-table :min-y 100
;; The height is 0 no matter what you do. So, instead we call
;; clim-internals!

(define-command-table menubar-command-table
    :menu (("Menub" :menu menu-command-table)
       ;;("Move 2nd bar" :command move-things)
           ("Exitb" :command com-quit-frame)))

(define-command-table menubarb-command-table
    :menu (("Menu" :menu menub-command-table)
           ("Quit" :command com-quit-frame)))

(define-application-frame tags-frame ()
  ((message :initform "Message" :accessor tags-message))
  (:panes
   ;; The commented out should be the best method, but broken.
   ;; This should be the actual method in clim, but is broken
   ;; (invisible bar, so make-menu-bar instead.
   ;;(pane2 :menu-bar :command-table 'menubarb-command-table :min-y 100
   ;;:min-height 100 :height 100)
   ;;
   ;; This one is broken in mcclim for the same reason!
   ;;(pane2 (make-pane :menu-bar :command-table 'menubar-command-table
   ;;		     :height 100 :min-height 30))

   ;; We next explore two other methods to make menubar. 

   (pane1 (clim-internals::make-menu-bar 'menubar-command-table))
   (pane2 (clim-internals::make-menu-bar 'menubarb-command-table))

   (some-pane :application :display-function 'display-some-pane)
   (my-interactor :interactor)
   (mouse :pointer-documentation))
  (:layouts
   (default
     (vertically  ()
      (1/3 pane1)
      (1/3 pane2)
      (1/3 some-pane)
      (:fill my-interactor)
      mouse))
   (moved
     (vertically  ()
      (1/3 pane1)
      (1/3 some-pane)
      pane2
      (:fill my-interactor)
      mouse))))

;; Notice that while it serves as a quit function within pane1 and
;; pane2, it also shows as a "Quit frame" command on the very top
;; menu.  That part happens because we have included a :menu t below. 
(define-tags-frame-command (com-quit-frame :menu t) ()
  (frame-exit *application-frame*))

;; this was in there originally, but these are greyed out!
;; (define-command com-hello ()
;;   (setf (tags-message *application-frame*) "Hello there!"))

;; Now see, the introduction of this move-things causes mcclim to come
;; up with its own menubar as well.  If this hadn't been there, mcclim
;; would not have its own menubar.  Of course, we can also make it a
;; subpart of one of the menubars we have defined. 
(define-tags-frame-command (com-move-things :menu t) ()
  (setf
   (frame-current-layout *application-frame*)
   (if (eql (frame-current-layout *application-frame*) 'default)
       'moved 'default)))

(define-tags-frame-command com-hello ()
  (setf (tags-message *application-frame*) "Hello there!"))

(define-tags-frame-command com-exclaim ()
  (setf (tags-message *application-frame*) "You there!"))

;; Notice how this one shows greyed out!!  This is because it is not
;; defined as a tags-frame command table.  
(define-command com-hi ()
  (setf (tags-message *application-frame*) "Hi there!"))

(define-command-table menu-command-table
    :menu (("Say Hello" :command com-hello)
           ("Say Hi" :command com-hi)))

(define-command-table menub-command-table
    :menu (("Exclaim" :command com-exclaim)
           ("Exclaim" :command com-exclaimb)))

(defun test ()
  (flet ((run ()
       ;; Intentional sleep to test the sleep-enough function below.
       (sleep 1)
       (let ((frame 
    	  (make-application-frame 
    	   'tags-frame
    	   :top 0
    	   :left 0 :right 3000 :bottom 30000
    	   )))
         (setq *test-frame* frame) (run-frame-top-level frame))))
    (mp:process-run-function "tags" #'run)))
(defmethod display-some-pane ((frame tags-frame) stream)
  (format stream (tags-message frame)))

(defmethod display-another-pane ((frame tags-frame) stream)
  (declare (ignore stream))
  (let ((pane (get-frame-pane *application-frame* 'another-pane)))
    (window-clear pane)
    (draw-rectangle* pane 10 10 200 150 :filled nil :line-thickness 2)
    (draw-ellipse* pane 150 100 10 0 0 30)))