code.delx.au - gnu-emacs/blob - 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-insert-char (char)
  70   (insert char)
  71   (move-overlay quail-overlay (overlay-start quail-overlay) (point)))
  72
  73 (defun ucs-input-method (key)
  74   (if (or buffer-read-only
  75           (and (/= key ?U) (/= key ?u)))
  76       (list key)
  77     (quail-setup-overlays nil)
  78     (ucs-input-insert-char key)
  79     (let ((modified-p (buffer-modified-p))
  80           (buffer-undo-list t)
  81           (input-method-function nil)
  82           (echo-keystrokes 0)
  83           (help-char nil)
  84           (events (list key))
  85           (str "    "))
  86       (unwind-protect
  87           (catch 'non-digit
  88             (progn
  89               (dotimes (i 4)
  90                 (let ((seq (read-key-sequence nil))
  91                       key)
  92                   (if (and (stringp seq)
  93                            (= 1 (length seq))
  94                            (setq key (aref seq 0))
  95                            (memq key '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?a
  96                                        ?b ?c ?d ?e ?f ?A ?B ?C ?D ?E ?F)))
  97                       (progn
  98                         (push key events)
  99                         (ucs-input-insert-char key))
 100                     (let ((last-command-char key)
 101                           (current-prefix-arg))
 102                       (condition-case err
 103                           (call-interactively (key-binding seq))
 104                         (quail-error (message "%s" (cdr err)) (beep))))
 105                     (quail-delete-region)
 106                     (throw 'non-digit (append (reverse events)
 107                                               (listify-key-sequence seq))))))
 108               (quail-delete-region)
 109               (let* ((n (string-to-number (apply 'string
 110                                                  (cdr (nreverse events)))
 111                                           16))
 112                      (c (decode-char 'ucs n))
 113                      (status (make-vector 9 nil)))
 114                 (if c
 115                     (list c)
 116                   (aset status 0 n)
 117                   (string-to-list (ccl-execute-on-string
 118                                    'utf-8-ccl-encode status ""))))))
 119         (quail-delete-overlays)
 120         (set-buffer-modified-p modified-p)
 121         (run-hooks 'input-method-after-insert-chunk-hook)))))
 122
 123 (defun ucs-input-activate (&optional arg)
 124   "Activate UCS input method.
 125 With arg, activate UCS input method if and only if arg is positive.
 126
 127 While this input method is active, the variable
 128 `input-method-function' is bound to the function `ucs-input-method'."
 129   (if (and arg
 130           (< (prefix-numeric-value arg) 0))
 131       (unwind-protect
 132           (progn
 133             (quail-hide-guidance)
 134             (quail-delete-overlays)
 135             (setq describe-current-input-method-function nil))
 136         (kill-local-variable 'input-method-function))
 137     (setq inactivate-current-input-method-function 'ucs-input-inactivate)
 138     (setq describe-current-input-method-function 'ucs-input-help)
 139     (quail-delete-overlays)
 140     (if (eq (selected-window) (minibuffer-window))
 141         (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
 142     (add-hook 'kill-buffer-hook 'quail-kill-guidance-buf nil t)
 143     (set (make-local-variable 'input-method-function)
 144          'ucs-input-method)))
 145
 146 (defun ucs-input-inactivate ()
 147   "Inactivate UCS input method."
 148   (interactive)
 149   (ucs-input-activate -1))
 150
 151 (defun ucs-input-help ()
 152   (interactive)
 153   (with-output-to-temp-buffer "*Help*"
 154     (princ "\
 155 Input method: ucs (mode line indicator:U)
 156
 157 Input as Unicode: U<hex> or u<hex>, where <hex> is a four-digit hex number.")))
 158
 159 ;; The file ../leim-ext.el contains the following call.
 160 ;; (register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+"
 161 ;;                     "Unicode input as hex in the form Uxxxx.")
 162
 163 (provide 'uni-input)
 164
 165 ;;; arch-tag: e0d91c7c-19a1-43d3-8f2b-28c0e031efaa
 166 ;;; uni-input.el ends here