Sequence dialog items with help balloons for each cell

[jona@ils.nwu.edu (Kemi Jona)]

Ever want to have a separate help balloon appear for each item in a table? 
Here's an extension to some code posted to comp.lang.lisp.mcl by Bill St.
Clair that does just that.  It defines a specialization of
sequence-dialog-item called sequence-di-with-cell-help.  You supply a
function that is passed the contents of the cell the mouse is over.  That
function returns a string which is then displayed in the balloon.

I've included the original code posted by Bill for those who didn't grab it
the first time around.

Save following as file viewless-balloon-help.lisp

; viewless-balloon-help.lisp
; (from Bill St. Clair via comp.lang.lisp.mcl)
; Define a VIEW-SECTION generic function which can
; be used to generate different balloon help strings for
; different parts of a view (or window). Make the balloon help
; code call it.

(in-package :ccl)

(require "HELP-MANAGER")

(let ((*warn-if-redefine* nil))

; This is a patch for the show-mouse-view-balloon function in
; ccl:library;help-manager.lisp".
; You may wish to put this code in that file.

(export 'view-section)

; view-section should return a token for the section of the
; view that includes the point given as the second argument.
; If the second arg is not specified, it should default to
; the mouse position. The token can be any Lisp object. EQ
; is used to determine if the mouse has entered a new section.
(defmethod view-section (view &optional where)
  (declare (ignore view where))
  nil)

(defvar *mouse-view-section* nil)
(defvar *mouse-view-section-view* nil)

(defun show-mouse-view-balloon ()
  (let* ((mouse-view *mouse-view*)
         (section (if (eq *mouse-view-section-view* mouse-view)
                    *mouse-view-section*
                    (progn
                      (setq *mouse-view-section*
                            (and mouse-view (view-section mouse-view)))
                      (setq *mouse-view-section-view* mouse-view)
                      nil))))
    ;; if we go outside the content region, then another balloon has taken
    ;; over, and we just return
    (unless mouse-view
      (setq *view-with-balloon* nil)
      (return-from show-mouse-view-balloon))
    ;; no balloon means someone else has put up a balloon or gotton rid of
ours
    (when (not (#_hmisballoon)) (setq *view-with-balloon* nil))
    ;;if we are not in the same view as before, get rid of old, and put up
new
    (when (or (neq *view-with-balloon* mouse-view)
              (and section 
                   (neq section
                        (setq *mouse-view-section* (view-section
mouse-view)))))
      (#_hmremoveballoon)
      (view-put-up-balloon mouse-view))))

)


;;; added by Kemi Jona (jona@ils.nwu.edu)
;;; a specialized sequence dialog item that can supply help balloons
;;; for each cell
;;; Supply function to the :cell-help-spec initarg that takes one argument.
;;; It will be passed the cell-contents of the cell in the table that
;;; the mouse is over.  If the mouse isn't over a cell, the regular
;;; help-spec for the table will be used.

;;; Note:  there seems to be a bit of sloppiness detecting which cell
;;; the mouse is over.  Sometimes the cell-help-spec balloon is shown
;;; when the mouse is over a scroll bar.  This may just be a function
;;; of the help balloon system.

(defclass sequence-di-with-cell-help (sequence-dialog-item) 
  ((cell-help-spec :accessor cell-help-spec :initarg :cell-help-spec))
  (:default-initargs :cell-help-spec nil))

;;; return the cell to use as a unique identifier or return the
;;; scroll bar view if not over a cell.  the latter is needed so
;;; that we can tell when we go back over a cell again.

(defmethod view-section ((di sequence-di-with-cell-help)
                         &optional (where (view-mouse-position di)))
  (or (point-to-cell di where)
      (find-view-containing-point di where)))

;;; wrapping a funcall in a lambda seems redundant, but using the
;;; help-string method as shown in the example below was crashing
;;; my machine.  This at least works even if it isn't pretty.

(defmethod help-spec ((di sequence-di-with-cell-help))
  (let ((cell (point-to-cell di (view-mouse-position di))))
    (if (and cell (cell-help-spec di))
      #'(lambda (item)
          (funcall (cell-help-spec item) 
                   (cell-contents item cell)))
      ;; call the main help-spec for the view
      (call-next-method))))


#|

(setq w (make-instance 'dialog))

(setq di (make-instance 'sequence-di-with-cell-help
           :view-position #@(10 10)
           :view-size #@(200 100)
           :table-sequence '(a b c d e f g)
           :table-hscrollp nil
           :cell-size #@(184 20)
           :help-spec "This is the help string for the whole table."
           :cell-help-spec
           #'(lambda (item) (format nil "~a is the item" item))))

(add-subviews w di)

|#

#|
; Example window displays different balloon help strings
; on its right and left sides

(defclass my-window (window)
  ((saved-view-section :accessor saved-view-section :initarg nil)))

(defmethod view-draw-contents ((w my-window))
  (let* ((size (view-size w))
         (size-h/2 (floor (point-h size) 2))
         (size-v (point-v size)))
    (#_Moveto size-h/2 0)
    (#_Lineto size-h/2 size-v)))

(defmethod view-section ((w my-window) &optional
                         (where (view-mouse-position w)))
  (let ((h (point-h where)))
    (setf (saved-view-section w)
          (if (> h (floor (point-h (view-size w)) 2))
            :right
            :left))))

(defmethod help-string ((w my-window))
  (if (eq (saved-view-section w) :right)
    "You're pointing at the right half of this window"
    "You're pointing at the left half of this window"))

(make-instance 'my-window)



|#




--Kemi

------------------------------------------------------------
Kemi Jona           jona@ils.nwu.edu             
Institute for the Learning Sciences, Northwestern University             
1890 Maple Ave., Rm.354, Evanston, IL 60201                  
(708) 467-1969 or 491-3500     FAX: (708) 491-5258