🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.lisp.mcl
Article #705

Re: Balloon help descenders missing

#705
From: Bill St. Clair
Date: Thu, 07 Jan 1993 20:14
51 lines
2646 bytes
>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))
Technical Details
Message-ID: <9301071908.AA10145@cambridge.apple.com>
Path: arc1-ca.pugleaf.net!sparky!uunet!stanford.edu!apple!cambridge.apple.com!bill@cambridge.apple.com

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!sparky!uunet!stanford.edu!apple!cambridge.apple.com!bill@cambridge.apple.com
From: bill@cambridge.apple.com (Bill St. Clair)
Newsgroups: comp.lang.lisp.mcl
Subject: Re: Balloon help descenders missing
Message-ID: <9301071908.AA10145@cambridge.apple.com>
Date: 7 Jan 93 20:14:48 GMT
Sender: info-mcl-request@cambridge.apple.com
Lines: 51
Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M