(defgroup translit-ru nil
  "The major mode for typing in Russian translit"
  :group 'languages)

(defvar *local-last-input* nil)

(defvar *latin-cyrillic-map*
  '((97  . "а") (98  . "б") (99  . "ц") (100 . "д")
    (101 . "е") (102 . "ф") (39  . "ь") (35  . "ъ")
    (103 . "г") (104 . "х") (105 . "и") (106 . "й")
    (107 . "к") (108 . "л") (109 . "м") (110 . "н")
    (111 . "о") (112 . "п") (113 . "щ") (114 . "р")
    (115 . "с") (116 . "т") (117 . "у") (118 . "в")
    (119 . "щ") (120 . "х") (121 . "ы") (122 . "з")))

(defvar *latin-cyrillic-prefices*
  '((106 . ((117 . "ю") (97 . "я") (101 . "э") (111 . "ё"))) ; j
    (115 . ((104 . "ш")))				     ; s
    (99  . ((104 . "ч")))				     ; c
    (122 . ((104 . "ж")))))				     ; z

(defun upcase-if-needed (c needed)
  (if needed c (upcase c)))

(defun latin-to-cyrillic ()
  (interactive)
  (setq debug-on-error t)
  (let* ((downcase-c (downcase last-input-char))
	 (matched-c (cdr (assq downcase-c *latin-cyrillic-map*)))
	 (continuation
	  (when *local-last-input*
	    (assq (downcase *local-last-input*)
		  *latin-cyrillic-prefices*)))
	 (completion (assq downcase-c continuation))
	 (last-input *local-last-input*)
	 (need-upcase (eq last-input-char downcase-c))
	 (reset-last (assq downcase-c *latin-cyrillic-prefices*)))
    (setq *local-last-input* nil)
    (cond
     (completion
      (insert (upcase-if-needed
	       (cdr completion)
	       (eq (downcase last-input) last-input))))
     (last-input
      (insert (upcase-if-needed
	       (cdr (assq (downcase last-input) *latin-cyrillic-map*))
	       (eq (downcase last-input) last-input)))
      (when (and matched-c (not reset-last))
	(insert (upcase-if-needed matched-c need-upcase))))
     ((and matched-c (not reset-last))
      (insert (upcase-if-needed matched-c need-upcase)))
     ((not matched-c) (insert last-input-char)))
    (when reset-last
      (setq *local-last-input* last-input-char))))
  
(define-key (current-global-map)
  [remap self-insert-command]
  'latin-to-cyrillic)
;(define-key (current-global-map) [remap self-insert-command] 'self-insert-command)

(provide 'translit-ru)