leim/quail/uni-input.el

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