home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #1 / NN_1993_1.iso / spool / comp / lang / lisp / mcl / 1949 < prev    next >
Encoding:
Text File  |  1993-01-07  |  2.5 KB  |  62 lines
  1. Path: sparky!uunet!stanford.edu!apple!cambridge.apple.com!bill@cambridge.apple.com
  2. From: bill@cambridge.apple.com (Bill St. Clair)
  3. Newsgroups: comp.lang.lisp.mcl
  4. Subject: Re: Balloon help descenders missing
  5. Message-ID: <9301071908.AA10145@cambridge.apple.com>
  6. Date: 7 Jan 93 20:14:48 GMT
  7. Sender: info-mcl-request@cambridge.apple.com
  8. Lines: 51
  9. Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M
  10.  
  11. >In this sequence:
  12. >1. Launch MCL 2.0p1
  13. >2. Bring up one of the various dialogs (first seen with the dialog posed by
  14. >the Environment... item in the Tools menu)
  15. >3. Turn on balloon help.
  16.  
  17. Thank you for telling me how to reliably duplicate this problem.
  18. I have seen it from time to time, but never knew how to make it
  19. happen reliably. Your message motivated me to look at the problem
  20. again, and I found a fix this time:
  21.  
  22. ---------------------------------------------------------------------
  23.  
  24. ; help-descenders-patch.lisp
  25. ;
  26. ; Fix the missing descenders in MCL's balloon help.
  27. ; This is a source patch for "ccl:library;help-manager.lisp".
  28.  
  29. (defun help-tehandle (string &aux (length (length string)))
  30.    "returns a texthandle with string as it's string contents. There is one terec *help-tehandle*"
  31.    (let ((terec *help-tehandle*)
  32.          font size)
  33.      (if terec
  34.        ; Necessary because bug in system neglects to initialize these.
  35.        (setf (href terec :terec.destrect.topleft) #@(5 5)
  36.              (href terec :terec.destrect.botRight) #@(100 100)
  37.              (href terec :terec.viewrect.topleft) #@(5 5)
  38.              (href terec :terec.viewrect.botRight) #@(100 100))
  39.        (rlet ((r :rect
  40.                  :topleft #@(5 5)
  41.                  :bottomright #@(100 100)))
  42.          (setq *help-tehandle* (setq terec (#_tenew r r)))))
  43.      (rlet ((font-info :integer))
  44.        (#_HMGetFont font-info)
  45.        (setf (href terec :terec.txfont)
  46.              (setq font (%get-word font-info)))
  47.        (#_HMGetFontSize font-info)
  48.        (setf (href terec :terec.txsize)
  49.              (setq size (%get-word font-info)))
  50.        (setf (href terec :terec.txmode) 0)
  51.        (setf (href terec :terec.txface) 0))
  52.      (multiple-value-bind (ascent descent maxwid leading)
  53.                           (font-codes-info (make-point 0 font)
  54.                                            (make-point size 0))
  55.        (declare (ignore maxwid))
  56.        (setf (href terec :terec.fontascent) ascent
  57.              ; maybe this should be just (+ ascent descent)
  58.              (href terec :terec.lineheight) (+ ascent descent leading)))
  59.      (with-cstr (cs string 0 length)
  60.        (#_tesettext cs length terec))
  61.      terec))
  62.