;;; Copyright (c) 2023
;;;   John Carroll, Ann Copestake, Robert Malouf, Stephan Oepen;
;;;   see `LICENSE' for conditions.

(in-package :lkb)

;;; McCLIM only
;;; Tooltips displaying LKB type documentation - available in feature structure and type
;;; hierarchy windows 

;;; Needs (ql:quickload :mcclim-tooltips)
;;; For tooltips documentation, see tooltips/README.org at
;;; https://codeberg.org/charliemac/McCLIM/src/branch/master/Extensions/

(defun display-type-comment-tooltip (type-name stream record)
  (let* ((type-entry (get-type-entry type-name))
         (comment (and type-entry (ltype-comment type-entry))))
    (when comment
      (mcclim-tooltips:draw-tooltip stream comment
        :text-render-fn 'draw-type-comment-text
        :region record))))

(defun draw-type-comment-text (medium s x y &rest keys)
  (apply #'clim:draw-text*
    medium s x (- y 2) ; up 2 units otherwise last line ends up too close to bottom
    keys))

;;; Use tooltip defaults for background colour, text colour, text style etc.
;;; NB Automatic line wrapping at 40 characters, but newlines are respected

(clim:define-presentation-method clim:highlight-presentation :after
  ((type type-thing) record stream (state (eql :highlight)))
  (display-type-comment-tooltip
    (type-thing-value (clim:presentation-object record)) stream record))

(clim:define-presentation-method clim:highlight-presentation :after
  ((type type-thing) record stream (state (eql :unhighlight)))
  (declare (ignore record))
  (mcclim-tooltips:erase-tooltip stream))

(clim:define-presentation-method clim:highlight-presentation :after
  ((type hier-node) record stream (state (eql :highlight)))
  (display-type-comment-tooltip (clim:presentation-object record) stream record))

(clim:define-presentation-method clim:highlight-presentation :after
  ((type hier-node) record stream (state (eql :unhighlight)))
  (declare (ignore record))
  (mcclim-tooltips:erase-tooltip stream))