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

Re: Balloon help descenders missing

>In this sequence:
>1. Launch MCL 2.0p1
>2. Bring up one of the various dialogs (first seen with the dialog posed by
>the Environment... item in the Tools menu)
>3. Turn on balloon help.

Thank you for telling me how to reliably duplicate this problem.
I have seen it from time to time, but never knew how to make it
happen reliably. Your message motivated me to look at the problem
again, and I found a fix this time:


; help-descenders-patch.lisp
; Fix the missing descenders in MCL's balloon help.
; This is a source patch for "ccl:library;help-manager.lisp".

(defun help-tehandle (string &aux (length (length string)))
   "returns a texthandle with string as it's string contents. There is one terec *help-tehandle*"
   (let ((terec *help-tehandle*)
         font size)
     (if terec
       ; Necessary because bug in system neglects to initialize these.
       (setf (href terec :terec.destrect.topleft) #@(5 5)
             (href terec :terec.destrect.botRight) #@(100 100)
             (href terec :terec.viewrect.topleft) #@(5 5)
             (href terec :terec.viewrect.botRight) #@(100 100))
       (rlet ((r :rect
                 :topleft #@(5 5)
                 :bottomright #@(100 100)))
         (setq *help-tehandle* (setq terec (#_tenew r r)))))
     (rlet ((font-info :integer))
       (#_HMGetFont font-info)
       (setf (href terec :terec.txfont)
             (setq font (%get-word font-info)))
       (#_HMGetFontSize font-info)
       (setf (href terec :terec.txsize)
             (setq size (%get-word font-info)))
       (setf (href terec :terec.txmode) 0)
       (setf (href terec :terec.txface) 0))
     (multiple-value-bind (ascent descent maxwid leading)
                          (font-codes-info (make-point 0 font)
                                           (make-point size 0))
       (declare (ignore maxwid))
       (setf (href terec :terec.fontascent) ascent
             ; maybe this should be just (+ ascent descent)
             (href terec :terec.lineheight) (+ ascent descent leading)))
     (with-cstr (cs string 0 length)
       (#_tesettext cs length terec))