code.delx.au - gnu-emacs/blob - lisp/international/robin.el

   1 ;;; robin.el --- yet another input method (smaller than quail)
   2
   3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
   4 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   5 ;;   Registration Number: H15PRO110
   6
   7 ;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
   8 ;; Keywords: mule, multilingual, input method, i18n
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Functionalities
  28 ;; ---------------
  29
  30 ;; Robin is a new input method for GNU Emacs.  It has three
  31 ;; functionalities:
  32
  33 ;; 1. It serves as a simple input method.  When the user types an ASCII
  34 ;;    key sequence, robin converts it into a string.  This functionality
  35 ;;    is most likely used to input non-ASCII characters.
  36
  37 ;; 2. It converts existing buffer substring into another string.
  38 ;;    This functionality is similar to the 1. above, but the input is
  39 ;;    buffer substring rather than key strokes.
  40
  41 ;; 3. It offers reverse conversion.  Each character produced by a
  42 ;;    robin rule can hold the original ASCII sequence as a
  43 ;;    char-code-property.
  44
  45
  46 ;; How to define conversion rules
  47 ;; ------------------------------
  48
  49 ;; Each conversion rule belongs to a robin package.  A robin package is
  50 ;; identified by a string called package name.  Use robin-define-package
  51 ;; to define a robin package.
  52
  53 ;; (robin-define-package NAME DOCSTRING
  54 ;;   (INPUT1 OUTPUT1)
  55 ;;   (INPUT2 OUTPUT2)
  56 ;;   ...)
  57
  58 ;; NAME is a string identifying the robin package.  It often starts with a
  59 ;; language name and followed by a method name.  For example,
  60 ;; french-postfix, greek-prefix, etc.
  61
  62 ;; DOCSTRING is a documentation string for the robin method.
  63
  64 ;; Each INPUTn is a string.  It represents a transliteration of the
  65 ;; corresponding OUTPUTn.
  66
  67 ;; Each OUTPUTn is a string or a character that is to be inserted as the
  68 ;; result of conversion.
  69
  70 ;; Neither INPUT* nor OUTPUT* are evaluated.  Do not use a variable or a
  71 ;; function in those parts.  Instead, use a string or character literal
  72 ;; directly.
  73
  74 ;; If multiple rules have the same input pattern but different output
  75 ;; patterns, only the latest definition is effective.
  76
  77
  78 ;; Example
  79 ;; -------
  80
  81 ;; (robin-define-package "german-example"
  82 ;;  "An example for German
  83
  84 ;; AE -> Ä   OE -> Ö   UE -> Ü
  85 ;; ae -> ä   oe -> ö   ue -> ü   ss -> ß
  86
  87 ;; Repeat E or S to input itself.
  88
  89 ;; AEE -> AE   OEE -> OE   UEE -> UE
  90 ;; aee -> ae   oee -> oe   uee -> ue   sss -> ss"
  91
  92 ;;  ("AE" ?Ä)
  93 ;;  ("OE" ?Ö)
  94 ;;  ("UE" ?Ü)
  95 ;;  ("ae" ?ä)
  96 ;;  ("oe" ?ö)
  97 ;;  ("ue" ?ü)
  98 ;;  ("ss" ?ß)
  99
 100 ;;  ("AEE" "AE")
 101 ;;  ("OEE" "OE")
 102 ;;  ("UEE" "UE")
 103 ;;  ("aee" "ae")
 104 ;;  ("oee" "oe")
 105 ;;  ("uee" "ue")
 106 ;;  ("sss" "ss")
 107 ;; )
 108
 109
 110 ;; Using robin as an input method
 111 ;; ------------------------------
 112
 113 ;; To use a defined robin package as an input method, register it with
 114 ;; the register-input-method function.  For example,
 115
 116 ;; (register-input-method
 117 ;;  "german-example"
 118 ;;  "german"
 119 ;;  'robin-use-package
 120 ;;  "de"
 121 ;;  "An example for German")
 122
 123 ;; The first argument is the robin package name.
 124
 125 ;; The second argument is the language environment for which this robin
 126 ;; package is used.
 127
 128 ;; Use the symbol `robin-use-package' as the third argument.
 129
 130 ;; The fourth argument is the prompt that appears in mode line when this
 131 ;; input method is active.
 132
 133 ;; The fifth argument is a documentation string; it may or may not be
 134 ;; identical to the one that you specified in robin-define-package.
 135
 136 ;; You can activate the robin input method by typing
 137
 138 ;;  C-u C-\ german-example RET
 139
 140 ;; Just like a quail package, only C-\ suffices for subsequent
 141 ;; invocation.
 142
 143
 144 ;; Using robin as a buffer translator
 145 ;; ----------------------------------
 146
 147 ;; To transliterate buffer substring, use the following functions.
 148
 149 ;; (robin-convert-buffer &optional name)
 150
 151 ;; Convert the content of current buffer using a robin package.
 152
 153 ;; NAME, if given, is a string specifying a robin package.  If NAME is
 154 ;; not given or nil, the value of `robin-current-package-name' is used.
 155
 156 ;; (robin-convert-region begin end &optional name)
 157
 158 ;; Convert the region using a robin package.
 159
 160 ;; NAME, if given, is a string specifying a robin package.  If NAME is
 161 ;; not given or nil, the value of `robin-current-package-name' is used.
 162
 163
 164 ;; Reverse conversion
 165 ;; ------------------
 166
 167 ;; If the output pattern defined in a robin rule is a character, robin
 168 ;; gives to the character a char-code-property whose key is the symbol
 169 ;; representation of the robin package name and whose value is the input
 170 ;; pattern of that character.  For example, with the "german-example"
 171 ;; definition above,
 172
 173 ;; (get-char-code-property ?Ä 'german-example) => "AE"
 174
 175 ;; etc.
 176
 177 ;; If you do not want to assign a char-code-property to a character, use
 178 ;; a string of length one as the output pattern, e.g.
 179
 180 ;; (robin-define-package "german-example2"
 181 ;;  "Another example for German."
 182
 183 ;;  ("AE" "Ä")
 184 ;;  ("OE" "Ö")
 185 ;;  ...)
 186
 187 ;; Then
 188
 189 ;; (get-char-code-property ?Ä 'german-example2) => nil
 190
 191 ;; etc.
 192
 193 ;; If multiple input patterns in a robin package generate the same
 194 ;; character, the lastly used input pattern is given as the value of the
 195 ;; char-code-property.
 196
 197 ;; There are two functions for reverse conversion.
 198
 199 ;; (robin-invert-buffer &optional name)
 200
 201 ;; Apply reverse conversion to the content of current buffer.  NAME, if
 202 ;; given, is a string specifying a robin package.  If NAME is not given
 203 ;; or nil, the value of `robin-current-package-name' is used.
 204
 205 ;; (robin-invert-region begin end &optional name)
 206
 207 ;; Apply reverse conversion to the region.  NAME, if given, is a string
 208 ;; specifying a robin package.  If NAME is not given or nil, the value of
 209 ;; `robin-current-package-name' is used.
 210
 211
 212 ;; Modifying an existing rule
 213 ;; --------------------------
 214
 215 ;; Use the robin-modify-package function to modify a rule already defined
 216 ;; in a Robin package.
 217
 218 ;; (robin-modify-package name input output)
 219
 220 ;; Change a rule in an already defined Robin package.
 221 ;; NAME is the string specifying a robin package.
 222 ;; INPUT is a string that specifies the input pattern.
 223 ;; OUTPUT is either a character or a string to be generated.
 224
 225
 226 ;; The name of the game
 227 ;; --------------------
 228
 229 ;; As stated in Murphy's law, it took longer than expected to develop the
 230 ;; very first version of Japanese input subsystem in NEmacs (Nihongo
 231 ;; Emacs).  So the subsystem was named "TAMAGO", which is an acronym of
 232 ;; "TAkusan Matasete GOmen-nasai" (Sorry to have kept you waiting so
 233 ;; long).  "Tamago" as a Japanese word means "egg", so the word "egg" was
 234 ;; also used for related filenames and function names.
 235
 236 ;; Since it was designed to input CJK characters, Egg was rather big as a
 237 ;; subsystem.  So later in Mule (Multilingual Enhancement to GNU Emacs),
 238 ;; we designed and implemented a smaller input subsystem.  We had to give
 239 ;; it a name.  "So, what's smaller than an egg?"  "A quail egg, of
 240 ;; course."  Therefore it was named "quail".
 241
 242 ;; As time went by, quail became more and more complicated.  That
 243 ;; tendency was inevitable as long as we support CJK input.  However, if
 244 ;; we can limit ourselves to non-CJK characters, a much simpler
 245 ;; transliteration mechanism suffices.  So I wrote "robin", whose name
 246 ;; was chosen because a robin is smaller than a quail.  I could name it
 247 ;; "hummingbird" or "nightingale", but those spellings seemed too long.
 248
 249
 250 ;;; Code:
 251
 252 (defvar robin-package-alist nil
 253   "List of robin packages.
 254 A robin package is of the form (NAME DOCSTRING &rest RULES).
 255 NAME is a string specifying a particular robin package.
 256 DOCSTRING is a documentation string for the robin package.
 257
 258 RULE is of the form (KEY OUTPUT &rest rules).
 259 KEY is a string.
 260 OUTPUT is a character or a string.
 261 For example, if you evaluate the following,
 262
 263 \(robin-define-package \"test\" \"Uppercase input characters\"
 264   (\"a\" \"A\")
 265   (\"ab\" \"AB\")
 266   (\"ac\" \"AC\")
 267   (\"acd\" \"ACD\")
 268   (\"ace\" \"ACE\")
 269   (\"b\" \"B\"))
 270
 271 this robin package will be the following.
 272
 273   (\"test\" \"Uppercase input characters\"
 274    (?a \"A\"
 275        (?b \"AB\")
 276        (?c \"AC\"
 277            (?d \"ACD\")
 278            (?e \"ACE\")))
 279    (?b \"B\"))
 280 ")
 281
 282 ;;;###autoload
 283 (defmacro robin-define-package (name docstring &rest rules)
 284   "Define a robin package.
 285
 286 NAME is the string of this robin package.
 287 DOCSTRING is the documentation string of this robin package.
 288 Each RULE is of the form (INPUT OUTPUT) where INPUT is a string and
 289 OUTPUT is either a character or a string.  RULES are not evaluated.
 290
 291 If there already exists a robin package whose name is NAME, the new
 292 one replaces the old one."
 293
 294   (let ((iname (intern name))
 295         (new (list name ""))            ; "" as a fake output
 296         input output pairs)
 297     (dolist (r rules)
 298       (setq input (car r)
 299             output (cadr r))
 300       (robin-add-rule name new input output)
 301       (cond
 302        ((not (stringp input))
 303         (error "Bad input sequence %S" r))
 304        ((characterp output)
 305         (setq pairs
 306               (cons (cons input output)
 307                     pairs)))
 308        ((not (stringp output))
 309         (error "Bad output pattern %S" r))))
 310     (setcar (cdr new) docstring)        ; replace "" above with real docstring
 311     `(let ((slot (assoc ,name robin-package-alist))
 312            (newdef ',new)
 313            (prop ',iname)
 314            (lst ',pairs))
 315        (if slot
 316            (setcdr slot (cdr newdef))
 317          (setq robin-package-alist
 318                (cons newdef robin-package-alist)))
 319        (dolist (l lst)
 320          (put-char-code-property (cdr l) prop (car l))))))
 321
 322 ;;;###autoload
 323 (defun robin-modify-package (name input output)
 324   "Change a rule in an already defined robin package.
 325
 326 NAME is the string specifying a robin package.
 327 INPUT is a string that specifies the input pattern.
 328 OUTPUT is either a character or a string to be generated."
 329
 330   (let ((tree (assoc name robin-package-alist))
 331         docstring)
 332     (if (not tree)
 333         (error "No such robin package")
 334       (setq docstring (cadr tree))
 335       (setcar (cdr tree) "")
 336       (robin-add-rule name tree input output)
 337       (setcar (cdr tree) docstring)
 338       (if (characterp output)
 339           (put-char-code-property output (intern name) input))))
 340   output)
 341
 342 (defun robin-add-rule (name tree input output)
 343   "Add translation rule (INPUT OUTPUT) to TREE whose name is NAME.
 344 Internal use only."
 345
 346   (let* ((head (aref input 0))
 347          (branch (assoc head tree))
 348          (sofar (cadr tree)))
 349
 350     (if (= (length input) 1)
 351         (if branch
 352
 353             ;; A definition already exists for this input.
 354             ;; We do not cancel old char-code-property of OUTPUT
 355             ;; so that n-to-1 reverse conversion is possible.
 356             (setcar (cdr branch) output)
 357
 358           ;; New definition for this input.
 359           (setcdr (last tree) (list (list head output))))
 360
 361       (unless branch
 362         (if (characterp sofar)
 363             (setq sofar (char-to-string sofar)))
 364         (setq branch
 365               (list head
 366                     (concat sofar
 367                             (char-to-string head))))
 368         (setcdr (last tree) (list branch)))
 369
 370       (robin-add-rule name branch (substring input 1) output))))
 371
 372 ;;; Interactive use
 373
 374 (defvar robin-mode nil
 375   "If non-nil, `robin-input-method' is active.")
 376 (make-variable-buffer-local 'robin-mode)
 377
 378 (defvar robin-current-package-name nil
 379   "String representing the name of the current robin package.
 380 A nil value means no package is selected.")
 381 (make-variable-buffer-local 'robin-current-package-name)
 382
 383 ;;;###autoload
 384 (defun robin-use-package (name)
 385   "Start using robin package NAME, which is a string."
 386
 387   (let ((package (assoc name robin-package-alist)))
 388     (unless package
 389       (error "No such robin package"))
 390     (setq robin-current-package-name name)
 391     (robin-activate)))
 392
 393 (defun robin-deactivate ()
 394   "Deactivate robin input method."
 395
 396   (interactive)
 397   (robin-activate -1))
 398
 399 (define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3")
 400
 401 (defun robin-activate (&optional arg)
 402   "Activate robin input method.
 403
 404 With ARG, activate robin input method if and only if ARG is positive.
 405
 406 While this input method is active, the variable
 407 `input-method-function' is bound to the function `robin-input-method'."
 408   (if (and arg
 409            (< (prefix-numeric-value arg) 0))
 410
 411       ;; deactivate robin input method.
 412       (unwind-protect
 413           (progn
 414             (setq robin-mode nil)
 415             (setq describe-current-input-method-function nil)
 416             (run-hooks
 417              'robin-inactivate-hook ; for backward compatibility
 418              'robin-deactivate-hook))
 419         (kill-local-variable 'input-method-function))
 420
 421     ;; activate robin input method.
 422     (setq robin-mode t
 423           describe-current-input-method-function 'robin-help
 424           deactivate-current-input-method-function 'robin-deactivate)
 425     (if (eq (selected-window) (minibuffer-window))
 426         (add-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer))
 427     (run-hooks 'input-method-activate-hook
 428                'robin-activate-hook)
 429     (set (make-local-variable 'input-method-function)
 430          'robin-input-method)))
 431
 432 (define-obsolete-variable-alias
 433   'robin-inactivate-hook
 434   'robin-deactivate-hook "24.3")
 435
 436 (defun robin-exit-from-minibuffer ()
 437   (deactivate-input-method)
 438   (if (<= (minibuffer-depth) 1)
 439       (remove-hook 'minibuffer-exit-hook 'robin-exit-from-minibuffer)))
 440
 441 (defun robin-input-method (key)
 442   "Interpret typed key sequence and insert into buffer."
 443
 444   (if (or buffer-read-only
 445           overriding-terminal-local-map
 446           overriding-local-map)
 447       (list key)
 448
 449     (let ((echo-keystrokes 0)
 450           (input-method-function nil)
 451           (start (point))
 452           (tree (cddr (assoc robin-current-package-name robin-package-alist)))
 453           branch
 454           output)
 455
 456       (while (setq branch (assq key tree))
 457         (delete-region start (point))
 458         (insert (setq output (cadr branch)))
 459         (setq tree (cddr branch))
 460         (if tree
 461             (setq key (read-event))
 462           (setq key nil)))
 463
 464       (if (null output)
 465           ;; body of the `while' above was not executed
 466           (list key)
 467         (delete-region start (point))
 468         (if key
 469             (push key unread-command-events))
 470         (if (stringp output)
 471             (string-to-list output)
 472           (list output))))))
 473
 474 (defun robin-help ()
 475   "Display the docstring of the current robin package."
 476
 477   (interactive)
 478   (let ((buf (get-buffer-create "*Robin Help*"))
 479         (doc (cadr (assoc robin-current-package-name robin-package-alist))))
 480     (set-buffer buf)
 481     (erase-buffer)
 482     (insert doc)
 483     (goto-char (point-min))
 484     (display-buffer buf)))
 485
 486 ;;; Batch mode
 487
 488 (defun robin-convert-buffer (&optional name)
 489   "Convert the content of current buffer using a robin package.
 490 NAME, if given, is a string specifying a robin package.  If NAME
 491 is not given or nil, the value of `robin-current-package-name' is
 492 used."
 493
 494   (interactive "*")
 495   (robin-convert-region (point-min) (point-max) name))
 496
 497 (defun robin-convert-region (begin end &optional name)
 498   "Convert the region using a robin package.
 499 NAME, if given, is a string specifying a robin package.  If NAME
 500 is not given or nil, the value of `robin-current-package-name' is
 501 used."
 502
 503   (interactive "*r")
 504   (or name
 505       (setq name robin-current-package-name)
 506       (error "No robin package specified"))
 507
 508   (let ((tree (assoc name robin-package-alist)))
 509     (unless tree
 510       (error "No such robin package"))
 511
 512     (save-excursion
 513       (save-restriction
 514         (narrow-to-region begin end)
 515         (goto-char (point-min))
 516         (while (not (eobp))
 517           (robin-convert-region-internal tree))))))
 518
 519 (defun robin-convert-region-internal (tree)
 520   "Apply a robin rule defined in TREE to the current point.
 521 Use the longest match method to select a rule."
 522
 523   (let ((begin (point))
 524         end branch)
 525     (while (setq branch (assq (following-char) tree))
 526       (setq tree branch)
 527       (forward-char 1))
 528
 529     (setq end (point))
 530     (if (= begin end)
 531         ;; no matching rule found; leave it as it is
 532         (forward-char 1)
 533       ;; replace the string
 534       (goto-char begin)
 535       (insert (cadr tree))
 536       (delete-char (- end begin)))))
 537
 538 ;; for backward compatibility
 539
 540 (fset 'robin-transliterate-region 'robin-convert-region)
 541 (fset 'robin-transliterate-buffer 'robin-convert-buffer)
 542
 543 ;;; Reverse conversion
 544
 545 (defun robin-invert-buffer (&optional name)
 546   "Apply reverse conversion to the content of current buffer.
 547 NAME, if given, is a string specifying a robin package.  If NAME
 548 is not given or nil, the value of `robin-current-package-name' is
 549 used."
 550
 551   (interactive "*")
 552   (robin-invert-region (point-min) (point-max) name))
 553
 554 (defun robin-invert-region (begin end &optional name)
 555   "Apply reverse conversion to the region.
 556 NAME, if given, is a string specifying a robin package.  If NAME
 557 is not given or nil, the value of `robin-current-package-name' is
 558 used."
 559
 560   (interactive "*r")
 561   (or name
 562       (setq name robin-current-package-name)
 563       (error "No robin package specified"))
 564
 565   (setq name (intern name))
 566   (let (str)
 567     (save-restriction
 568       (narrow-to-region begin end)
 569       (goto-char (point-min))
 570       (while (not (eobp))
 571         (if (not (setq str (get-char-code-property (following-char) name)))
 572             (forward-char 1)
 573           (insert str)
 574           (delete-char 1))))))
 575
 576 (provide 'robin)
 577
 578 ;; Local Variables:
 579 ;; coding: utf-8
 580 ;; End:
 581
 582 ;;; robin.el ends here