(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 (file)
--- 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.
 ;;;