Want more features on Pastebin? Sign Up, it's FREE!
Guest

Mind-bogging transliteration

By: a guest on Dec 16th, 2011  |  syntax: Lisp  |  size: 2.17 KB  |  views: 104  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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)
clone this paste RAW Paste Data