[mcclim-cvs] CVS mcclim
CVS User afuchs
afuchs at common-lisp.net
Sun Jan 22 21:17:07 UTC 2006
Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp:/tmp/cvs-serv5587
Modified Files:
input-editing.lisp medium.lisp
Log Message:
Remove the blocks marked #+unicode, and remove #-unicode tags.
As clisp includes :unicode on their *features* list, it doesn't
make much sense anymore to keep code around that worked only with an
experimental branch of cmucl, long ago.
--- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2005/06/22 09:49:15 1.47
+++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2006/01/22 21:17:07 1.48
@@ -653,7 +653,7 @@
(if (> nmatches 0)
(insert-input input)
(beep)))
- (cond ((and success (eq mode :complete))
+ (cond ((and success (eq mode :complete))
(return-from complete-input
(values object success input)))
((activation-gesture-p gesture)
--- /project/mcclim/cvsroot/mcclim/medium.lisp 2005/12/01 11:10:55 1.56
+++ /project/mcclim/cvsroot/mcclim/medium.lisp 2006/01/22 21:17:07 1.57
@@ -79,8 +79,6 @@
(defgeneric text-style-family (text-style))
(defgeneric text-style-face (text-style))
(defgeneric text-style-size (text-style))
-#+unicode
-(defgeneric text-style-language (text-style))
(defgeneric merge-text-styles (text-style-1 text-style-2))
(defgeneric text-style-ascent (text-style medium))
(defgeneric text-style-descent (text-style medium))
@@ -99,24 +97,13 @@
:reader text-style-face)
(size :initarg :text-size
:initform :normal
- :reader text-style-size)
- #+unicode
- (language :initarg :text-language
- :initform nil
- :reader text-style-language)))
+ :reader text-style-size)))
-#-unicode
(defmethod make-load-form ((obj standard-text-style) &optional env)
(declare (ignore env))
(with-slots (family face size) obj
`(make-text-style ',family ',face ',size)))
-#+unicode
-(defmethod make-load-form ((obj standard-text-style) &optional env)
- (declare (ignore env))
- (with-slots (family face size language) obj
- `(make-text-style ',family ',face ',size ',language)))
-
(defun family-key (family)
(ecase family
((nil) 0)
@@ -148,29 +135,14 @@
((:smaller) 8)
((:larger) 9))))
-#+unicode
-(defun language-key (language)
- (ecase language
- ((:english nil) 0)
- ((:korean) 1)))
-
-#-unicode
(defun text-style-key (family face size)
(+ (* 256 (size-key size))
(* 16 (face-key face))
(family-key family)))
-#+unicode
-(defun text-style-key (family face size &optional (language nil))
- (+ (ash (size-key size) 12)
- (ash (language-key language) 8)
- (ash (face-key face) 4)
- (ash (family-key family) 0)))
-
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *text-style-hash-table* (make-hash-table :test #'eql)))
-#-unicode
(defun make-text-style (family face size)
(let ((key (text-style-key family face size)))
(declare (type fixnum key))
@@ -181,17 +153,6 @@
:text-face face
:text-size size)))))
-#+unicode
-(defun make-text-style (family face size &optional language)
- (let ((key (text-style-key family face size language)))
- (declare (type fixnum key))
- (or (gethash key *text-style-hash-table*)
- (setf (gethash key *text-style-hash-table*)
- (make-instance 'standard-text-style
- :text-family family
- :text-face face
- :text-size size
- :text-language language)))))
) ; end eval-when
(defmethod print-object ((self text-style) stream)
@@ -202,9 +163,7 @@
(style2 standard-text-style))
(and (eql (text-style-family style1) (text-style-family style2))
(eql (text-style-face style1) (text-style-face style2))
- (eql (text-style-size style1) (text-style-size style2))
- #+unicode (eql (text-style-language style1)
- (text-style-language style2))))
+ (eql (text-style-size style1) (text-style-size style2))))
(defconstant *default-text-style* (make-text-style :fix :roman :normal))
(defconstant *undefined-text-style* *default-text-style*)
@@ -232,9 +191,7 @@
(defmethod text-style-components ((text-style standard-text-style))
(values (text-style-family text-style)
(text-style-face text-style)
- (text-style-size text-style)
- #+unicode
- (text-style-language text-style)))
+ (text-style-size text-style)))
;;; Device-Font-Text-Style class
@@ -274,7 +231,6 @@
;;; Text-style utilities
-#-unicode
(defmethod merge-text-styles (s1 s2)
(setq s1 (parse-text-style s1))
(setq s2 (parse-text-style s2))
@@ -296,31 +252,6 @@
(make-text-style family face size))
s1))
-#+unicode
-(defmethod merge-text-styles (s1 s2)
- (setq s1 (parse-text-style s1))
- (setq s2 (parse-text-style s2))
- (if (and (not (device-font-text-style-p s1))
- (not (device-font-text-style-p s2)))
- (let* ((family (or (text-style-family s1) (text-style-family s2)))
- (face1 (text-style-face s1))
- (face2 (text-style-face s2))
- (face (if (subsetp '(:bold :italic) (list face1 face2))
- '(:bold :italic)
- (or face1 face2)))
- (size1 (text-style-size s1))
- (size2 (text-style-size s2))
- (size (case size1
- ((nil) size2)
- (:smaller (find-smaller-size size2))
- (:larger (find-larger-size size2))
- (t size1)))
- ; v- this is probably wrong, but it requires an idea of which
- ; languages include which foreign language support.
- (language (or (text-style-language s1) (text-style-language s2))))
- (make-text-style family face size language))
- s1))
-
(defun parse-text-style (style)
(cond ((text-style-p style) style)
((null style) (make-text-style nil nil nil)) ; ?
@@ -392,18 +323,6 @@
(invoke-with-text-style ,medium #',cont
(make-text-style nil nil ,size)))))
-#+unicode
-(defmacro with-text-language ((medium language) &body body)
- (declare (type symbol medium))
- (when (eq medium t) (setq medium '*standard-output*))
- (with-gensyms (cont)
- `(flet ((,cont (,medium)
- ,(declare-ignorable-form* medium)
- , at body))
- (declare (dynamic-extent #',cont))
- (invoke-with-text-style ,medium #',cont
- (make-text-style nil nil nil ,language)))))
-
;;; MEDIUM class
More information about the Mcclim-cvs
mailing list