;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration -*- coding: ctext -*- 

;; Copyright (C) 2004, 2006  Free Software Foundation, Inc.

;; Author: Werner LEMBERG <wl@gnu.org>

;; Keywords: multilingual, input method, Chinese, pinyin, sisheng

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Synched up with: FSF 22.0.50.6

;;; Commentary:

;;; XEmacs change: use ctext as coding system for compatibility with 21.4

;;; Code:

(require 'quail)

;; XEmacs change; assoc-string is FSF-specific. 
(defun-when-void assoc-string (key list &optional case-fold)
  "Like `assoc' but specifically for strings.
Case is ignored if case-fold is non-nil.
As opposed to `assoc', it will also match an entry consisting of a single
string rather than a cons cell whose car is a string."
  (block return-assoc-string
    (setq key (downcase key))
    (dolist (str list)
      (when (equal key (downcase (format "%s" (if (consp str)
						  (car str)
						str))))
	(return-from return-assoc-string str)))))

(defconst sisheng-regexp
  "[-Dàºïòþ$(A(5(B]\\|-Aü-Dº")-A

;; First element is the key,
;; second element is the vowel used for the input sequence,
;; last four elements are the resulting tones.
;;
(defconst sisheng-vowel-table
  '(("-Dà" "a" "à" "-Aá" "$(A(#(B" "à")
    ("-Dº" "e" "º" "-Aé" "-Bì" "-Aè")
    ("-Dï" "i" "ï" "-Aí" "$(A(+(B" "ì")
    ("-Dò" "o" "ò" "-Aó" "$(A(/(B" "ò")
    ("-Dþ" "u" "þ" "-Aú" "$(A(3(B" "ù")
    ("$(A(5(B" "v" "$(A(5(B" "$(A(6(B" "$(A(7(B" "$(A(8(B")
    ("ü-Dº" "ve" "-Aü-Dº" "-Aüé" "ü-Bì" "-Aüè")))


;; All possible syllables in Mandarin Chinese, presented in the first
;; tone.  Note that make-sisheng-rules always constructs rules for all
;; four tones even if some of those tones aren't used in Mandarin.
;;
(defconst sisheng-syllable-table
  '("-Dà" "ài" "àn" "àng" "ào"-A

    "b-Dà" "bài" "bàn" "bàng" "bào"-A
    "b-Dºi" "bºn" "bºng"-A
    "b-Dï" "biàn" "biào" "biº" "bïn" "bïng"-A
    "b-Dò"-A
    "b-Dþ"-A

    "c-Dà" "cài" "càn" "càng" "cào"-A
    "c-Dº" "cºn" "cºng"-A
    "c-Dï"-A
    "c-Dòng" "còu"-A
    "c-Dþ" "cuàn" "cuï" "cþn" "cuò"-A

    "ch-Dà" "chài" "chàn" "chàng" "chào"-A
    "ch-Dº" "chºn" "chºng"-A
    "ch-Dï"-A
    "ch-Dòng" "chòu"-A
    "ch-Dþ" "chuà" "chuài" "chuàn" "chuàng" "chuï" "chþn" "chuò"-A

    "d-Dà" "dài" "dàn" "dàng" "dào"-A
    "d-Dº" "dºi" "dºn" "dºng"-A
    "d-Dï" "diàn" "diào" "diº" "dïng" "diþ"-A
    "d-Dòng" "dòu"-A
    "d-Dþ" "duàn" "duï" "dþn" "duò"-A

    "-Dº" "ºi" "ºn" "ºng" "ºr"-A

    "f-Dà" "fàn" "fàng"-A
    "f-Dºi" "fºn" "fºng"-A
    "fi-Dào"-A
    "f-Dò" "fòu"-A
    "f-Dþ"-A

    "g-Dà" "gài" "gàn" "gàng" "gào"-A
    "g-Dº" "gºi" "gºn" "gºng"-A
    "g-Dòng" "gòu"-A
    "g-Dþ" "guà" "guài" "guàn" "guàng" "guï" "gþn" "guò"-A

    "h-Dà" "hài" "hàn" "hàng" "hào"-A
    "h-Dº" "hºi" "hºn" "hºng"-A
    "h-Dòng" "hòu"-A
    "h-Dþ" "huà" "huài" "huàn" "huàng" "huï" "hþn" "huò"-A

    "j-Dï" "jià" "jiàn" "jiàng" "jiào" "jiº" "jïn" "jïng" "jiòng" "jiþ"-A
    "j-Dþ" "juàn" "juº" "jþn"-A

    "k-Dà" "kài" "kàn" "kàng" "kào"-A
    "k-Dº" "kºi" "kºn" "kºng"-A
    "k-Dòng" "kòu"-A
    "k-Dþ" "kuà" "kuài" "kuàn" "kuàng" "kuï" "kþn" "kuò"-A

    "l-Dà" "lài" "làn" "làng" "lào"-A
    "l-Dº" "lºi" "lºng"-A
    "l-Dï" "lià" "liàn" "liàng" "liào" "liº" "lïn" "lïng" "liþ"-A
    "l-Dòng" "lòu"-A
    "l-Dþ" "luàn" "lþn" "luò"-A
    "l$(A(5(B" "lü-Dº"-A

    "m-Dà" "mài" "màn" "màng" "mào"-A
    "m-Dº" "mºi" "mºn" "mºng"-A
    "m-Dï" "miàn" "miào" "miº" "mïn" "mïng" "miþ"-A
    "m-Dò" "mòu"-A
    "m-Dþ"-A

    "n-Dà" "nài" "nàn" "nàng" "nào"-A
    "n-Dº" "nºi" "nºn" "nºng"-A
    "n-Dï" "niàn" "niàng" "niào" "niº" "nïn" "nïng" "niþ"-A
    "n-Dòng" "nòu"-A
    "n-Dþ" "nuàn" "nuò"-A
    "n$(A(5(B" "nü-Dº"-A

    "-Dò" "òu"-A

    "p-Dà" "pài" "pàn" "pàng" "pào"-A
    "p-Dºi" "pºn" "pºng"-A
    "p-Dï" "piàn" "piào" "piº" "pïn" "pïng"-A
    "p-Dò" "pòu"-A
    "p-Dþ"-A

    "q-Dï" "qià" "qiàn" "qiàng" "qiào" "qiº" "qïn" "qïng" "qiòng" "qiþ"-A
    "q-Dþ" "quàn" "quº" "qþn"-A

    "r-Dàn" "ràng" "rào"-A
    "r-Dº" "rºn" "rºng"-A
    "r-Dï"-A
    "r-Dòng" "ròu"-A
    "r-Dþ" "ruà" "ruàn" "ruï" "rþn" "ruò"-A

    "s-Dà" "sài" "sàn" "sàng" "sào"-A
    "s-Dº" "sºn" "sºng"-A
    "s-Dï"-A
    "s-Dòng" "sòu"-A
    "s-Dþ" "suàn" "suï" "sþn" "suò"-A

    "sh-Dà" "shài" "shàn" "shàng" "shào"-A
    "sh-Dº" "shºi" "shºn" "shºng"-A
    "sh-Dï"-A
    "sh-Dòu"-A
    "sh-Dþ" "shuà" "shuài" "shuàn" "shuàng" "shuï" "shþn" "shuò"-A

    "t-Dà" "tài" "tàn" "tàng" "tào"-A
    "t-Dº" "tºi" "tºng"-A
    "t-Dï" "tiàn" "tiào" "tiº" "tïng"-A
    "t-Dòng" "tòu"-A
    "t-Dþ" "tuàn" "tuï" "tþn" "tuò"-A

    "w-Dà" "wài" "wàn" "wàng"-A
    "w-Dºi" "wºn" "wºng"-A
    "w-Dò"-A
    "w-Dþ"-A

    "x-Dï" "xià" "xiàn" "xiàng" "xiào" "xiº" "xïn" "xïng" "xiòng" "xiþ"-A
    "x-Dþ" "xuàn" "xuº" "xþn"-A

    "y-Dà" "yàn" "yàng" "yào"-A
    "y-Dº"-A
    "y-Dï" "yïn" "yïng"-A
    "y-Dò" "yòng" "yòu"-A
    "y-Dþ" "yuàn" "yuº" "yþn"-A

    "z-Dà" "zài" "zàn" "zàng" "zào"-A
    "z-Dº" "zºi" "zºn" "zºng"-A
    "z-Dï"-A
    "z-Dòng" "zòu"-A
    "z-Dþ" "zuàn" "zuï" "zþn" "zuò"-A

    "zh-Dà" "zhài" "zhàn" "zhàng" "zhào"-A
    "zh-Dº" "zhºi" "zhºn" "zhºng"-A
    "zh-Dï"-A
    "zh-Dòng" "zhòu"-A
    "zh-Dþ" "zhuà" "zhuài" "zhuàn" "zhuàng" "zhuï" "zhþn" "zhuò"))-A

;; This function converts e.g.
;;
;;   "zhu-Dò"-A
;;
;; into
;;
;;   (("zhuo4" ["zhuò"])
;;    ("zhuo3" ["zhu$(A(/(B"])
;;    ("zhuo2" ["zhuó"])
;;    ("zhuo1" ["zhu-Dò"]))-A
;;
(defun quail-make-sisheng-rules (syllable)
  (let ((case-fold-search t)
	vowel-match
	vowel-list
	input-vowel
	base-key
	key
	value
	key-value-list
	(i 1))
    (string-match sisheng-regexp syllable)
    (setq vowel-match (downcase (match-string 0 syllable)))
    (setq vowel-list
	  (cdr (assoc-string vowel-match sisheng-vowel-table)))
    (setq input-vowel (car vowel-list))
    (setq base-key (replace-match input-vowel nil nil syllable))
    (while (<= i 4)
      (setq key (concat base-key (number-to-string i)))
      (setq value (vector (replace-match (nth i vowel-list) nil nil syllable)))
      (push (list key value) key-value-list)
      (setq i (1+ i)))
    key-value-list))

;; Set up sisheng input method.
;;
(quail-define-package
 "chinese-sisheng"			; name
 "Chinese"				; language
 "$(A(7(B"					; title
 t					; guidance
 "Sìsh-Dºng input method for pïnyïn transliteration of Chinese.-A

Examples: shuang1 -> shu-Dàng-A
          Lv3     -> L$(A(7(B
          AN4     -> ÀN

Use the fifth (unstressed) tone for syllables containing `ü'
without a tone mark.

Example:  nve5    -> nüe
"					; docstring
 nil					; translation-keys
 t					; forget-last-selection
 nil					; deterministic
 nil					; kbd-translate
 nil					; show-layout
 nil					; create-decode-map
 nil					; maximum-shortest
 nil					; overlay-plist
 nil					; update-translation-function
 nil					; conversion-keys
 t					; simple
 )

;; Call quail-make-sisheng-rules for all syllables in sisheng-syllable-table.
;;
(let ((case-table-save (current-case-table))
      sisheng-list)
  (set-case-table (standard-case-table))
  (dolist (syllable sisheng-syllable-table)
    (setq sisheng-list
	  (append (quail-make-sisheng-rules syllable)
		  sisheng-list)))

  (dolist (syllable sisheng-syllable-table)
    (setq sisheng-list
	  (append (quail-make-sisheng-rules (upcase-initials syllable))
		  sisheng-list)))

  (dolist (syllable sisheng-syllable-table)
    (setq sisheng-list
	  (append (quail-make-sisheng-rules (upcase syllable))
		  sisheng-list)))

  (eval `(quail-define-rules
	  ,@sisheng-list
	
	  ("lv5" ["lü"])
	  ("lve5" ["lüe"])
	  ("nv5" ["nü"])
	  ("nve5" ["nüe"])

	  ("Lv5" ["Lü"])
	  ("Lve5" ["Lüe"])
	  ("Nv5" ["Nü"])
	  ("Nve5" ["Nüe"])

	  ("LV5" ["LÜ"])
	  ("LVE5" ["LÜE"])
	  ("NV5" ["NÜ"])
	  ("NVE5" ["NÜE"])))
  (set-case-table case-table-save))

;;; arch-tag: 1fa6ba5f-6747-44bc-bf12-30628ad3e8ad
