;;; 新仮名遣いから歴史的仮名遣いに変換 ;;; ;;; 1996.1.21 ;;; (defconst regx-list-old '( ("\\(し\C-j?ょ\C-j?う\\)" . "せう") ("\\(き\C-j?ょ\C-j?う\\)" . "けふ") ("\\(ち\C-j?ょ\C-j?う\C-j?ど\\)" . "ちやうど") ("\\([味賑結幸]\n?わ\\)\C-j?\\([わいうえお]\\)" . "$") ("[味賑結幸]\n?\\(わ\\)" . "は") ("い\C-j?\\(わ\\)\C-j?[ゆば]" . "は") ("\\(わ\\)\C-j?[いうえお]" . "は") ("[そこ]\n?う\n?い\n?\\(う\\)" . "ふ") ("[とにてでのはを]\C-j?い\C-j?\\([わいうえお]\\)\n?[^に]") ("[あかだな]\C-j?\\(ろ\\)\C-j?う" . "ら") ("[てで]\C-j?\\(い\\)\C-j?[たてなまれよる]" . "い") ("\\(い\\)\C-j?な\C-j?い" . "い") ("強\C-j?\\(い\\)\C-j?[しすたてれ]" . "ひ") ("[帥将將用率]\C-j?\\(い\\)" . "ゐ") ("[据植飢餓ゆ]\C-j?\\(え\\)" . "ゑ") ("\\cC\C-j?\\(と\\)\C-j?う" . "た") ("[死]\C-j?\\(の\\)\C-j?う" . "な") ("\\cC\C-j?\\(も\\)\C-j?う" . "ま") ("\\cC\C-j?\\(ろ\\)\C-j?う" . "ら") ("[てでに]\C-j?\\(お\\)\C-j?[らりるれ]" . "を") ("て\C-j?お\C-j?\\(こ\\)\C-j?う" . "か") ("[たのる]\C-j?う\C-j?\\(え\\)" . "へ") ("あ\C-j?\\(え\\)\C-j?[ずて]" . "へ") ("[のうくすたぬふむる]\C-j?\\(ほ\\)\C-j?う" . "は") ("す\C-j?な\C-j?\\(わ\\)\C-j?ち" . "は") ("\\(わ\\)\C-j?れ\C-j?る" . "は") ("\\(こ\\)\C-j?う\C-j?し" . "か") ("\\(こ\\)\C-j?う" . "か") ("\\(そ\\)\C-j?う" . "さ") ("お?[のみ自]\C-j?\\(ず\\)\C-j?[かと]\C-j?ら?" . "づ") ("い\C-j?\\(ず\\)\C-j?れ" . "づ") ("\\(ず\\)\C-j?つ" . "づ") ("ま\C-j?\\(ず\\)" . "づ") ("[のいうくすたぬふむる]\C-j?は\C-j?\\(ず\\)" . "づ") ("わ\C-j?\\(ず\\)\C-j?か" . "づ") ("[閉恥耻]\C-j?\\(ず\\)" . "づ") ("[閉恥耻]\C-j?\\(じ\\)" . "ぢ") ("\\(い\\)\C-j?よ\C-j?う" . "ゐ") ("\\(よ\\)\C-j?う\C-j?す" . "や") ("[のいうくすたぬふむる]\C-j?\\(よ\\)\C-j?う\C-j?[なにでだ]?" . "や") ("\\(よ\\)\C-j?う\C-j?や\C-j?く" . "や") ("[な猶尚]\C-j?\\(お\\)" . "ほ") ("\\(ゃ\\)" . "や") ("\\(ゅ\\)" . "ゆ") ("\\(ょ\\)" . "よ") ("\\(っ\\)" . "つ") ("\\(わ\\)\C-j?し\C-j?[いくけ]" . "は") ("\\cC\C-j?\\(ぼ\\)\C-j?う" . "ば") ("[てでにがはと]\C-j?\\(い\\)\C-j?\\([るたてまな]\\|\\(ら\C-j?れ\\)\\|\\(よ\C-j?う\\)\\)" . "ゐ") ("\\(し\C-j?ま\C-j?\\)\C-j?\\([わいうえお]\\)" . "$") ("\\(\\cC\\|あ\\|い\\|ま\\|わ\\)\C-j?\\([わいうえお]\\)" . "!") )) (defconst regx-list-new '( ("\\(つ\C-j?\\)[たちてと]" . "っ") ("\\(つ\C-j?\\)[きくそ]り" . "っ") ("\\(せ\C-j?う\\)" . "しょう") ("\\(け\C-j?ふ\\)" . "きょう") ("\\(ち\C-j?や\C-j?う\C-j?ど\\)" . "ちょうど") ("い\C-j?\\(は\\)\C-j?[ゆば]" . "わ") ("[とにでのは]\C-j?い\C-j?\\([はひふへほ]\\)") ("[あかだな]\C-j?\\(ら\\)\C-j?う" . "ろ") ("\\(ゐ\\)" . "い") ("\\(ゑ\\)" . "え") ("[てで]\C-j?\\(を\\)\C-j?[らりるれ]" . "お") ("て\C-j?お\C-j?\\(か\\)\C-j?う" . "こ") ("[たのる]\C-j?う\C-j?\\(へ\\)" . "え") ("あ\C-j?\\(へ\\)\C-j?[ずて]" . "え") ("[のうくすたぬふむる]\C-j?\\(は\\)\C-j?う" . "ほ") ("す\C-j?な\C-j?\\(は\\)\C-j?ち" . "わ") ("\\(は\\)\C-j?れ\C-j?る" . "わ") ("\\(か\\)\C-j?う\C-j?し" . "こ") ("\\cC\C-j?\\(た\\)\C-j?う" . "と") ("\\cC\C-j?\\(の\\)\C-j?う" . "な") ("\\cC\C-j?\\(ま\\)\C-j?う" . "も") ("\\cC\C-j?\\(ら\\)\C-j?う" . "ろ") ("\\(か\\)\C-j?う" . "こ") ("\\(さ\\)\C-j?う" . "そ") ("[のみ自]\C-j?\\(づ\\)\C-j?か\C-j?ら" . "ず") ("い\C-j?\\(づ\\)\C-j?れ" . "ず") ("\\(づ\\)\C-j?つ" . "ず") ("ま\C-j?\\(づ\\)" . "ず") ("[のいうくすたぬふむる]\C-j?は\C-j?\\(づ\\)" . "ず") ("わ\C-j?\\(づ\\)\C-j?か" . "ず") ("[有在散入要炒煎熬居射鋳売彫選下降折居織上刈苅駆駈切斬截伐繰蹴凝去知刷摺剃掏迫反剃逸足散釣吊照取採捕執撮生成為塗練煉乗載罵張振震降触振放抛掘彫回廻群減罵守盛破揺因由拠依寄凭頼割鑄賣驅爲乘觸搖據]\C-j?\\(ら\\)\C-j?う" . "ろ") ("[閉恥耻]\C-j?\\(づ\\)" . "ず") ("[閉恥耻]\C-j?\\(ぢ\\)" . "じ") ("\\(や\\)\C-j?う\C-j?す" . "よ") ("[のいうくすたぬふむる]\C-j?\\(や\\)\C-j?う\C-j?[なにでだ]?" . "よ") ("\\(や\\)\C-j?う\C-j?や\C-j?く" . "よ") ("[な猶尚]\C-j?\\(ほ\\)" . "お") ("\\cC\C-j?\\(ば\\)\C-j?う" . "ぼ") ("\\(し\C-j?ま\C-j?\\)\C-j?\\([はひふへほ]\\)" . "$") ("\\(\\cC\\|い\\|わ\\)\C-j?\\([はひふへほ]\\)" . "!") )) (defconst hagyo-old '(("わ" . "は") ("い" . "ひ") ("う" . "ふ") ("え" . "へ") ("お" . "は"))) (defconst hagyo-new '(("は" . "わ") ("ひ" . "い") ("ふ" . "う") ("へ" . "え") ("は" . "お"))) (defconst jogai "缺欠玄説狹畫嘆歎燒々亜哀愛悪或暗闇偉員引嘘雲叡映曳栄永泳洩鋭越円援遠於汚往温寡稼画解快悔絵開慨各覚割渇乾寒巻寛干潅甘緩貫陥丸危幾揮毅貴輝飢欺急泣旧強彊怯狭響驚仰暁近傾継軽欠堅見賢古固互後厚向好宏巧幸広弘硬紅荒香高剛酷黒漉今詐挫塞砕細咲捌撒酸史嗣枝次疾釈若弱惹手朱種趣就衆醜柔渋重瞬淳暑庶書除小少尚招捷消焼紹衝植殖色深辛震人吹炊据青脆赤絶煽鮮善全粗素掃掻早相蒼即速続尊多太耐退大叩脱丹歎淡短置遅着中抽注聴超長痛低甜吐透働動導撞得篤突届鈍軟難熱燃濃播背剥博白薄曝抜挽晩披肥描品付敷赴焚聞碧歩抱萌飽防吠殆無鳴愈癒湧涌由幼用耀率凌良老儘卷吼嘯圓屆惡榮痊瘉續聳覺遲騷") (defconst kakutei "贖累逢扱囲意易萎謂違窺唄云詠厭掩沿応押憶加歌禍会蓋堪患換敢関願希揮帰疑逆吸救供競協教吟具喰遇訓憩携敬稽計迎結遣顕現言雇乞交抗拘控更構考行合債済災雑讃賛仕伺使思支賜飼事失種囚愁拾終習襲酬集従縦臭祝循潤遵順償唱尚彰称笑訟拭食振震衰酔随数勢整生誓請戚占戦洗繕狙訴喪想争葬装捉卒揃損耐替代濯奪担湛鍛値畜蓄逐著弔調追通添纏伝答闘匂賑能覗買賠伴煩庇備畢漂表病負舞副覆払奮蔽変捕補慕倣報縫訪貿迷問悶憂猶誘与傭用謡養抑例恋露惑仆會傚傳兢竸况簒啖啗嗤嚮圍從應懷戀戰擔拂拵擒攜攫數變歸殃浚渫濟濬爭稱縱與裝誂誣謠謳譬讚贊隨醉關襍雜竟顯鬪") (defun new2old () "" (interactive) (save-excursion (setq temp-regx-list-temp regx-list-old) (while temp-regx-list-temp (setq regx-string (car (car temp-regx-list-temp)) replace-string (cdr (car temp-regx-list-temp)) replace-string2 replace-string) (goto-char (point-min)) (while (not (eobp)) (if (re-search-forward regx-string nil t) (progn (message (buffer-substring (match-beginning 0) (match-end 0))) (setq sp (match-beginning 1) ep (match-end 1) target (buffer-substring sp ep)) (if replace-string (if (or (string= replace-string "!") (string= replace-string "$")) (if (string-match target jogai) nil (progn (setq sp (match-beginning 2) ep (match-end 2) target2 (buffer-substring sp ep)) (if (or (string-match target kakutei) (string= replace-string "$")) (setq replace-string2 (cdr (assoc target2 hagyo-old))) (kana-query-replace (buffer-substring (match-beginning 0) (match-end 0)) t)) (if replace-string2 (progn (goto-char sp) (delete-region sp ep) (insert replace-string2))))) (progn (goto-char sp) (delete-region sp ep) (insert replace-string2))) (progn (goto-char sp) (delete-region sp ep) (insert (cdr (assoc target hagyo-old)))))) (goto-char (point-max)))) (setq temp-regx-list-temp (cdr temp-regx-list-temp))))) (defun old2new () "" (interactive) (save-excursion (setq temp-regx-list-temp regx-list-new) (while temp-regx-list-temp (setq regx-string (car (car temp-regx-list-temp)) replace-string (cdr (car temp-regx-list-temp)) replace-string2 replace-string) (goto-char (point-min)) (while (not (eobp)) (if (re-search-forward regx-string nil t) (progn (message (buffer-substring (match-beginning 0) (match-end 0))) (setq sp (match-beginning 1) ep (match-end 1) target (buffer-substring sp ep)) (if replace-string (if (or (string= replace-string "!") (string= replace-string "$")) (if (string-match target jogai) nil (progn (setq sp (match-beginning 2) ep (match-end 2) target2 (buffer-substring sp ep)) (if (or (string-match target kakutei) (string= replace-string "$")) (setq replace-string2 (cdr (assoc target2 hagyo-new))) (if (string-match "\\cC" target) (setq replace-string2 nil) (kana-query-replace (buffer-substring (match-beginning 0) (match-end 0)) nil))) (if replace-string2 (progn (goto-char sp) (delete-region sp ep) (insert replace-string2))))) (if replace-string2 (progn (goto-char sp) (delete-region sp ep) (insert replace-string2)))) (progn (goto-char sp) (delete-region sp ep) (insert (cdr (assoc target hagyo-new)))))) (goto-char (point-max)))) (setq temp-regx-list-temp (cdr temp-regx-list-temp))) (message "Done."))) (defun kana-query-replace (word old-or-not) "" (if old-or-not (setq hagyo-temp hagyo-old) (setq hagyo-temp hagyo-new)) (message (format "%s 置換？ (Space or Del): " word)) (setq num (read-char)) (cond ((= num 32) (setq replace-string2 (cdr (assoc target2 hagyo-temp))) (if (string-match "\\cC" word) (setq kakutei (concat kakutei target)))) ((= num 127) (setq replace-string2 nil) (if (string-match "\\cC" word) (setq jogai (concat jogai target)))) ))