code.delx.au - gnu-emacs/blob - leim/quail/uni-input.el

   1 ;;; uni-input.el --- Hex Unicode input method
   2
   3 ;; Copyright (C) 2001, 2003  Free Software Foundation, Inc.
   4 ;; Copyright (C) 2004
   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                     (let ((last-command-char key)
 104                           (current-prefix-arg))
 105                       (condition-case err
 106                           (call-interactively (key-binding seq))
 107                         (quail-error (message "%s" (cdr err)) (beep))))
 108                     (quail-delete-region)
 109                     (throw 'non-digit (append (reverse events)
 110                                               (listify-key-sequence seq))))))
 111               (quail-delete-region)
 112               (let* ((n (string-to-number (apply 'string
 113                                                  (cdr (nreverse events)))
 114                                           16))
 115                      (c (decode-char 'ucs n))
 116                      (status (make-vector 9 nil)))
 117                 (if c
 118                     (list c)
 119                   (aset status 0 n)
 120                   (string-to-list (ccl-execute-on-string
 121                                    'utf-8-ccl-encode status ""))))))
 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