home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / comp / lang / lisp / mcl / 1627 < prev    next >
Encoding:
Text File  |  1992-11-18  |  6.5 KB  |  187 lines
  1. Newsgroups: comp.lang.lisp.mcl
  2. Path: sparky!uunet!sun-barr!cs.utexas.edu!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!mp.cs.niu.edu!uxa.ecn.bgu.edu!news.ils.nwu.edu!splat.ils.nwu.edu!user
  3. From: jona@ils.nwu.edu (Kemi Jona)
  4. Subject: Sequence dialog items with help balloons for each cell
  5. Message-ID: <jona-181192190156@splat.ils.nwu.edu>
  6. Followup-To: comp.lang.lisp.mcl
  7. Sender: usenet@ils.nwu.edu (Mr. usenet)
  8. Nntp-Posting-Host: splat.ils.nwu.edu
  9. Organization: Institute for the Learning Sciences
  10. Date: Thu, 19 Nov 1992 00:43:03 GMT
  11. Lines: 174
  12.  
  13. Ever want to have a separate help balloon appear for each item in a table? 
  14. Here's an extension to some code posted to comp.lang.lisp.mcl by Bill St.
  15. Clair that does just that.  It defines a specialization of
  16. sequence-dialog-item called sequence-di-with-cell-help.  You supply a
  17. function that is passed the contents of the cell the mouse is over.  That
  18. function returns a string which is then displayed in the balloon.
  19.  
  20. I've included the original code posted by Bill for those who didn't grab it
  21. the first time around.
  22.  
  23. Save following as file viewless-balloon-help.lisp
  24.  
  25. ; viewless-balloon-help.lisp
  26. ; (from Bill St. Clair via comp.lang.lisp.mcl)
  27. ; Define a VIEW-SECTION generic function which can
  28. ; be used to generate different balloon help strings for
  29. ; different parts of a view (or window). Make the balloon help
  30. ; code call it.
  31.  
  32. (in-package :ccl)
  33.  
  34. (require "HELP-MANAGER")
  35.  
  36. (let ((*warn-if-redefine* nil))
  37.  
  38. ; This is a patch for the show-mouse-view-balloon function in
  39. ; ccl:library;help-manager.lisp".
  40. ; You may wish to put this code in that file.
  41.  
  42. (export 'view-section)
  43.  
  44. ; view-section should return a token for the section of the
  45. ; view that includes the point given as the second argument.
  46. ; If the second arg is not specified, it should default to
  47. ; the mouse position. The token can be any Lisp object. EQ
  48. ; is used to determine if the mouse has entered a new section.
  49. (defmethod view-section (view &optional where)
  50.   (declare (ignore view where))
  51.   nil)
  52.  
  53. (defvar *mouse-view-section* nil)
  54. (defvar *mouse-view-section-view* nil)
  55.  
  56. (defun show-mouse-view-balloon ()
  57.   (let* ((mouse-view *mouse-view*)
  58.          (section (if (eq *mouse-view-section-view* mouse-view)
  59.                     *mouse-view-section*
  60.                     (progn
  61.                       (setq *mouse-view-section*
  62.                             (and mouse-view (view-section mouse-view)))
  63.                       (setq *mouse-view-section-view* mouse-view)
  64.                       nil))))
  65.     ;; if we go outside the content region, then another balloon has taken
  66.     ;; over, and we just return
  67.     (unless mouse-view
  68.       (setq *view-with-balloon* nil)
  69.       (return-from show-mouse-view-balloon))
  70.     ;; no balloon means someone else has put up a balloon or gotton rid of
  71. ours
  72.     (when (not (#_hmisballoon)) (setq *view-with-balloon* nil))
  73.     ;;if we are not in the same view as before, get rid of old, and put up
  74. new
  75.     (when (or (neq *view-with-balloon* mouse-view)
  76.               (and section 
  77.                    (neq section
  78.                         (setq *mouse-view-section* (view-section
  79. mouse-view)))))
  80.       (#_hmremoveballoon)
  81.       (view-put-up-balloon mouse-view))))
  82.  
  83. )
  84.  
  85.  
  86. ;;; added by Kemi Jona (jona@ils.nwu.edu)
  87. ;;; a specialized sequence dialog item that can supply help balloons
  88. ;;; for each cell
  89. ;;; Supply function to the :cell-help-spec initarg that takes one argument.
  90. ;;; It will be passed the cell-contents of the cell in the table that
  91. ;;; the mouse is over.  If the mouse isn't over a cell, the regular
  92. ;;; help-spec for the table will be used.
  93.  
  94. ;;; Note:  there seems to be a bit of sloppiness detecting which cell
  95. ;;; the mouse is over.  Sometimes the cell-help-spec balloon is shown
  96. ;;; when the mouse is over a scroll bar.  This may just be a function
  97. ;;; of the help balloon system.
  98.  
  99. (defclass sequence-di-with-cell-help (sequence-dialog-item) 
  100.   ((cell-help-spec :accessor cell-help-spec :initarg :cell-help-spec))
  101.   (:default-initargs :cell-help-spec nil))
  102.  
  103. ;;; return the cell to use as a unique identifier or return the
  104. ;;; scroll bar view if not over a cell.  the latter is needed so
  105. ;;; that we can tell when we go back over a cell again.
  106.  
  107. (defmethod view-section ((di sequence-di-with-cell-help)
  108.                          &optional (where (view-mouse-position di)))
  109.   (or (point-to-cell di where)
  110.       (find-view-containing-point di where)))
  111.  
  112. ;;; wrapping a funcall in a lambda seems redundant, but using the
  113. ;;; help-string method as shown in the example below was crashing
  114. ;;; my machine.  This at least works even if it isn't pretty.
  115.  
  116. (defmethod help-spec ((di sequence-di-with-cell-help))
  117.   (let ((cell (point-to-cell di (view-mouse-position di))))
  118.     (if (and cell (cell-help-spec di))
  119.       #'(lambda (item)
  120.           (funcall (cell-help-spec item) 
  121.                    (cell-contents item cell)))
  122.       ;; call the main help-spec for the view
  123.       (call-next-method))))
  124.  
  125.  
  126. #|
  127.  
  128. (setq w (make-instance 'dialog))
  129.  
  130. (setq di (make-instance 'sequence-di-with-cell-help
  131.            :view-position #@(10 10)
  132.            :view-size #@(200 100)
  133.            :table-sequence '(a b c d e f g)
  134.            :table-hscrollp nil
  135.            :cell-size #@(184 20)
  136.            :help-spec "This is the help string for the whole table."
  137.            :cell-help-spec
  138.            #'(lambda (item) (format nil "~a is the item" item))))
  139.  
  140. (add-subviews w di)
  141.  
  142. |#
  143.  
  144. #|
  145. ; Example window displays different balloon help strings
  146. ; on its right and left sides
  147.  
  148. (defclass my-window (window)
  149.   ((saved-view-section :accessor saved-view-section :initarg nil)))
  150.  
  151. (defmethod view-draw-contents ((w my-window))
  152.   (let* ((size (view-size w))
  153.          (size-h/2 (floor (point-h size) 2))
  154.          (size-v (point-v size)))
  155.     (#_Moveto size-h/2 0)
  156.     (#_Lineto size-h/2 size-v)))
  157.  
  158. (defmethod view-section ((w my-window) &optional
  159.                          (where (view-mouse-position w)))
  160.   (let ((h (point-h where)))
  161.     (setf (saved-view-section w)
  162.           (if (> h (floor (point-h (view-size w)) 2))
  163.             :right
  164.             :left))))
  165.  
  166. (defmethod help-string ((w my-window))
  167.   (if (eq (saved-view-section w) :right)
  168.     "You're pointing at the right half of this window"
  169.     "You're pointing at the left half of this window"))
  170.  
  171. (make-instance 'my-window)
  172.  
  173.  
  174.  
  175. |#
  176.  
  177.  
  178.  
  179.  
  180. --Kemi
  181.  
  182. ------------------------------------------------------------
  183. Kemi Jona           jona@ils.nwu.edu             
  184. Institute for the Learning Sciences, Northwestern University             
  185. 1890 Maple Ave., Rm.354, Evanston, IL 60201                  
  186. (708) 467-1969 or 491-3500     FAX: (708) 491-5258                
  187.