[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: ballon-help ?

>I have a window with different parts. This parts are NOT represented by
>views but dirrectly drawn in the window.
>I would like to have two different help ballons for this parts. My window
>has a method to know in which part is the cursor.
>I tried to figure out how to write method for ballon help from the file
>help-manager.lisp but nothing happened (I'm trying to think but ...:-)
>It is seems that there is a view-help-event-handler but where it is defined ????
>I anyone has an idea....

The help-manager code doesn't support that as is. Fortunately, it's
not hard to make it do so:


; viewless-balloon-help.lisp
; 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))

(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)
                      (setq *mouse-view-section*
                            (and mouse-view (view-section mouse-view)))
                      (setq *mouse-view-section-view* mouse-view)
    ;; 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)))))
      (view-put-up-balloon mouse-view))))


; 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))

(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)