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