leim/quail/uni-input.el

   1 ;;; uni-input.el --- Hex Unicode input method
   2
   3 ;; Copyright (C) 2001, 2003, 2006  Free Software Foundation, Inc.
   4 ;; Copyright (C) 2004, 2005, 2006
   5 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   6 ;;   Registration Number H14PRO021
   7
   8 ;; Author: Dave Love <fx@gnu.org>
   9 ;; Keywords: i18n
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This file is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Provides an input method for entering characters by hex unicode in
  31 ;; the form `uxxxx', similarly to the Yudit editor.
  32
  33 ;; This is not really a Quail method, but uses some Quail functions.
  34 ;; There is probably A Better Way.
  35
  36 ;; Compare `ucs-insert', which explicitly inserts a unicoded character
  37 ;; rather than supplying an input method.
  38
  39 ;;; Code:
  40
  41 (require 'quail)
  42
  43 ;; Maybe stolen from Mule-UCS -- I don't remember.
  44 (define-ccl-program utf-8-ccl-encode
  45   `(4 (if (r0 < ?\x80)
  46         ((write r0))
  47       (if (r0 < #x800)
  48           ((write ((r0 >> 6) | ?\xC0))
  49            (write ((r0 & ?\x3F) | ?\x80)))
  50         (if (r0 < #x10000)
  51             ((write ((r0 >> 12) | ?\xE0))
  52              (write (((r0 >> 6) & ?\x3F) | ?\x80))
  53              (write ((r0 & ?\x3F) | ?\x80)))
  54           (if (r0 < #x200000)
  55               ((write ((r0 >> 18) | ?\xF0))
  56                (write (((r0 >> 12) & ?\x3F) | ?\x80))
  57                (write (((r0 >> 6) & ?\x3F) | ?\x80))
  58                (write ((r0 & ?\x3F) | ?\x80)))
  59             (if (r0 < #x4000000)
  60                 ((write ((r0 >> 24) | ?\xF8))
  61                  (write (((r0 >> 18) & ?\x3F) | ?\x80))
  62                  (write (((r0 >> 12) & ?\x3F) | ?\x80))
  63                  (write (((r0 >> 6) & ?\x3F) | ?\x80))
  64                  (write ((r0 & ?\x3F) | ?\x80)))
  65               ((write ((r0 >> 30) | ?\xFC))
  66                (write (((r0 >> 24) & ?\x3F) | ?\x80))
  67                (write (((r0 >> 18) & ?\x3F) | ?\x80))
  68                (write (((r0 >> 12) & ?\x3F) | ?\x80))
  69                (write (((r0 >> 6) & ?\x3F) | ?\x80))
  70                (write ((r0 & ?\x3F) | ?\x80))))))))))
  71
  72 (defun ucs-input-insert-char (char)
  73   (insert char)
  74   (move-overlay quail-overlay (overlay-start quail-overlay) (point)))
  75
  76 (defun ucs-input-method (key)
  77   (if (or buffer-read-only
  78           (and (/= key ?U) (/= key ?u)))
  79       (list key)
  80     (quail-setup-overlays nil)
  81     (ucs-input-insert-char key)
  82     (let ((modified-p (buffer-modified-p))
  83           (buffer-undo-list t)
  84           (input-method-function nil)
  85           (echo-keystrokes 0)
  86           (help-char nil)
  87           (events (list key))
  88           (str "    "))
  89       (unwind-protect
  90           (catch 'non-digit
  91             (progn
  92               (dotimes (i 4)
  93                 (let ((seq (read-key-sequence nil))
  94                       key)
  95                   (if (and (stringp seq)
  96                            (= 1 (length seq))
  97                            (setq key (aref seq 0))
  98                            (memq key '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?a
  99                                        ?b ?c ?d ?e ?f ?A ?B ?C ?D ?E ?F)))
 100                       (progn
 101                         (push key events)
 102                         (ucs-input-insert-char key))
 103                     (quail-delete-region)
 104                     (throw 'non-digit (append (reverse events)
 105                                               (listify-key-sequence seq))))))
 106               (quail-delete-region)
 107               (let* ((n (string-to-number (apply 'string
 108                                                  (cdr (nreverse events)))
 109                                           16))
 110                      (c (decode-char 'ucs n))
 111                      (status (make-vector 9 nil)))
 112                 (if c
 113                     (list c)
 114                   (aset status 0 n)
 115                   (string-to-list (ccl-execute-on-string
 116                                    'utf-8-ccl-encode status ""))))))
 117         (quail-delete-overlays)
 118         (set-buffer-modified-p modified-p)
 119         (run-hooks 'input-method-after-insert-chunk-hook)))))
 120
 121 (defun ucs-input-activate (&optional arg)
 122   "Activate UCS input method.
 123 With arg, activate UCS input method if and only if arg is positive.
 124
 125 While this input method is active, the variable
 126 `input-method-function' is bound to the function `ucs-input-method'."
 127   (if (and arg
 128           (< (prefix-numeric-value arg) 0))
 129       (unwind-protect
 130           (progn
 131             (quail-hide-guidance)
 132             (quail-delete-overlays)
 133             (setq describe-current-input-method-function nil))
 134         (kill-local-variable 'input-method-function))
 135     (setq inactivate-current-input-method-function 'ucs-input-inactivate)
 136     (setq describe-current-input-method-function 'ucs-input-help)
 137     (quail-delete-overlays)
 138     (if (eq (selected-window) (minibuffer-window))
 139         (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
 140     (set (make-local-variable 'input-method-function)
 141          'ucs-input-method)))
 142
 143 (defun ucs-input-inactivate ()
 144   "Inactivate UCS input method."
 145   (interactive)
 146   (ucs-input-activate -1))
 147
 148 (defun ucs-input-help ()
 149   (interactive)
 150   (with-output-to-temp-buffer "*Help*"
 151     (princ "\
 152 Input method: ucs (mode line indicator:U+)
 153
 154 Input as Unicode: U<hex> or u<hex>, where <hex> is a four-digit hex number.")))
 155
 156 ;; The file ../leim-ext.el contains the following call.
 157 ;; (register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+"
 158 ;;                     "Unicode input as hex in the form Uxxxx.")
 159
 160 (provide 'uni-input)
 161
 162 ;;; arch-tag: e0d91c7c-19a1-43d3-8f2b-28c0e031efaa
 163 ;;; uni-input.el ends here