cgit.sxemacs.org Git - packages/blob - xemacs-packages/x-symbol/lisp/x-symbol-mule.el

   1 ;;; x-symbol-mule.el --- XEmacs/Mule support for package x-symbol
   2
   3 ;; Copyright (C) 1997-1999, 2001-2002 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Christoph Wedler <wedler@users.sourceforge.net>
   6 ;; Maintainer: (Please use `M-x x-symbol-package-bug' to contact the maintainer)
   7 ;; Version: 4.5
   8 ;; Keywords: WYSIWYG, LaTeX, HTML, wp, math, internationalization, Mule
   9 ;; X-URL: http://x-symbol.sourceforge.net/
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; if not, write to the Free Software
  23 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; If you want to use package x-symbol, please visit the URL (use
  28 ;; \\[x-symbol-package-web]) and read the info (use \\[x-symbol-package-info]).
  29
  30 ;;; Code:
  31
  32 ;; No `eval-and-compile' around this test, would just complicate distribution
  33 (unless (featurep 'mule)
  34   (error "This file is meant to be used with XEmacs/Mule"))
  35 (provide 'x-symbol-mule)
  36 (eval-when-compile (require 'cl))
  37 (require 'x-symbol-hooks)
  38 (eval-when-compile (require 'x-symbol-vars)) ; TODO: or always?  or next line?
  39 (eval-when-compile (require 'x-symbol)) ; x-symbol also requires this file
  40 ;;  (defvar x-symbol-cstring-table)     ; in x-symbol.el
  41 ;;  (defvar x-symbol-face-docstrings))
  42 ;;(require 'quail) has autoload
  43
  44 ;;(unless (eq x-symbol-default-coding 'iso-8859-1)
  45 ;;  (warn "Package x-symbol under XEmacs/Mule has only been tested with default coding `iso-8859-1'"))
  46
  47 ;; Provide easier XEmacs-21/Mule bug workaround:
  48 (defvar x-symbol-mule-default-charset
  49   (cond
  50    ((or (null x-symbol-default-coding)
  51         (eq x-symbol-default-coding 'iso-8859-1))
  52     'latin-iso8859-1)
  53    ;; XEmacs iso-2022 coding-system-type
  54    ((eq (coding-system-type x-symbol-default-coding) 'iso2022)
  55     (coding-system-property x-symbol-default-coding 'charset-g1))
  56    ;; Emacs iso-2022 coding-system-type
  57    ((eq (coding-system-type x-symbol-default-coding) 2)
  58     (aref (coding-system-flags x-symbol-default-coding) 1))
  59    (t
  60     (lwarn 'x-symbol 'warning
  61       "Can't determine charset from coding system %s, using latin-iso8859-1"
  62       x-symbol-default-coding)
  63     'latin-iso8859-1))
  64   "Mule charset corresponding to `x-symbol-default-coding'.")
  65
  66
  67 ;;;===========================================================================
  68 ;;;  Function aliases and internal variables
  69 ;;;===========================================================================
  70
  71 (defalias 'x-symbol-make-cset 'x-symbol-mule-make-cset)
  72 (defalias 'x-symbol-make-char 'x-symbol-mule-make-char)
  73 (defalias 'x-symbol-init-charsym-syntax 'x-symbol-mule-init-charsym-syntax)
  74 (defalias 'x-symbol-charsym-after 'x-symbol-mule-charsym-after)
  75 (defalias 'x-symbol-string-to-charsyms 'x-symbol-mule-string-to-charsyms)
  76 (defalias 'x-symbol-match-before 'x-symbol-mule-match-before)
  77 (defalias 'x-symbol-encode-lisp 'x-symbol-mule-encode-lisp)
  78 (defalias 'x-symbol-pre-command-hook 'x-symbol-mule-pre-command-hook)
  79 (defalias 'x-symbol-post-command-hook 'x-symbol-mule-post-command-hook)
  80 (defalias 'x-symbol-encode-charsym-after 'x-symbol-mule-encode-charsym-after)
  81 (defalias 'x-symbol-init-quail-bindings 'x-symbol-mule-init-quail-bindings)
  82
  83 (defvar x-symbol-mule-char-table nil
  84   "Internal.  Map characters to charsyms.")
  85 (defvar x-symbol-mule-pre-command nil
  86   "Internal.  Used for pre- and post-command handling.")
  87
  88
  89 ;;;===========================================================================
  90 ;;;  Init code
  91 ;;;===========================================================================
  92
  93 (defun x-symbol-mule-make-charset (definition graphic registry)
  94   "Define new charset according to DEFINITION.
  95 DEFINITION looks like nil or (NAME) or (NAME DOCSTRING CHARS FINAL), see
  96 `x-symbol-init-cset'.  GRAPHIC and REGISTRY are charset properties, see
  97 `make-charset' for details."
  98   (and definition
  99        (null (find-charset (car definition)))
 100        (make-charset (car definition) (cadr definition)
 101                      (list 'registry registry
 102                            'dimension 1
 103                            'chars (caddr definition)
 104                            'final (cadddr definition)
 105                            'graphic graphic))))
 106
 107 (defvar x-symbol-mule-default-font nil)
 108
 109 (defun x-symbol-mule-default-font ()
 110   ;; It would be probably better to set the font for all (device-list)s.  But
 111   ;; even better would be if XEmacs would allow an easy way to set fonts for
 112   ;; other charset-encodings without changing the font for the default
 113   ;; charset-encoding.  No using `append' instead `prepend' as HOW-TO-ADD is
 114   ;; loosing since then other settings might have preference.
 115   (or x-symbol-mule-default-font
 116       (setq x-symbol-mule-default-font
 117             (font-instance-name
 118              (face-property-instance 'default 'font (selected-device))))))
 119 ;;;      (let ((temp-buffer (get-buffer-create " x-symbol default font")))
 120 ;;;     (save-window-excursion
 121 ;;;       (display-buffer temp-buffer)
 122 ;;;       (sit-for 0.1)  ; necessary?
 123 ;;;       (setq x-symbol-mule-default-font
 124 ;;;             (font-instance-name (face-property-instance 'default 'font))))
 125 ;;;     (kill-buffer temp-buffer)
 126 ;;;     x-symbol-mule-default-font)))
 127
 128 (defun x-symbol-mule-make-cset (cset fonts)
 129   "Define new charsets according to CSET using FONTS.
 130 See `x-symbol-init-cset'.  Return (NORMAL SUBSCRIPT SUPERSCIPT).  Each
 131 element is a face or nil if the corresponding font in FONTS could not be
 132 found.  Return nil, if no default font for that registry could be found."
 133   (let ((first (if noninteractive
 134                    (caar fonts)
 135                  (x-symbol-try-font-name (car fonts)))))
 136     (when (or first
 137               (and x-symbol-latin-force-use (x-symbol-cset-coding cset))
 138               (and (find-charset (car (x-symbol-cset-left cset)))
 139                    (find-charset (car (x-symbol-cset-right cset)))))
 140       (let ((default (eq (x-symbol-cset-coding cset)
 141                          (or x-symbol-default-coding 'iso-8859-1)))
 142             (registry (x-symbol-cset-registry cset))
 143             (left (x-symbol-cset-left cset))
 144             (right (x-symbol-cset-right cset)))
 145         (x-symbol-mule-make-charset left 0 registry)
 146         (x-symbol-mule-make-charset right 1 registry)
 147         (or default
 148             (null first)
 149             noninteractive
 150             (not (fboundp 'face-property-matching-instance)) ;Only for XEmacs.
 151             (and (null x-symbol-mule-change-default-face)
 152                  (face-property-matching-instance 'default 'font
 153                                                   (or (car left) (car right))
 154                                                   nil nil t))
 155             (let ((origfont (x-symbol-mule-default-font)))
 156               (set-face-property 'default 'font first nil
 157                                  '(mule-fonts) 'prepend)
 158               ;; If we do not reset the originally default font, we end up
 159               ;; using a latin5 default font...
 160               (set-face-property 'default 'font origfont)))
 161         (if noninteractive
 162             (list nil)
 163           (let ((faces '(x-symbol-face x-symbol-sub-face x-symbol-sup-face))
 164                 (docstrings x-symbol-face-docstrings)
 165                 (raise 0)
 166                 font)
 167             (while faces
 168               (when (setq font (x-symbol-try-font-name (car fonts) raise))
 169                 (make-face (car faces) (car docstrings))
 170                 (x-symbol-set-face-font (car faces) font
 171                                         (list (car left) (car right))
 172                                         default))
 173               (setq fonts (cdr fonts)
 174                     raise (1+ raise)
 175                     faces (cdr faces)
 176                     docstrings (cdr docstrings))))
 177           (if first '(x-symbol-face) '(default)))))))
 178
 179 (defun x-symbol-mule-make-char (cset encoding charsym face coding)
 180   "Define character in CSET with ENCODING, represented by CHARSYM.
 181 The character is considered to be a 8bit character in CODING.  Use FACE
 182 when character is presented in the grid."
 183   (unless (char-table-p x-symbol-mule-char-table)
 184     (setq x-symbol-mule-char-table (make-char-table 'generic))
 185     (put-char-table t nil x-symbol-mule-char-table))
 186   (let* ((char (if (< encoding 128)
 187                    (make-char (caadr cset) encoding)
 188                  (make-char (caddr cset) (- encoding 128)))))
 189     (put-char-table char charsym x-symbol-mule-char-table)
 190     (x-symbol-set-cstrings charsym coding char
 191                            (and coding (>= encoding 160)
 192                                 (make-char x-symbol-mule-default-charset
 193                                            (- encoding 128)))
 194                            face)))
 195
 196 (defun x-symbol-mule-init-charsym-syntax (charsyms)
 197   "Initialize the syntax for the characters represented by CHARSYMS.
 198 See `x-symbol-init-cset' and `x-symbol-group-syntax-alist'."
 199   (dolist (charsym charsyms)
 200     (when (gethash charsym x-symbol-cstring-table)
 201       (let ((syntax (get charsym 'x-symbol-syntax)))
 202         (when syntax
 203           (let ((opposite (and (cdr syntax)
 204                                (gethash (cddr syntax) x-symbol-cstring-table))))
 205             (modify-syntax-entry (aref (gethash charsym x-symbol-cstring-table)
 206                                        0)
 207                                  (if opposite
 208                                      (format (cadr syntax) opposite)
 209                                    (car syntax))
 210                                  (standard-syntax-table))))))))
 211
 212 (defun x-symbol-mule-init-quail-bindings (context chain)
 213   (if context
 214       (quail-defrule (if (< (length context) (max x-symbol-key-min-length 2))
 215                          (concat context x-symbol-quail-suffix-string)
 216                        context)
 217                      (mapconcat (lambda (charsym)
 218                                   (gethash charsym x-symbol-cstring-table))
 219                                 chain ""))
 220     (quail-define-package
 221      "x-symbol" "X-Symbol" "XS" t
 222      "X-Symbol input method Quail, see <info:(x-symbol)Input Method Quail>"
 223      nil t                              ; FORGET-LAST-SELECTION
 224      nil nil nil nil t)))               ; MAXIMUM-SHORTEST
 225
 226
 227 ;;;===========================================================================
 228 ;;;  Character recognition
 229 ;;;===========================================================================
 230
 231 (defun x-symbol-mule-encode-charsym-after ()
 232   (get-char-table (char-after) x-symbol-mule-char-table))
 233
 234
 235 (defun x-symbol-mule-charsym-after (&optional pos)
 236   "Return x-symbol charsym for character at POS.
 237 POS defaults to point.  If POS is out of range, return nil.  Otherwise,
 238 return (POS . CHARSYM) where CHARSYM is the x-symbol charsym for the
 239 character at POS or nil otherwise."
 240   (or pos (setq pos (point)))
 241   (and (char-after pos)
 242        (cons pos (get-char-table (char-after pos) x-symbol-mule-char-table))))
 243
 244 (defun x-symbol-mule-string-to-charsyms (string)
 245   "Return list of charsyms for the characters in STRING.
 246 If a character is not represented as a charsym, use the character itself
 247 if is an ascii in the range \\040-\\176, otherwise nil."
 248   (let ((chars (nreverse (append string nil)))
 249         result after)
 250     (while chars
 251       (setq after (pop chars))
 252       (push (or (get-char-table after x-symbol-mule-char-table)
 253                 (and (<= ?\040 after) (< after ?\177) after))
 254             result))
 255     result))
 256
 257 (defun x-symbol-mule-match-before (atree pos &optional case-fn)
 258   "Return association in ATREE for longest match before POS.
 259 Return (START . VALUE) where the buffer substring between START and
 260 point is the key to the association VALUE in ATREE.  If optional CASE-FN
 261 is non-nil, convert characters before the current position with CASE-FN.
 262 See `x-symbol-atree-push'."
 263   (let ((result nil))
 264     (while (setq atree (cdr (assoc (if case-fn
 265                                        (funcall case-fn (char-after (decf pos)))
 266                                      (char-after (decf pos)))
 267                                    (cdr atree))))
 268       (and (car atree)
 269            (setq result (cons pos (car atree)))))
 270     result))
 271
 272
 273 ;;;===========================================================================
 274 ;;;  Command hooks
 275 ;;;===========================================================================
 276
 277 ;; Functions in these hooks are run twice (and more) when pressing a key which
 278 ;; runs a keyboard macro, e.g., if [backspace] runs [delete] and [delete] runs
 279 ;; `delete-backward-char'.
 280
 281 (defun x-symbol-mule-pre-command-hook ()
 282   "Function used in `pre-command-hook' when `x-symbol-mode' is turned on.
 283 Hide revealed characters, see `x-symbol-hide-revealed-at-point'.
 284 Provide input method TOKEN, see `x-symbol-token-input'."
 285   (x-symbol-hide-revealed-at-point)
 286   (when (and x-symbol-mode (null x-symbol-mule-pre-command))
 287     (setq x-symbol-mule-pre-command t)
 288     (x-symbol-token-input)))
 289
 290 (defun x-symbol-mule-post-command-hook ()
 291   "Function used in `post-command-hook' when `x-symbol-mode' is turned on.
 292 Provide input method ELECTRIC, see `x-symbol-electric-input'.  Start
 293 idle timer for info in echo area and revealing invisible characters, see
 294 `x-symbol-start-itimer-once'."
 295   (when (and x-symbol-mode x-symbol-mule-pre-command)
 296     (x-symbol-electric-input)
 297     (x-symbol-start-itimer-once))
 298   (setq x-symbol-mule-pre-command nil))
 299
 300 ;;; Local IspellPersDict: .ispell_xsymb
 301 ;;; x-symbol-mule.el ends here