[spr1065] Re: Non-popup menus in Common Windows

[jdi@Franz.COM (John Irwin)]

I hadn't noticed you had sent your request to allegro-cl also.  I'm
forwarding you my reply again for benefit of the mailing list.

	-- John Irwin
	   Franz Inc.

--

From: jdi (John Irwin)
To: kthompso@ptolemy.arc.nasa.gov
Subject: Re: [spr1065] Non-popup menus in Common Windows

Your message:

    We have an application for which we need non-popup (static?) menus, which X
    Common Windows does not provide.  Is there something really tricky/complex
    hurdle we're missing that makes this hard to do?? If not, how come xcw
    doesn't have it by default? The Composer Podium window looks fine, we want
    something like that, but I'm wondering if there's some "gotcha" that makes
    this hard to do in a general way as with pop-up menus.  I'm guessing that
    it has something to do with multiprocessing, event handler interactions,
    but not too sure (sorry I'm vague).

    So if anyone has experience with this, I'd appreciate any sage, experienced
    advice :).  Any wonderful code that makes this simple is of course
    appreciated.

    Thanks!

    Kevin Thompson
    kthompso@ptolemy.arc.nasa.gov     Sterling Software/Nasa-Ames Research
				      Center
--------

The real problem is that we couldn't decide how to define the behaviour and
control of a static menu.  A pop-up menu is simple; you call a function
that pops up the menu, and when the user finishes with the menu you get
a return value back.

A static menu has totally different behaviour.  A static menu item can be
selected at any time; thus you must define a protocol for how messages get
sent from the menu to the object interested in them, etc.  We decided this
was beyond the scope of our xcw 1.3final project.  I have added your request
to our list of requested enhancements for a future version of XCW.  (For
your information, several other customers have requested this and we consider
it desirable, but cannot promise a delivery date.)  We appreciate your
request as this is a primary input in how we prioritize work to be done for
future releases.

I have included below some example code written by a developer here that
implements simple static menus.  This example was actually written more
to illustrate the methods necessary to prevent deadlock in a multiprocessing
window environment, but you should be able to use most of the code anyway.

Please let us know if you have further questions.

	-- John Irwin
	   Franz Inc.

-- slice --

;;;
;;; Copyright (c) 1990 Franz Inc, Berkeley, Ca.
;;;
;;; Permission is granted to any individual or institution to use, copy,
;;; modify, and distribute this software, provided that this complete
;;; copyright and permission notice is maintained, intact, in all copies and
;;; supporting documentation.
;;;
;;; Franz Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;

#| This code demonstrates solutions to the cw problem where mouse
button or keypress (typed character) events can be blocked if the
event handler is still processing an earlier event.

The user clicks on an item in a static menu window, which pops up
another window to type into.  Ordinarily the single event handler
would be waiting for the menu window's button method to return, and
therefore not processing the typed characters as they are typed.
Depending on the value of *event-handler-mode-p*, this code will
either use process-run-function to allow the button method to return,
or set up individual event handlers for the two windows involved.

It also demonstrates a way to set up active regions with strings in
them, to serve as a static menu. |#

;; Set this var to non-NIL to use a separate event handler for
;; the menu window and the type-in window.  Set it to NIL
;; to use process-run-function instead.  Be sure to run "setup"
;; after changing the value of this variable.
;; NOTE:  In xcw pilot, in event handler mode you must move the
;; mouse cursor to some window other than the menu before you
;; can type into the type-in window --- this bug is being fixed
;; for xcw final.
(defparameter *event-handler-mode-p* nil)

(defparameter *type-in-window* nil)
(defparameter *menu* nil)
(defparameter *items* '(("Name" :name)
			("Quest" :quest)
			("Favorite Color" :color)))
(defparameter *menu-font* (open-font :helvetica :roman 12 :weight :bold))

;; Call this function to create the menu window, which you can
;; then click on at any time.
(defun menu-setup (&optional (items *items*))
  (setq *menu* (make-window-stream
		:activate-p t
		:left 750 :bottom 100
		:font *menu-font*
		:width 150
		:inner-height (* (font-character-height *menu-font*)
				 (length items))
		:title "Answer one"))

  ;; Create active-region menu items.
  (do* ((items items (cdr items))
	(item (car items)(car items))
	(line-height (window-stream-linefeed-height *menu*))
	(y (- (window-stream-inner-height *menu*) line-height)
	   (- y line-height))
	(font (window-stream-font *menu*))
	(baseline (font-baseline font))
	ar)
      ((null items))
    (setq ar
      (make-active-region :parent *menu*
			  :activate-p t
			  :left 0 :bottom y
			  :width (font-string-width font (first item))
			  :height line-height))
    (setf (active-region-get ar :item) item)
    (setf (active-region-button ar) '(ar-button))
    (setf (active-region-mouse-cursor-in ar) '(ar-in))
    (setf (active-region-mouse-cursor-out ar) '(ar-out))
    (draw-string-xy *menu* 0 (+ y baseline)(first item))
    )

  (setq *type-in-window*
    (make-window-stream :left (window-stream-left *menu*)
			:bottom (window-stream-top *menu*)
			:width (window-stream-width *menu*)
			:height 100
			:title "Type here now"))

  (when *event-handler-mode-p*
    (enable-window-stream-event-handling *menu*) 
    (enable-window-stream-event-handling *type-in-window*)))

(defun ar-button (ar &rest ignore)
  (if *event-handler-mode-p*
      (ar-button-low ar)
    (mp::process-run-function nil #'ar-button-low ar)))

(defun ar-button-low (ar)
  (unwind-protect
      (progn
	(invert-active-region ar)
	(print (list (second (active-region-get ar :item))
		     (readit *type-in-window*)))
	(force-output))
    (invert-active-region ar)))

(defun readit (stream)
  (cond ((eq (window-stream-status stream) :active)
	 :busy)
	(t
	 (clear stream)(reset stream)(expose stream)
	 (prog1
	     (with-window-stream-selected stream (readit-now stream))
	   (deactivate stream)))))

(defun readit-now (stream)
      (rubout-handler :stream stream :do-not-echo '(#\newline)
		      :body (progn (do ((char (read-char stream)
					      (read-char stream)))
				       ((char= char #\newline) t))
				   (get-rubout-handler-buffer stream))))

(defun ar-text-redo (window &rest ignore)
  (declare (ignore ignore))
  (let ((*create-ars-p* t))
    (repaint window)))

(defun ar-in (ar &rest ignore)
  (declare (ignore ignore))
  (box-active-region ar))

(defun ar-out (ar &rest ignore)
  (declare (ignore ignore))
  (box-active-region ar))

(defun box-active-region (ar)
  (draw-rectangle-xy (active-region-parent ar)
		     (active-region-left ar)
		     (active-region-bottom ar)
		     (active-region-width ar)
		     (active-region-height ar)
		     :operation boole-xor))

(defun invert-active-region (ar)
  (complement-rectangle-xy
   (active-region-parent ar)(active-region-left ar)(active-region-bottom ar)
   (active-region-width ar)(active-region-height ar)))

(format t "~%Call (menu-setup) to create static menu, then click on it.")