[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Balloon help descenders missing
- To: jwbaxter@halcyon.halcyon.com
- Subject: Re: Balloon help descenders missing
- From: bill@cambridge.apple.com (Bill St. Clair)
- Date: Thu, 7 Jan 1993 14:14:48 -0600
- Cc: info-mcl
>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))
terec))