Index: medium.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/medium.lisp,v
retrieving revision 1.54
diff -u -r1.54 medium.lisp
--- medium.lisp	24 Jan 2005 23:03:41 -0000	1.54
+++ medium.lisp	1 Aug 2005 16:48:44 -0000
@@ -89,6 +89,7 @@
 (defgeneric text-style-fixed-width-p (text-style medium))
 
 (defgeneric text-style-equalp (style1 style2))
+(defmethod text-style-equalp ((style1 text-style) (style2 text-style)) nil)
 
 (defclass standard-text-style (text-style)
   ((family   :initarg :text-family
@@ -194,7 +195,7 @@
                              :text-language language)))))
 ) ; end eval-when
 
-(defmethod print-object ((self text-style) stream)
+(defmethod print-object ((self standard-text-style) stream)
   (print-unreadable-object (self stream :type t :identity nil)
     (format stream "~{~S~^ ~}" (multiple-value-list (text-style-components self)))))
 
@@ -239,11 +240,19 @@
 ;;; Device-Font-Text-Style class
 
 (defclass device-font-text-style (text-style)
-  ())
+  ((display-device :initarg :display-device :accessor display-device)
+   (device-font-name :initarg :device-font-name :accessor device-font-name)))
+
+(defmethod print-object ((self device-font-text-style) stream)
+  (print-unreadable-object (self stream :type t :identity nil)
+    (format stream "~S on ~S" (device-font-name self) (display-device self))))
 
 (defun device-font-text-style-p (s)
   (typep s 'device-font-text-style))
 
+(defmethod text-style-equalp ((style1 device-font-text-style) (style2 device-font-text-style))
+  (eq style1 style2))
+
 (defmethod text-style-mapping ((port basic-port) text-style
                                &optional character-set)
   (declare (ignore character-set))
@@ -266,9 +275,8 @@
 
 (defun make-device-font-text-style (port font-name)
   (let ((text-style (make-instance 'device-font-text-style
-                                   :text-family font-name
-                                   :text-face nil
-                                   :text-size nil)))
+				   :display-device port
+				   :device-font-name font-name)))
     (setf (text-style-mapping port text-style) font-name)
     text-style))