home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / irchat-pj / irchat-pj-2.4.24.22.tar.gz / irchat-pj-2.4.24.22.tar / irchat-pj-2.4.24.22 / irchat-pj-jisx0201.el < prev    next >
Lisp/Scheme  |  1999-12-17  |  6KB  |  206 lines
  1. ;;;
  2. ;;; irchat-pj-jisx0201.el
  3. ;;;
  4. ;;; This file is based on jisx0201.el (Mule 2.3)
  5. ;;; I referred mew-lang-jp.el (Mew 1.93) when editting.
  6. ;;; Thanks to Mule Project and Mew Project
  7. ;;;
  8. ;;; last modify : Sun, 27 Jun 1999 by simm@irc.fan.gr.jp / irchat-PJ Project
  9. ;;; (date format modification by simm@irc.fan.gr.jp, Sun, 27 Jun 1999)
  10. ;;;
  11. ;;; see file irchat-copyright.el for change log and copyright info
  12.  
  13. (provide 'irchat-pj-jisx0201)
  14.  
  15. (defvar irchat-pj-katakana-alist
  16.   '(( 161 . "(I'(B" )
  17.     ( 162 . "(I1(B" )
  18.     ( 163 . "(I((B" )
  19.     ( 164 . "(I2(B" )
  20.     ( 165 . "(I)(B" )
  21.     ( 166 . "(I3(B" )
  22.     ( 167 . "(I*(B" )
  23.     ( 168 . "(I4(B" )
  24.     ( 169 . "(I+(B" )
  25.     ( 170 . "(I5(B" )
  26.     ( 171 . "(I6(B" )
  27.     ( 172 . "(I6^(B" )
  28.     ( 173 . "(I7(B" )
  29.     ( 174 . "(I7^(B" )
  30.     ( 175 . "(I8(B" )
  31.     ( 176 . "(I8^(B" )
  32.     ( 177 . "(I9(B" )
  33.     ( 178 . "(I9^(B" )
  34.     ( 179 . "(I:(B" )
  35.     ( 180 . "(I:^(B" )
  36.     ( 181 . "(I;(B" )
  37.     ( 182 . "(I;^(B" )
  38.     ( 183 . "(I<(B" )
  39.     ( 184 . "(I<^(B" )
  40.     ( 185 . "(I=(B" )
  41.     ( 186 . "(I=^(B" )
  42.     ( 187 . "(I>(B" )
  43.     ( 188 . "(I>^(B" )
  44.     ( 189 . "(I?(B" )
  45.     ( 190 . "(I?^(B" )
  46.     ( 191 . "(I@(B" )
  47.     ( 192 . "(I@^(B" )
  48.     ( 193 . "(IA(B" )
  49.     ( 194 . "(IA^(B" )
  50.     ( 195 . "(I/(B" )
  51.     ( 196 . "(IB(B" )
  52.     ( 197 . "(IB^(B" )
  53.     ( 198 . "(IC(B" )
  54.     ( 199 . "(IC^(B" )
  55.     ( 200 . "(ID(B" )
  56.     ( 201 . "(ID^(B" )
  57.     ( 202 . "(IE(B" )
  58.     ( 203 . "(IF(B" )
  59.     ( 204 . "(IG(B" )
  60.     ( 205 . "(IH(B" )
  61.     ( 206 . "(II(B" )
  62.     ( 207 . "(IJ(B" )
  63.     ( 208 . "(IJ^(B" )
  64.     ( 209 . "(IJ_(B" )
  65.     ( 210 . "(IK(B" )
  66.     ( 211 . "(IK^(B" )
  67.     ( 212 . "(IK_(B" )
  68.     ( 213 . "(IL(B" )
  69.     ( 214 . "(IL^(B" )
  70.     ( 215 . "(IL_(B" )
  71.     ( 216 . "(IM(B" )
  72.     ( 217 . "(IM^(B" )
  73.     ( 218 . "(IM_(B" )
  74.     ( 219 . "(IN(B" )
  75.     ( 220 . "(IN^(B" )
  76.     ( 221 . "(IN_(B" )
  77.     ( 222 . "(IO(B" )
  78.     ( 223 . "(IP(B" )
  79.     ( 224 . "(IQ(B" )
  80.     ( 225 . "(IR(B" )
  81.     ( 226 . "(IS(B" )
  82.     ( 227 . "(I,(B" )
  83.     ( 228 . "(IT(B" )
  84.     ( 229 . "(I-(B" )
  85.     ( 230 . "(IU(B" )
  86.     ( 231 . "(I.(B" )
  87.     ( 232 . "(IV(B" )
  88.     ( 233 . "(IW(B" )
  89.     ( 234 . "(IX(B" )
  90.     ( 235 . "(IY(B" )
  91.     ( 236 . "(IZ(B" )
  92.     ( 237 . "(I[(B" )
  93.     ( 239 . "(I\(B" ) ; (I\(B -> $B%o(B $B$KJQ49$9$k$h$&$K(B
  94.     ( 238 . "(I\(B" ) ; $B%o$H%n$N=gHV$,8r49$7$F$"$k!#(B
  95.     ( 240 . "(I((B" )
  96.     ( 241 . "(I*(B" )
  97.     ( 242 . "(I&(B" )
  98.     ( 243 . "(I](B" )
  99.     ( 244 . "(I3^(B" )
  100.     ( 245 . "(I6(B" )
  101.     ( 246 . "(I9(B" )))
  102.  
  103. (defvar irchat-pj-katakana-kigou-alist
  104.   '(( 162 . "(I$(B" )
  105.     ( 163 . "(I!(B" )
  106.     ( 166 . "(I%(B" )
  107.     ( 171 . "(I^(B" )
  108.     ( 172 . "(I_(B" )
  109.     ( 188 . "(I0(B" )
  110.     ( 214 . "(I"(B" )
  111.     ( 215 . "(I#(B" )))
  112.  
  113. (defvar irchat-pj-dakuon-list
  114.   '( ?$B%+(B ?$B%-(B ?$B%/(B ?$B%1(B ?$B%3(B
  115.      ?$B%5(B ?$B%7(B ?$B%9(B ?$B%;(B ?$B%=(B
  116.      ?$B%?(B ?$B%A(B ?$B%D(B ?$B%F(B ?$B%H(B
  117.      ?$B%O(B ?$B%R(B ?$B%U(B ?$B%X(B ?$B%[(B))
  118.  
  119. ;;(defvar irchat-pj-handakuon-list (memq ?$B%O(B 'irchat-pj-dakuon-list))
  120. (defvar irchat-pj-handakuon-list 
  121.   '( ?$B%O(B ?$B%R(B ?$B%U(B ?$B%X(B ?$B%[(B))
  122.  
  123. (defun irchat-pj-search-henkan-alist (ch list)
  124.   (let ((ptr list)
  125.     (result nil))
  126.     (while ptr
  127.       (if (string= ch (cdr (car ptr)))
  128.       (progn
  129.         (setq result (car (car ptr)))
  130.         (setq ptr nil))
  131.     (setq ptr (cdr ptr))))
  132.     result))
  133.  
  134. (defun irchat-pj-make-jisx0208-katakana (ch)
  135.   (cond ((featurep 'xemacs)
  136.      (message "XEmacs")
  137.      (make-char 'japanese-jisx0208 37 (- ch 128)))
  138.     ((>= (string-to-int (substring emacs-version 0 2)) 20)
  139.      (message "Emacs20")
  140.      (make-char 'japanese-jisx0208 ?\245 ch))
  141.     (t
  142.      (message "Other")
  143.      (make-character lc-jp ?\245 ch))))
  144.  
  145. (defun irchat-pj-make-jisx0208-kigou (ch)
  146.   (cond ((featurep 'xemacs)
  147.      (message "XEmacs")
  148.      (make-char 'japanese-jisx0208 33 (- ch 128)))
  149.     ((>= (string-to-int (substring emacs-version 0 2)) 20)
  150.      (message "Emacs20")
  151.      (make-char 'japanese-jisx0208 ?\241 ch))
  152.     (t
  153.      (message "Other")
  154.      (make-character lc-jp ?\241 ch))))
  155.  
  156. (defun irchat-pj-zenkaku-katakana-string (string)
  157.   "Convert jisx0201 katakana to jisx0208."
  158.   (let ((return "")
  159.     (ch nil)
  160.     (wk nil)
  161.     (point 0))
  162.     (if (null (string-match "\\ck" string))
  163.     (setq return string)
  164.       (while (< point (length string))
  165.     (setq ch (elt string point))
  166.     (setq wk (char-to-string ch))
  167.     (if (null (string-match "\\ck" wk))
  168.         (setq return (concat return wk))
  169.       (cond ((= ch ?(I^(B)
  170.          (if (= 0 point)
  171.              (setq return (concat return "$B!+(B"))
  172.            (setq wk (elt return (1- (length return))))
  173.            (cond ((= wk ?$B%&(B)
  174.               (setq return (substring return 0 (1- (length return))))
  175.               (setq return (concat return "$B%t(B")))
  176.              ((setq wk (memq wk irchat-pj-dakuon-list))
  177.               (setq return (substring return 0 (1- (length return))))
  178.               (setq return (concat return (char-to-string (1+ (car wk))))))
  179.              (t
  180.               (setq return (concat return "$B!+(B"))))))
  181.         ((= ch ?(I_(B)
  182.          (if (= 0 point)
  183.              (setq return (concat return "$B!,(B"))
  184.            (setq wk (elt return (1- (length return))))
  185.            (cond ((setq wk (memq wk irchat-pj-handakuon-list))
  186.               (setq return (substring return 0 (1- (length return))))
  187.               (setq return (concat return (char-to-string (+ 2 (car wk))))))
  188.              (t
  189.               (setq return (concat return "$B!,(B"))))))
  190.         ((setq wk (irchat-pj-search-henkan-alist
  191.                (char-to-string ch) irchat-pj-katakana-alist))
  192.          (setq return
  193.                (concat return
  194.                    (char-to-string (irchat-pj-make-jisx0208-katakana wk)))))
  195.         ((setq wk (irchat-pj-search-henkan-alist
  196.                (char-to-string ch) irchat-pj-katakana-kigou-alist))
  197.          (setq return
  198.                (concat return
  199.                    (char-to-string (irchat-pj-make-jisx0208-kigou wk)))))))
  200.     (setq point (1+ point))))
  201.     return))
  202.  
  203. ;;;
  204. ;;; eof
  205. ;;;
  206.