[mcclim-cvs] CVS mcclim/Backends/gtkairo

dlichteblau dlichteblau at common-lisp.net
Sat Dec 23 13:26:54 UTC 2006


Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo
In directory clnet:/tmp/cvs-serv3975

Modified Files:
	pango.lisp 
Log Message:
Fix presentation highlighting (among other issues) in beirc.

	* pango.lisp (text-style-ascent, text-style-descent): Compute
        dummy values from TEXT-SIZE instead of asking the font.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pango.lisp	2006/12/20 18:45:37	1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pango.lisp	2006/12/23 13:26:54	1.2
@@ -272,37 +272,31 @@
 	  (not (zerop (pango_font_family_is_monospace family))))))))
 
 (defmethod text-style-ascent (text-style (medium metrik-medium))
-  (with-gtk ()
-    (with-pango-context (context medium)
-      (with-text-style-font-description (desc text-style)
-	(with-font-metrics (metrics context desc)
-	  (ceiling (pango_font_metrics_get_ascent metrics) PANGO_SCALE)))))
+;;;  (with-gtk ()
+;;;    (with-pango-context (context medium)
+;;;      (with-text-style-font-description (desc text-style)
+;;;	(with-font-metrics (metrics context desc)
+;;;	  (ceiling (pango_font_metrics_get_ascent metrics) PANGO_SCALE)))))
   ;; here's a dummy implementation guaranteing ascent+descent=height:
-  ;; we don't seem to need it though.
-;;;  (multiple-value-bind (width height final-x final-y baseline)
-;;;      (text-size medium "foo" :text-style text-style)
-;;;    (declare (ignore width height final-x final-y))
-;;;    baseline)
-  )
+  (multiple-value-bind (width height final-x final-y baseline)
+      (text-size medium "foo" :text-style text-style)
+    (declare (ignore width height final-x final-y))
+    baseline))
 
 (defmethod text-style-descent (text-style (medium metrik-medium))
-  (with-gtk ()
-    (with-pango-context (context medium)
-      (with-text-style-font-description (desc text-style)
-	(with-font-metrics (metrics context desc)
-	  (ceiling (pango_font_metrics_get_descent metrics) PANGO_SCALE)))))
+;;;  (with-gtk ()
+;;;    (with-pango-context (context medium)
+;;;      (with-text-style-font-description (desc text-style)
+;;;	(with-font-metrics (metrics context desc)
+;;;	  (ceiling (pango_font_metrics_get_descent metrics) PANGO_SCALE)))))
   ;; here's a dummy implementation guaranteing ascent+descent=height:
-  ;; we don't seem to need it though.
-;;;  (multiple-value-bind (width height final-x final-y baseline)
-;;;      (text-size medium "foo" :text-style text-style)
-;;;    (declare (ignore width final-x final-y))
-;;;    (- height baseline))
-  )
+  (multiple-value-bind (width height final-x final-y baseline)
+      (text-size medium "foo" :text-style text-style)
+    (declare (ignore width final-x final-y))
+    (- height baseline)))
 
 (defmethod text-style-height (text-style (medium metrik-medium))
   (nth-value 1 (text-size medium "foo" :text-style text-style))
-  ;; here's a dummy implementation guaranteing ascent+descent=height,
-  ;; leading to less inter-line space.
 ;;;  (+ (text-style-ascent text-style medium)
 ;;;     (text-style-descent text-style medium))
   )




More information about the Mcclim-cvs mailing list