cgit.sxemacs.org Git - packages/blob - mule-packages/egg-its/egg-jisx0201.el

   1 ;; Utility for HankakuKana (jisx0201)
   2
   3 ;; This file is part of Egg on Mule (Japanese Environment)
   4
   5 ;; Egg is distributed in the forms of patches to GNU
   6 ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
   7 ;; LICENSE which is distributed along with GNU Emacs by the
   8 ;; Free Software Foundation.
   9
  10 ;; Egg is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied
  12 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  13 ;; PURPOSE.  See the GNU EMACS GENERAL PUBLIC LICENSE for
  14 ;; more details.
  15
  16 ;; You should have received a copy of the GNU EMACS GENERAL
  17 ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
  18 ;; If not, write to the Free Software Foundation, 675 Mass
  19 ;; Ave, Cambridge, MA 02139, USA.
  20
  21 ;;; 92.9.24  created for Mule Ver.0.9.6 by K.Shibata <shibata@sgi.co.jp>
  22 ;;; 93.8.3   modified for Mule Ver.1.1 by K.Handa <handa@etl.go.jp>
  23 ;;;     Not to define regexp of Japanese word in this file.
  24
  25 (require 'egg)
  26 (provide 'egg-jisx0201)
  27
  28 (defvar *katakana-alist*
  29   '(( 161 . "\e(I'\e(B" )
  30     ( 162 . "\e(I1\e(B" )
  31     ( 163 . "\e(I(\e(B" )
  32     ( 164 . "\e(I2\e(B" )
  33     ( 165 . "\e(I)\e(B" )
  34     ( 166 . "\e(I3\e(B" )
  35     ( 167 . "\e(I*\e(B" )
  36     ( 168 . "\e(I4\e(B" )
  37     ( 169 . "\e(I+\e(B" )
  38     ( 170 . "\e(I5\e(B" )
  39     ( 171 . "\e(I6\e(B" )
  40     ( 172 . "\e(I6^\e(B" )
  41     ( 173 . "\e(I7\e(B" )
  42     ( 174 . "\e(I7^\e(B" )
  43     ( 175 . "\e(I8\e(B" )
  44     ( 176 . "\e(I8^\e(B" )
  45     ( 177 . "\e(I9\e(B" )
  46     ( 178 . "\e(I9^\e(B" )
  47     ( 179 . "\e(I:\e(B" )
  48     ( 180 . "\e(I:^\e(B" )
  49     ( 181 . "\e(I;\e(B" )
  50     ( 182 . "\e(I;^\e(B" )
  51     ( 183 . "\e(I<\e(B" )
  52     ( 184 . "\e(I<^\e(B" )
  53     ( 185 . "\e(I=\e(B" )
  54     ( 186 . "\e(I=^\e(B" )
  55     ( 187 . "\e(I>\e(B" )
  56     ( 188 . "\e(I>^\e(B" )
  57     ( 189 . "\e(I?\e(B" )
  58     ( 190 . "\e(I?^\e(B" )
  59     ( 191 . "\e(I@\e(B" )
  60     ( 192 . "\e(I@^\e(B" )
  61     ( 193 . "\e(IA\e(B" )
  62     ( 194 . "\e(IA^\e(B" )
  63     ( 195 . "\e(I/\e(B" )
  64     ( 196 . "\e(IB\e(B" )
  65     ( 197 . "\e(IB^\e(B" )
  66     ( 198 . "\e(IC\e(B" )
  67     ( 199 . "\e(IC^\e(B" )
  68     ( 200 . "\e(ID\e(B" )
  69     ( 201 . "\e(ID^\e(B" )
  70     ( 202 . "\e(IE\e(B" )
  71     ( 203 . "\e(IF\e(B" )
  72     ( 204 . "\e(IG\e(B" )
  73     ( 205 . "\e(IH\e(B" )
  74     ( 206 . "\e(II\e(B" )
  75     ( 207 . "\e(IJ\e(B" )
  76     ( 208 . "\e(IJ^\e(B" )
  77     ( 209 . "\e(IJ_\e(B" )
  78     ( 210 . "\e(IK\e(B" )
  79     ( 211 . "\e(IK^\e(B" )
  80     ( 212 . "\e(IK_\e(B" )
  81     ( 213 . "\e(IL\e(B" )
  82     ( 214 . "\e(IL^\e(B" )
  83     ( 215 . "\e(IL_\e(B" )
  84     ( 216 . "\e(IM\e(B" )
  85     ( 217 . "\e(IM^\e(B" )
  86     ( 218 . "\e(IM_\e(B" )
  87     ( 219 . "\e(IN\e(B" )
  88     ( 220 . "\e(IN^\e(B" )
  89     ( 221 . "\e(IN_\e(B" )
  90     ( 222 . "\e(IO\e(B" )
  91     ( 223 . "\e(IP\e(B" )
  92     ( 224 . "\e(IQ\e(B" )
  93     ( 225 . "\e(IR\e(B" )
  94     ( 226 . "\e(IS\e(B" )
  95     ( 227 . "\e(I,\e(B" )
  96     ( 228 . "\e(IT\e(B" )
  97     ( 229 . "\e(I-\e(B" )
  98     ( 230 . "\e(IU\e(B" )
  99     ( 231 . "\e(I.\e(B" )
 100     ( 232 . "\e(IV\e(B" )
 101     ( 233 . "\e(IW\e(B" )
 102     ( 234 . "\e(IX\e(B" )
 103     ( 235 . "\e(IY\e(B" )
 104     ( 236 . "\e(IZ\e(B" )
 105     ( 237 . "\e(I[\e(B" )
 106     ( 239 . "\e(I\\e(B" ) ; \e(I\\e(B -> \e$B%o\e(B \e$B$KJQ49$9$k$h$&$K\e(B
 107     ( 238 . "\e(I\\e(B" ) ; \e$B%o$H%n$N=gHV$,8r49$7$F$"$k!#\e(B
 108     ( 240 . "\e(I(\e(B" )
 109     ( 241 . "\e(I*\e(B" )
 110     ( 242 . "\e(I&\e(B" )
 111     ( 243 . "\e(I]\e(B" )
 112     ( 244 . "\e(I3^\e(B" )
 113     ( 245 . "\e(I6\e(B" )
 114     ( 246 . "\e(I9\e(B" )))
 115
 116 (defvar *katakana-kigou-alist*
 117   '(( 162 . "\e(I$\e(B" )
 118     ( 163 . "\e(I!\e(B" )
 119     ( 166 . "\e(I%\e(B" )
 120     ( 171 . "\e(I^\e(B" )
 121     ( 172 . "\e(I_\e(B" )
 122     ( 188 . "\e(I0\e(B" )
 123     ( 214 . "\e(I"\e(B" )
 124     ( 215 . "\e(I#\e(B" )))
 125
 126 (defvar *dakuon-list*
 127   '( ?\e$B%+\e(B ?\e$B%-\e(B ?\e$B%/\e(B ?\e$B%1\e(B ?\e$B%3\e(B
 128      ?\e$B%5\e(B ?\e$B%7\e(B ?\e$B%9\e(B ?\e$B%;\e(B ?\e$B%=\e(B
 129      ?\e$B%?\e(B ?\e$B%A\e(B ?\e$B%D\e(B ?\e$B%F\e(B ?\e$B%H\e(B
 130      ?\e$B%O\e(B ?\e$B%R\e(B ?\e$B%U\e(B ?\e$B%X\e(B ?\e$B%[\e(B))
 131
 132 (defvar *handakuon-list* (memq ?\e$B%O\e(B *dakuon-list*))
 133
 134 ;;;
 135 ;;; \e$BH>3QJQ49\e(B
 136 ;;;
 137
 138 (defun hankaku-katakana-region (start end &optional arg)
 139   (interactive "r\nP")
 140   (save-restriction
 141     (narrow-to-region start end)
 142     (goto-char (point-min))
 143     (let ((regexp (if arg "\\cS\\|\\cK\\|\\cH" "\\cS\\|\\cK")))
 144       (while (re-search-forward regexp (point-max) (point-max))
 145         (let* ((ch (char-to-int (char-before)))
 146                (ch1 (/ ch 256))
 147                (ch2 (mod ch 256)))
 148           (cond ((= 208 ch1)
 149                  (let ((val (cdr (assq ch2 *katakana-kigou-alist*))))
 150                    (if val (progn
 151                              (delete-char -1)
 152                              (insert val)))))
 153                 ((or (= 209 ch1) (= 215 ch1))
 154                  nil)
 155                 (t
 156                  (let ((val (cdr (assq ch2 *katakana-alist*))))
 157                    (if val (progn
 158                              (delete-char -1)
 159                              (insert val)))))))))))
 160
 161 (defun hankaku-katakana-paragraph ()
 162   "hankaku-katakana paragraph at or after point."
 163   (interactive )
 164   (save-excursion
 165     (forward-paragraph)
 166     (let ((end (point)))
 167       (backward-paragraph)
 168       (hankaku-katakana-region (point) end ))))
 169
 170 (defun hankaku-katakana-sentence ()
 171   "hankaku-katanaka sentence at or after point."
 172   (interactive )
 173   (save-excursion
 174     (forward-sentence)
 175     (let ((end (point)))
 176       (backward-sentence)
 177       (hankaku-katakana-region (point) end ))))
 178
 179 (defun hankaku-katakana-word (arg)
 180   (interactive "p")
 181   (let ((start (point)))
 182     (forward-word arg)
 183     (hankaku-katakana-region start (point))))
 184
 185 ;;;
 186 ;;; \e$BA43QJQ49\e(B
 187 ;;;
 188 (defun search-henkan-alist (ch list)
 189   (let ((ptr list)
 190         (result nil))
 191     (while ptr
 192       (if (string= ch (cdr (car ptr)))
 193           (progn
 194             (setq result (car (car ptr)))
 195             (setq ptr nil))
 196         (setq ptr (cdr ptr))))
 197     result))
 198
 199 (defun zenkaku-katakana-region (start end)
 200   (interactive "r")
 201   (save-restriction
 202     (narrow-to-region start end)
 203     (goto-char (point-min))
 204     (while (re-search-forward "\\ck" (point-max) (point-max))
 205       (let ((ch (preceding-char))
 206             (wk nil))
 207         (cond
 208          ((= ch ?\e(I^\e(B)
 209           (save-excursion
 210             (backward-char 1)
 211             (setq wk (preceding-char)))
 212           (cond ((= wk ?\e$B%&\e(B)
 213                  (delete-char -2)
 214                  (insert "\e$B%t\e(B"))
 215                 ((setq wk (memq wk *dakuon-list*))
 216                  (delete-char -2)
 217                  (insert (1+ (car wk))))
 218                 (t
 219                  (delete-char -1)
 220                  (insert "\e$B!+\e(B"))))
 221          ((= ch ?\e(I_\e(B)
 222           (save-excursion
 223             (backward-char 1)
 224             (setq wk (preceding-char)))
 225           (if (setq wk (memq wk *handakuon-list*))
 226               (progn
 227                 (delete-char -2)
 228                 (insert (+ 2 (car wk))))
 229             (progn
 230               (delete-char -1)
 231               (insert "\e$B!,\e(B"))))
 232          ((setq wk (search-henkan-alist
 233                     (char-to-string ch) *katakana-alist*))
 234           (progn
 235             (delete-char -1)
 236             (insert (make-char 'japanese-jisx0208 37 (- wk 128)))))
 237          ((setq wk (search-henkan-alist
 238                     (char-to-string ch) *katakana-kigou-alist*))
 239           (progn
 240             (delete-char -1)
 241             (insert (make-char 'japanese-jisx0208 33 (- wk 128))))))))))
 242
 243 (defun zenkaku-katakana-paragraph ()
 244   "zenkaku-katakana paragraph at or after point."
 245   (interactive )
 246   (save-excursion
 247     (forward-paragraph)
 248     (let ((end (point)))
 249       (backward-paragraph)
 250       (zenkaku-katakana-region (point) end ))))
 251
 252 (defun zenkaku-katakana-sentence ()
 253   "zenkaku-katakana sentence at or after point."
 254   (interactive )
 255   (save-excursion
 256     (forward-sentence)
 257     (let ((end (point)))
 258       (backward-sentence)
 259       (zenkaku-katakana-region (point) end ))))
 260
 261 (defun zenkaku-katakana-word (arg)
 262   (interactive "p")
 263   (let ((start (point)))
 264     (forward-word arg)
 265     (zenkaku-katakana-region start (point))))
 266
 267 ;;;
 268 ;;;  JISX 0201 fence mode
 269 ;;;
 270
 271 (defun fence-hankaku-katakana  ()
 272   (interactive)
 273   (hankaku-katakana-region egg:*region-start* egg:*region-end* t))
 274
 275 (defun fence-katakana  ()
 276   (interactive)
 277   (zenkaku-katakana-region egg:*region-start* egg:*region-end* )
 278   (japanese-katakana-region egg:*region-start* egg:*region-end*))
 279
 280 (defun fence-hiragana  ()
 281   (interactive)
 282   (zenkaku-katakana-region egg:*region-start* egg:*region-end*)
 283   (japanese-hiragana-region egg:*region-start* egg:*region-end*))
 284
 285 (define-key fence-mode-map "\ex"  'fence-hankaku-katakana)