leim/quail/uni-input.el

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