Advertisement
Guest User

Mind-bogging transliteration

a guest
Dec 16th, 2011
259
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 2.17 KB | None | 0 0
  1. (defgroup translit-ru nil
  2.   "The major mode for typing in Russian translit"
  3.   :group 'languages)
  4.  
  5. (defvar *local-last-input* nil)
  6.  
  7. (defvar *latin-cyrillic-map*
  8.   '((97  . "а") (98  . "б") (99  . "ц") (100 . "д")
  9.     (101 . "е") (102 . "ф") (39  . "ь") (35  . "ъ")
  10.     (103 . "г") (104 . "х") (105 . "и") (106 . "й")
  11.     (107 . "к") (108 . "л") (109 . "м") (110 . "н")
  12.     (111 . "о") (112 . "п") (113 . "щ") (114 . "р")
  13.     (115 . "с") (116 . "т") (117 . "у") (118 . "в")
  14.     (119 . "щ") (120 . "х") (121 . "ы") (122 . "з")))
  15.  
  16. (defvar *latin-cyrillic-prefices*
  17.   '((106 . ((117 . "ю") (97 . "я") (101 . "э") (111 . "ё"))) ; j
  18.     (115 . ((104 . "ш")))                   ; s
  19.     (99  . ((104 . "ч")))                   ; c
  20.     (122 . ((104 . "ж")))))                     ; z
  21.  
  22. (defun upcase-if-needed (c needed)
  23.   (if needed c (upcase c)))
  24.  
  25. (defun latin-to-cyrillic ()
  26.   (interactive)
  27.   (setq debug-on-error t)
  28.   (let* ((downcase-c (downcase last-input-char))
  29.      (matched-c (cdr (assq downcase-c *latin-cyrillic-map*)))
  30.      (continuation
  31.       (when *local-last-input*
  32.         (assq (downcase *local-last-input*)
  33.           *latin-cyrillic-prefices*)))
  34.      (completion (assq downcase-c continuation))
  35.      (last-input *local-last-input*)
  36.      (need-upcase (eq last-input-char downcase-c))
  37.      (reset-last (assq downcase-c *latin-cyrillic-prefices*)))
  38.     (setq *local-last-input* nil)
  39.     (cond
  40.      (completion
  41.       (insert (upcase-if-needed
  42.            (cdr completion)
  43.            (eq (downcase last-input) last-input))))
  44.      (last-input
  45.       (insert (upcase-if-needed
  46.            (cdr (assq (downcase last-input) *latin-cyrillic-map*))
  47.            (eq (downcase last-input) last-input)))
  48.       (when (and matched-c (not reset-last))
  49.     (insert (upcase-if-needed matched-c need-upcase))))
  50.      ((and matched-c (not reset-last))
  51.       (insert (upcase-if-needed matched-c need-upcase)))
  52.      ((not matched-c) (insert last-input-char)))
  53.     (when reset-last
  54.       (setq *local-last-input* last-input-char))))
  55.  
  56. (define-key (current-global-map)
  57.   [remap self-insert-command]
  58.   'latin-to-cyrillic)
  59. ;(define-key (current-global-map) [remap self-insert-command] 'self-insert-command)
  60.  
  61. (provide 'translit-ru)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement