From: tomo <tomo>
Date: Sun, 31 Oct 2004 19:18:19 +0000 (+0000)
Subject: (conv-u-convert-char): Delete unused local variable `guc'.
X-Git-Tag: chise-base-0_23~18
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a50f2623ab9adb3e6d865abcad57859960c18d15;p=chise%2Ftomoyo-tools.git

(conv-u-convert-char): Delete unused local variable `guc'.
(conv-u-convert-char-fullwidth): New function.
---

diff --git a/conv-util.el b/conv-util.el
index 819f14c..79fb1f1 100644
--- a/conv-util.el
+++ b/conv-util.el
@@ -29,7 +29,7 @@
 
 (defun conv-u-convert-char (c &optional v)
   (setq v (get-char-attribute c '->ucs-unified))
-  (let (ufs ifs ucs guc m ret)
+  (let (ufs ifs ucs m ret)
     (when (or (and
 	       (setq m (get-char-attribute c 'morohashi-daikanwa))
 	       (setq m (if (eq (nth 1 m) 0)
@@ -68,6 +68,56 @@
 	    (remove-char-attribute vc '=>ucs)))
       )))
 
+(defun conv-u-convert-char-fullwidth (c &optional v)
+  (when (setq v (get-char-attribute c '->ucs-unified))
+    (let (ufs ifs ucs name ret)
+      (when (get-char-attribute c '->fullwidth)
+	(setq ufs (char-attribute-alist c)
+	      ifs ufs)
+	(dolist (vc v)
+	  (setq ifs (intersection
+		     ifs
+		     (char-attribute-alist vc)
+		     :test #'equal)))      
+	(dolist (cell ufs)
+	  (cond ((eq (car cell) 'name)
+		 (setq name (cdr cell)))
+		((eq (car cell) '->decomposition))
+		((eq (car cell) 'composition))
+		((eq (car cell) '->lowercase))
+		((eq (car cell) '->uppercase))
+		((eq (car cell) '->titlecase))
+		((eq (car cell) '=ucs)
+		 (setq ucs (cdr cell))
+		 (setq ret
+		       (cons (cons (if (<= ucs #xFFFF)
+				       '=ucs@unicode
+				     '=ucs@iso)
+				   ucs)
+			     ret)))
+		((member cell ifs))
+		((eq (car cell) '->ucs-unified)
+		 (remove-char-attribute c '->ucs-unified))
+		(t
+		 (remove-char-attribute c (car cell))
+		 (setq ret (cons cell ret)))))
+	(setq ufs ret)
+	(put-char-attribute c '->denotational
+			    (cons (define-char ufs) v))
+	(dolist (vc v)
+	  (dolist (isf ifs)
+	    (remove-char-attribute vc (car isf)))
+	  (if (eq ucs (get-char-attribute vc '=>ucs))
+	      (remove-char-attribute vc '=>ucs))
+	  (if (setq ret (get-char-attribute vc '<-fullwidth))
+	      (put-char-attribute vc '<-fullwidth (delq c ret)))
+	  (if (and name
+		   (string= (concat "fullwidth " (downcase name))
+			    (get-char-attribute vc 'name)))
+	      (remove-char-attribute vc 'name))
+	  )
+	))))
+
 
 ;;; @ End.
 ;;;