9 Mar
2009
9 Mar
'09
1:26 a.m.
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)))