Two Mouse Clicks to Discard Window Resource

• To: clim@BBN.COM
• Subject: Two Mouse Clicks to Discard Window Resource
• From: will taylor <taylor@charon.arc.nasa.gov>
• Date: Tue, 14 Jul 1992 17:18-0700
• Cc: taylor@charon.arc.nasa.gov

Symbolics 8.1.1 - CLIM 1.1

When my application menu command is clicked and it puts up a menu
with CLIM:WITH-MENU and I want to discard it, I click once and it
is gone and any mouse sensitive presentations on my frame are again
mouse sensitive.  I created a "both-scroll-menu" which is resource
like MENU, but has both scroll bars and I use it to show the user 
information which may be of large extent in both directions.  The
only problem is that it takes TWO mouse clicks off the "both-scroll-menu"
1) to discard the menu, and 2) to get mouse sensitivity back for the
presentations.  My code is below -- I must be neglecting something ..

Thanks for any suggestions.
==> Will Taylor

(clim::defresource BOTH-SCROLL-MENU (associated-window root)
  :constructor (open-window-stream :parent root	
				   :left 100 :top 100 :width 600 :height 400	;"random" size
				   :scroll-bars ':both
				   :window-class (clim::menu-class-name root)
				   :save-under t)
  :initializer (clim::initialize-menu both-scroll-menu associated-window)
  :deinitializer (progn (setf (window-visibility both-scroll-menu) nil)
			(window-clear both-scroll-menu)
			(setf (window-label both-scroll-menu) nil))
  :matcher (eql (window-parent both-scroll-menu) root))

(defmacro WITH-BOTH-SCROLL-MENU ((menu associated-window &key (label "   "))
				&body body)
  "bring up both scroll bar menu with output in body"
  (let ((window '#:associated-window))
    `(let ((,window ,associated-window))
       (clim::using-resource (,menu both-scroll-menu
			      (window-top-level-window ,window)
			      (window-root ,window))
		       (clim::letf-globally (((stream-default-view ,window) +menu-view+))
			 (formatting-table (,menu :inter-row-spacing 5)
			   (formatting-row (,menu)
			     (formatting-cell (,menu :align-x :center)
			       (DRAW-MENU-LABEL ,label 0 ,menu)))
			   (formatting-row (,menu)
			     (formatting-cell (,menu :align-x :center)
			       ,@body
			       (with-text-face (:italic ,menu)
				 (format ,menu "~%To discard: Click TWICE off menu ~%")))))
			 (clim::size-menu-appropriately ,menu)
			 (multiple-value-bind (x y)
			     (clim::pointer-position* (stream-primary-pointer
							,associated-window))
			   (clim::position-window-near-carefully ,menu x y))
			 (window-expose ,menu)
			 (stream-input-wait ,associated-window))))))

(define-evolutionary-tree-frame-command (COM-MATRIX)
    ((pane 'scaled-editor-pane-class))
  (let* ((frame *application-frame*)
	 (associated-window (frame-top-level-window frame))
	 (matrix-type (menu-choose-item
			:question "Choose matrix type"
			:item-list '(("dna" :value genesys::dna)
				     ("rna" :value genesys::rna)
				     ("amino acid" :value genesys::amino))
			:no-menu-if-1-item-p t
			:associated-window associated-window)))
    (when matrix-type
      (let ((label-format-string (case matrix-type
				   (genesys::dna "~A: DNA Matrix")
				   (genesys::rna "~A: RNA Matrix")
				   (genesys::amino "~A: Amino Acid Matrix"))))
	;; pop-up a scrollable window
	(WITH-BOTH-SCROLL-MENU (menu associated-window
				     :label (format nil label-format-string
						    (name (current-tree pane))))
	  (case matrix-type
	    (genesys::dna
	      (GENESYS::MATRIX-PRINT-MATRIX
		(first (genesys::transition-matrices
			 (genesys-tree (current-tree pane))))
		:stream menu)
	      (format menu "~%"))
	    (otherwise
	      (format menu "    NOT AVAILABLE YET ~%"))))))))
------------------------------------------------------------------------

• Prev: Please remove me
• Next: bulk text editing.
• Index: CLIM Mailing list (1-Jan-92 to 31-Aug-92)
• Thread: CLIM Mailing list Index (1-Jan-92 to 31-Aug-92)