(chise-tex-encode-region-for-utf-8-jis): New function.
authortomo <tomo>
Wed, 23 Jan 2008 06:53:50 +0000 (06:53 +0000)
committertomo <tomo>
Wed, 23 Jan 2008 06:53:50 +0000 (06:53 +0000)
(chise-tex-decode-region): Decode \u, \v and \c.
(utf-8-jp-tex): New coding-system.

chise2otf/elisp/chise-tex.el

index 230500a..092b39b 100644 (file)
                (t
                 (forward-char))))))))
 
+(defun chise-tex-encode-region-for-utf-8-jis (start end)
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (let ((font-encoding 'T1)
+           chr ret rest spec modifier base modifier-1 pos)
+       (while (and (skip-chars-forward "\x00-\x7F")
+                   (not (eobp)))
+         (setq chr (char-after))
+         (cond
+          ((and (setq ret (encode-char chr '=ucs))
+                (and (<= #x0400 ret)(<= ret #x04F9)))
+           (if (eq font-encoding 'T2A)
+               (forward-char)
+             (setq pos (point))
+             (unless (and (prog1
+                              (search-backward
+                               "\\fontencoding{T2A}\\selectfont{}" nil t)
+                            (goto-char pos))
+                          (eq pos (match-end 0)))
+               (insert "\\fontencoding{T2A}\\selectfont{}")
+               )
+             (forward-char)
+             (setq font-encoding 'T2A))
+           )
+          (t
+           (unless (eq font-encoding 'T1)
+              (setq pos (point))
+             (unless (and (prog1
+                              (search-backward
+                               "\\fontencoding{T1}\\selectfont{}" nil t)
+                            (goto-char pos))
+                          (eq pos (match-end 0)))
+               (insert "\\fontencoding{T1}\\selectfont{}")
+               )
+             (setq font-encoding 'T1))
+           (cond ((eq (char-ucs chr) #x00D7)
+                  (delete-char)
+                  (insert "\\UCSjis{00D7}"))
+                 ((encode-char chr '=jis-x0208-1983)
+                  (forward-char))
+                 ((and (setq ret (encode-char chr '=ucs))
+                       (or (and (<= #x0374 ret)(<= ret #x03F3))
+                           (eq ret #x1E2B)))
+                  (forward-char))
+                 ;; ((setq ret (encode-char chr '=jis-x0208-1990))
+                 ;;  (delete-char)
+                 ;;  (insert (decode-char '=jis-x0208-1983 ret)))
+                 ((eq (char-ucs chr) #x012B)
+                  (delete-char)
+                  (insert "\\={\\i}"))
+                 ((and (not (eq (char-ucs chr) #x0439))
+                       (not (eq (char-ucs chr) #x0451))
+                       (setq ret (char-feature chr '=decomposition))
+                       (setq modifier (assq (nth 1 ret)
+                                            '((?\u0300 . "`")
+                                              (?\u0301 . "'")
+                                              (?\u0302 . "^")
+                                              (?\u0303 . "~")
+                                              (?\u0304 . "=")
+                                              (?\u0306 . "u")
+                                              (?\u0307 . ".")
+                                              (?\u0308 . "\"")
+                                              (?\u0309 . "Hook")
+                                              (?\u030C . "v")
+                                              (?\u0323 . "d")
+                                              (?\u0327 . "c")
+                                              (?\u032E . "ubreve")
+                                              (?\u0331 . "umacron")
+                                              ))))
+                  (delete-char)
+                  (setq base (car ret))
+                  (if (and (setq ret (char-feature base '=decomposition))
+                           (setq modifier-1
+                                 (assq (car modifier)
+                                       (cdr
+                                        (assq (nth 1 ret)
+                                              '((?\u0302
+                                                 (?\u0300 . "CircGrave")
+                                                 (?\u0301 . "CircAcute")
+                                                 (?\u0303 . "CircTilde")
+                                                 (?\u0309 . "CircHook")
+                                                 )
+                                                (?\u031B
+                                                 (?\u0301 . "HornAcute")
+                                                 )
+                                                (?\u0323
+                                                 (?\u0302 . "Circudot")
+                                                 )))))))
+                      (insert (format "\\%s{%c}" (cdr modifier-1) (car ret)))
+                    (insert (format "\\%s{%c}" (cdr modifier) base))))
+                 ((and (or (encode-char chr '=jis-x0213-1-2000)
+                           (encode-char chr '=jis-x0213-2-2000))
+                       (setq ret (or (encode-char chr '=ucs@jis/2000)
+                                     (encode-char chr '=ucs@jis/fw)))
+                       (<= ret #xFFFF))
+                  ;; (delete-char)
+                  ;; (if (eq (char-before) ?\e$B!T\e(B)
+                  ;;     (insert " "))
+                  ;; (insert (format "\\UCSjis{%04X}" ret))
+                  (forward-char))
+                 ((and (encode-char chr '=ks-x1001)
+                       (setq ret (or (encode-char chr '=ucs@ks)
+                                     (char-ucs chr))))
+                  (delete-char)
+                  ;; (if (eq (char-before) ?\e$B!T\e(B)
+                  ;;     (insert " "))
+                  (insert (format "\\UCSks{%04X}" ret)))
+                 ((setq ret (encode-char chr '=ucs-hangul))
+                  (delete-char)
+                  ;; (if (eq (char-before) ?\e$B!T\e(B)
+                  ;;     (insert " "))
+                  (insert (format "\\UCSks{%04X}" ret)))
+                 ((eq chr ?\u00B2)
+                  (delete-char)
+                  (insert "$^2$"))
+                 ((eq chr ?\u00B3)
+                  (delete-char)
+                  (insert "$^3$"))
+                 ((eq chr ?\u0111)
+                  (delete-char)
+                  (insert "{\\usefont{T1}{pxr}{m}{n}\\dj}"))
+                 ((eq chr ?\u014B)
+                  (delete-char)
+                  (insert "{\\usefont{T1}{pxr}{m}{n}\\ng}"))
+                 ((eq chr ?\u0282)
+                  (delete-char)
+                  (insert "{\\usefont{T1}{pxr}{m}{n}\\k{s}}"))
+                 ((eq chr ?\u0294)
+                  (delete-char)
+                  (insert "\\UCSjis{0294}"))
+                 ((eq chr ?\u2022)
+                  (delete-char)
+                  (insert "\\textbullet{}"))
+                 ((eq chr ?\u2081)
+                  (delete-char)
+                  (insert "$_1$"))
+                 ((eq chr ?\u2082)
+                  (delete-char)
+                  (insert "$_2$"))
+                 ((eq chr ?\u2083)
+                  (delete-char)
+                  (insert "$_3$"))
+                 ((eq chr ?\u2085)
+                  (delete-char)
+                  (insert "$_5$"))
+                 ((eq chr ?\u2637)
+                  (delete-char)
+                  (insert "\\UCSgb{2637}"))
+                 ((and (encode-char chr '=ucs@jp)
+                       (setq ret (char-representative-of-domain chr 'gb))
+                       (setq ret (encode-char ret '=ucs@gb))
+                       (<= ret #xFFFF))
+                  (delete-char)
+                  ;; (if (eq (char-before) ?\e$B!T\e(B)
+                  ;;     (insert " "))
+                  (insert (format "\\UCSgb{%04X}" ret)))
+                 ((catch 'tag
+                    (setq rest chise-tex-coded-charset-expression-alist)
+                    (while (setq spec (car rest))
+                      (if (setq ret (encode-char chr (car spec)))
+                          (throw 'tag ret))
+                      (setq rest (cdr rest))))
+                  (delete-char)
+                  ;; (if (eq (char-before) ?\e$B!T\e(B)
+                  ;;     (insert " "))
+                  (insert (format (format "\\%s{%%0%d%s}"
+                                          (nth 1 spec)
+                                          (nth 2 spec)
+                                          (nth 3 spec))
+                                  ret)))
+                 (t
+                  (forward-char))))))))))
+
 (defun chise-tex-decode-region (start end)
   (interactive "r")
   (save-excursion
                          (?^  . ?\u0302) ; <COMBINING CIRCUMFLEX ACCENT>
                          (?~  . ?\u0303) ; <COMBINING TILDE>
                          (?=  . ?\u0304) ; <COMBINING MACRON>
+                         (?u  . ?\u0306) ; <COMBINING BREVE>
                          (?\. . ?\u0307) ; <COMBINING DOT ABOVE>
                          (?\" . ?\u0308) ; <COMBINING DIAERESIS>
+                         (?v  . ?\u030C) ; <COMBINING CARON>
                          (?d  . ?\u0323) ; <COMBINING DOT BELOW>
+                         (?c  . ?\u0327) ; <COMBINING CEDILLA>
                          )))
                 (setq ret
                       (cdr (assq (cdr macro)
    mnemonic "pTeX(JIS)/7bit"
    ))
 
+(make-coding-system
+ 'utf-8-jp-tex 'utf-8
+ "Coding-system of UTF-8 for common glyphs used in Japan."
+ '(pre-write-conversion chise-tex-encode-region-for-utf-8-jis
+   post-read-conversion chise-tex-decode-region
+   charset-g0 =ucs@jp
+   charset-g1 =>ucs-jis
+   charset-g2 =>ucs
+   mnemonic "upTeX(JP)/UTF8"))
+
 
 ;;; @ End.
 ;;;