[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[spr1065] Re: Non-popup menus in Common Windows
Hello --- When I saw your request, it occurred to me that the static
menu example sent to you earlier could easily be enhanced to provide a
general static menu capability. (I neglected to tell John that I was
updating the code, though, so he went ahead and sent the current
version.) Below is a new version with changes I made today.
In particular, the action to be taken when picking a menu item is
no longer hard-coded into the example, but is now passed as a
part of the menu-items list. The general part of the code has been
separated out into the function make-static-menu. If anything is
unclear, please let know.
Ken Cheetham, Franz Inc. 1995 University Avenue, Suite 275
internet: cheetham@franz.com Berkeley, CA 94704
uucp: ...uunet!franz!cheetham voice: 415-548-3600
"It's later than it's ever been!" fax: 415-548-8253
--------------------------------------------------------------------------
;;; Copyright (c) 1987, 1988, 1989, 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 "menu-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 fixed
;; for xcw final.
(defparameter *event-handler-mode-p* nil)
;; These special variables are rebound in the process that performs
;; the menu item action, so you can know (in your menu item action code)
;; which menu and item were buttoned on.
(defparameter *menu* nil)
(defparameter *menu-item* nil)
;; The item-list arg to make-static-menu should be a list where each
;; member is a list of (1) a string to display in the menu and
;; (2) a lisp form to execute when the item is buttoned on.
(defparameter *items* '(("Name" (get-answer-and-print :name))
("Quest" (get-answer-and-print :quest))
("Favorite Color" (get-answer-and-print :color))
("Reshape" (reshape-menu))))
;; Call this function to create our example menu, which you can
;; then click on at any time.
(defun menu-setup
(&optional (items *items*)
(item-font (open-font :helvetica :roman 12 :weight :bold)))
(let* ((menu (make-static-menu items 750 100
:item-font item-font))
(type-in-window (make-window-stream
:left (window-stream-left menu)
:bottom (window-stream-top menu)
:width (window-stream-width menu)
:height 50
:title "Type here now")))
(setf (window-stream-get menu :type-in-window) type-in-window)
(when *event-handler-mode-p*
(enable-window-stream-event-handling menu)
(enable-window-stream-event-handling type-in-window))))
;; ---------------------------------------------------------------------
;; General code for creating a static menu.
(defun make-static-menu
(items left bottom &key (item-font *system-font*)
(title-font *title-font*))
(let* ((font-height (font-character-height item-font))
(menu (make-window-stream
:activate-p t
:left left :bottom bottom
:font item-font
:title-font title-font
:inner-width
(do* ((items items (cdr items))
(width (font-string-width item-font
(or (caar items) ""))
(font-string-width item-font
(or (caar items) "")))
(max-width width (max max-width width)))
((null items)
(+ max-width 4)))
:inner-height (* font-height (length items))
:title "Answer one")))
;; Create active-region menu items.
(do* ((items items (cdr items))
(item (car items)(car items))
(y (- (window-stream-inner-height menu) font-height)
(- y font-height))
(baseline (font-baseline item-font))
ar)
((null items))
(setq ar
(make-active-region :parent menu
:activate-p t
:left 0 :bottom y
:width (font-string-width item-font (first item))
:height font-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)))
menu))
(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
(let ((action (second (active-region-get ar :item)) ar)
(*menu-item* ar)
(*menu* (active-region-parent ar)))
(invert-active-region ar)
(apply (car action)(cdr action)))
(invert-active-region ar)))
;; ---------------------------------------------------------------------
;; Highlighting of active regions (general code).
(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)))
;; ---------------------------------------------------------------------
;; Application-specific code for our menu item actions.
(defun get-answer-and-print (key)
(print (list key (readit (window-stream-get *menu* :type-in-window))))
(force-output))
(defun readit (stream)
(cond ((eq (window-stream-status stream) :active)
:type-in-window-is-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 reshape-menu ()
(cw::get-region-and-reshape *menu*)
(setf (window-stream-position (window-stream-get *menu* :type-in-window))
(make-position :x (window-stream-left *menu*)
:y (window-stream-top *menu*))))
;; ---------------------------------------------------------------------
(format t "~%Call (menu-setup) to create static menu, then click on it.")