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

   1 ;;; x-symbol.el --- semi WYSIWYG for LaTeX, HTML, etc using additional fonts
   2
   3 ;; Copyright (C) 1995-2003 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.X
   8 ;; Keywords: WYSIWYG, LaTeX, HTML, wp, math, internationalization
   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 ;; This is the main file of package X-Symbol.  It also defines charsets for the
  31 ;; basic fonts: latin1, latin2, latin3, latin5, xsymb0 and xsymb1.
  32
  33 ;; This file does some initialization.  Thus, do not put any `defcustom'
  34 ;; commands into this file.  If you think some variables in this files should
  35 ;; be customized, move them to file `x-symbol-vars.el'.
  36
  37 ;;; Code:
  38
  39 (provide 'x-symbol)
  40 ;;(require 'x-symbol-hooks)
  41 (require 'x-symbol-vars)
  42 (require (if (featurep 'mule) 'x-symbol-mule 'x-symbol-nomule))
  43 (eval-when-compile (require 'x-symbol-macs))
  44 (eval-when-compile (require 'cl))
  45
  46 (eval-when-compile
  47   (defvar font-lock-extra-managed-props) ; font-lock of Emacs-21.4
  48   (defvar reporter-prompt-for-summary-p))
  49
  50 ;; CW: TODO
  51 (defvar x-symbol-trace-invisible nil)
  52 ;; shows that invisible is reset but Emacs still shows it as invisible
  53
  54 (defun-when-void put-display-table (range value display-table)
  55   "Set the value for char RANGE to VALUE in DISPLAY-TABLE.  "
  56   (if (sequencep display-table)
  57       (aset display-table range value)
  58     (put-char-table range value display-table)))
  59
  60 \f
  61 ;;;;##########################################################################
  62 ;;;;  General code, default values for `x-symbol-*-function'
  63 ;;;;##########################################################################
  64
  65
  66 ;;;===========================================================================
  67 ;;;  Token languages
  68 ;;;===========================================================================
  69
  70 (defconst x-symbol-language-access-alist
  71   `((x-symbol-LANG-auto-style "auto-style" t listp) ; redefinition, TODO: optional is just temporary
  72     (x-symbol-LANG-modeline-name "modeline-name" nil stringp)
  73     (x-symbol-LANG-required-fonts "required-fonts" t listp)
  74     (x-symbol-LANG-token-grammar "token-grammar" nil
  75                                  ,(lambda (x)
  76                                     (or (vectorp x)
  77                                         (eq (car-safe x)
  78                                             'x-symbol-make-grammar))))
  79     ;;(x-symbol-input-token-grammar "input-token-grammar" nil consp)
  80     (x-symbol-LANG-table "table" nil consp)
  81     (x-symbol-LANG-generated-data "generated-data" nil null)
  82     ;; input methods
  83     (x-symbol-LANG-header-groups-alist "header-groups-alist" nil listp)
  84     (x-symbol-LANG-class-alist "class-alist" nil listp)
  85     (x-symbol-LANG-class-face-alist "class-face-alist" t listp)
  86     (x-symbol-LANG-electric-ignore "electric-ignore")
  87     (x-symbol-LANG-extra-menu-items "extra-menu-items" t listp)
  88     ;; super-/subscripts, images
  89     (x-symbol-LANG-subscript-matcher "subscript-matcher" t)
  90     (x-symbol-LANG-image-keywords "image-keywords" t listp)
  91     (x-symbol-LANG-master-directory "master-directory"
  92                                     x-symbol-LANG-image-keywords
  93                                     functionp)
  94     (x-symbol-LANG-image-searchpath "image-searchpath"
  95                                     x-symbol-LANG-image-keywords
  96                                     listp)
  97     (x-symbol-LANG-image-cached-dirs "image-cached-dirs"
  98                                      x-symbol-LANG-image-keywords
  99                                      listp))
 100   "Alist of token language dependent variable accesses.
 101 OUTDATED.
 102 Each element looks like (ACCESS . SUFFIX) or (ACCESS MULE . NOMULE).
 103 With the first form, the symbol of the LANGUAGE dependent variable is
 104 `FEATURE-SUFFIX' where FEATURE is the value of LANGUAGE's symbol
 105 property `x-symbol-feature'.  With the second form, the symbol is
 106 `FEATURE-MULE' when running under XEmacs/Mule or `FEATURE-NOMULE' when
 107 running under XEmacs/no-Mule.  The symbol is stored as LANGUAGE's
 108 property ACCESS.  To get a value of a language dependent variable, use
 109 `x-symbol-language-value'.
 110
 111 The following language dependent access is defined after the language
 112 has been registered, see `x-symbol-register-language':
 113
 114  * `x-symbol-name': String naming the language when presented to the user.
 115
 116 The following language dependent accesses are defined after the language
 117 has been initialized, see `x-symbol-init-language':
 118
 119  * `x-symbol-modeline-name': String naming the language in the modeline.
 120  * `x-symbol-master-directory': Function returning the directory of the
 121    master file, see `x-symbol-image-parse-buffer'.
 122  * `x-symbol-image-searchpath': Search path used for implicitly relative
 123    image file names, see `x-symbol-image-use-remote'.
 124  * `x-symbol-image-cached-dirs': Directory parts of image file names
 125    stored in the memory cache, see `x-symbol-image-use-remote'.
 126  * `x-symbol-image-keywords': Keywords used to find image insertion
 127    commands, see `x-symbol-image-parse-buffer'.
 128  * `x-symbol-font-lock-keywords': font-lock keywords for super- and
 129    subscripts.
 130
 131  * `x-symbol-header-groups-alist': If non-nil, used instead
 132    `x-symbol-header-groups-alist' in the language specific grid/menu.
 133  * `x-symbol-class-alist': Alist used for the info in the echo area, see
 134    `x-symbol-character-info'.  Each element looks like (CLASS . SPEC)
 135    where CLASS is a valid token class, see `x-symbol-init-language' and
 136    SPEC is used according to `x-symbol-fancy-string'.  You should define
 137    entries for the CLASSes `VALID' and `INVALID'.
 138  * `x-symbol-class-face-alist': Alist used for the color scheme in the
 139    language dependent grid and token info.  Each element looks like
 140    (CLASS FACE . FACE-SPECS) where CLASS is a valid token class, FACE is
 141    used for the character in the grid, and FACE-SPECS is used according
 142    to `x-symbol-fancy-string'.
 143  * `x-symbol-electric-ignore': Language dependent version of
 144    `x-symbol-electric-ignore', see variable `x-symbol-electric-input'.
 145
 146  * `x-symbol-required-fonts': Features providing fonts.
 147  * `x-symbol-case-insensitive': If non-nil, tokens are case-insensitive.
 148    The non-nil value should be a function: `upcase' or `downcase'.
 149  * `x-symbol-token-shape': Used to (conditionally) prevent decoding
 150    tokens of the given shape.  Looks like
 151       (TOKEN-ESC TOKEN-REGEXP . LETTER-REGEXP)
 152    If TOKEN-ESC is non-nil, a token is not decoded if the character
 153    before token is TOKEN-ESC, TOKEN-ESC is allowed to appear exactly
 154    even times, though.  If non-nil, TOKEN-REGEXP matches tokens not to
 155    be decoded if LETTER-REGEXP matches the character after the token.
 156  * `x-symbol-table': Table defining the language, includes user table.
 157  * `x-symbol-token-list': The token specification in language tables are
 158    passed to this function, see `x-symbol-init-language'.
 159  * `x-symbol-input-token-ignore': Regexp or function used to \"hide\"
 160    some tokens from input method TOKEN.
 161  * `x-symbol-exec-specs': Specification used when building executables,
 162    t if no executables should be built, see `x-symbol-exec-create'.
 163
 164 The following internal language dependent accesses are defined after the
 165 language has been initialized, see `x-symbol-init-language':
 166
 167  * `x-symbol-menu-alist': Alist used for language dependent menu.
 168  * `x-symbol-grid-alist': Alist used for language dependent grid.
 169  * `x-symbol-decode-atree': Atree for used by `x-symbol-token-input'.
 170  * `x-symbol-decode-alist': Alist used during decoding.
 171  * `x-symbol-encode-alist': Alist used during encoding.
 172  * `x-symbol-decode-exec': File name of decode executable.  If this
 173    access is not present, no warning is issued, as opposed to value nil.
 174  * `x-symbol-encode-exec': File name of encode executable.  If this
 175    access is not present, no warning is issued, as opposed to value nil.")
 176
 177
 178 ;;;===========================================================================
 179 ;;;  Structure data types
 180 ;;;===========================================================================
 181
 182 (defstruct (x-symbol-generated
 183             (:type vector)
 184             (:constructor x-symbol-make-generated-data)
 185             (:copier nil))
 186   encode-table
 187   decode-obarray
 188   menu-alist
 189   grid-alist
 190   token-classes
 191   max-token-len)
 192
 193 (defstruct (x-symbol-grammar
 194             (:type vector)
 195             (:constructor x-symbol-make-grammar)
 196             (:copier nil))
 197   (case-function nil :read-only t)
 198   (encode-spec nil :read-only t)
 199   (decode-regexp (error "Must provide :decode-regexp") :read-only t)
 200   (decode-spec nil :read-only t)
 201   (token-list nil :read-only t)
 202   (after-init nil :read-only t)
 203   (input-regexp (concat "\\(?:" decode-regexp "\\)\\'") :read-only t)
 204   (input-spec (if (and (not (functionp decode-spec))
 205                        (equal decode-spec encode-spec))
 206                   encode-spec
 207                 (warn "Must provide :input-spec") ; TODO: `error'
 208                 encode-spec)
 209               :read-only t))
 210
 211
 212 ;;;===========================================================================
 213 ;;;  Internal variables used throughout the package
 214 ;;;===========================================================================
 215
 216 (defvar x-symbol-map nil
 217   "Keymap for x-symbol key sequences starting with \\[x-symbol-map].
 218 Set by `x-symbol-init-input'.")
 219
 220 (defvar x-symbol-unalias-alist nil
 221   "Internal.  Alist used to resolve character aliases.
 222 See `x-symbol-unalias'.")
 223
 224 (defvar x-symbol-latin-decode-alists nil
 225   "Internal.  Alist used during decoding to handle different file codings.
 226 Used if `x-symbol-coding' differs from `x-symbol-default-coding'.")
 227
 228 (defvar x-symbol-context-atree nil
 229   "Internal.  Atree used by input method context.
 230 See `x-symbol-modify-key'.")
 231
 232 (defvar x-symbol-electric-atree nil
 233   "Internal.  Atree used by `x-symbol-electric-input'.")
 234
 235 (defvar x-symbol-grid-alist nil
 236   "Internal.  Alist containing the global grid.")
 237
 238 (defvar x-symbol-menu-alist nil
 239   "Internal.  Alist containing the global submenus for insert commands.")
 240
 241 (defvar x-symbol-all-charsyms nil
 242   "Internal.  List of all defined charsyms in order of definition.
 243 Symbol property `x-symbol-decode-alist' is a cache {symbol-name->symbol}
 244 used by `x-symbol-read-token'.")
 245
 246 (defvar x-symbol-fancy-value-cache nil
 247   "Internal.  Cache for `x-symbol-fancy-value'.")
 248
 249 ;; encoding -> charsym-for-char-in-encoding-cset -> char-in-default-cset
 250 (defvar x-symbol-fchar-tables nil)
 251
 252 ;; encoding -> charsym-for-char-in-encoding-cset -> char-in-encoding-cset (string in nomule)
 253 (defvar x-symbol-bchar-tables nil)
 254
 255 (defvar x-symbol-cstring-table nil)
 256
 257 (defvar x-symbol-fontified-cstring-table nil)
 258
 259 (defvar x-symbol-charsym-decode-obarray nil)
 260
 261
 262 ;;;===========================================================================
 263 ;;;  General functions
 264 ;;;===========================================================================
 265
 266 (defun x-symbol-set-variable (var value)
 267   "Set VAR's value to VALUE, using special set functions.
 268 If VAR has a symbol property `x-symbol-set-function', use that function
 269 instead `set' to set the value.  At the end, run each hook in the symbol
 270 property `x-symbol-after-set-hook' of VAR."
 271   (if (get var 'x-symbol-set-function)
 272       (funcall (get var 'x-symbol-set-function) var value)
 273     (if (and (get var 'custom-type)
 274              (null (local-variable-if-set-p var (current-buffer))))
 275         (customize-set-variable var value)
 276       (set var value)))
 277   (let ((hook (get var 'x-symbol-after-set-hook)))
 278     (while hook (funcall (pop hook)))))
 279
 280 (defun x-symbol-ensure-hashtable (symbol)
 281   "Make sure that SYMBOL's value is a hashtable.
 282 The initial size of the key-weak hashtable is `x-symbol-cache-size'."
 283   (or (hash-table-p (symbol-value symbol))
 284       (set symbol (make-hash-table :size x-symbol-cache-size
 285                                    :test 'eq :weakness 'key))))
 286
 287 (defun x-symbol-puthash (key val hashtable)
 288   "Hash KEY to VAL in HASHTABLE.  Return VAL.
 289 Flush HASHTABLE, i.e., delete all entries before, if number of entries
 290 would become larger than `x-symbol-cache-size'."
 291   (if (>= (hash-table-count hashtable) x-symbol-cache-size)
 292       (clrhash hashtable))
 293   (puthash key val hashtable))
 294
 295 (defun x-symbol-call-function-or-regexp (callee string &rest args)
 296   "Check STRING by calling function or matching a regexp.
 297 If CALLEE is a function, call function with first argument STRING and
 298 rest ARGS.  If it is a string, return index of start of first match for
 299 CALLEE in STRING."
 300   (if (stringp callee)
 301       (string-match callee string)
 302     (if (fboundp callee) (apply callee string args))))
 303
 304 (defun x-symbol-match-in-alist (elem alist &optional result replacep)
 305   "Check ALIST for element whose car is a regexp matching elem.
 306 Return cdr of matching element or RESULT if the cdr is nil.  If REPLACEP
 307 is non-nil and the cdr is a string, replace text matched by the car with
 308 the cdr and return result, see `replace-match' for details.  If REPLACEP
 309 is non-nil and the cdr is a non-empty list, call the car of the cdr with
 310 ELEM and the remaining arguments in the cdr of the cdr to get the
 311 result."
 312   (let (match)
 313     (while alist
 314       (if (string-match (caar alist) elem)
 315           (setq result (cdar alist)
 316                 match t
 317                 alist nil)
 318         (setq alist (cdr alist))))
 319     (if (and replacep match)
 320         (cond ((stringp result) (replace-match result t nil elem))
 321               ((consp result) (apply (car result) elem (cdr result)))
 322               (t result))
 323       result)))
 324
 325
 326 ;;;===========================================================================
 327 ;;;  Strings with properties (inclusive. caching)
 328 ;;;===========================================================================
 329 ;; both Emacs and XEmacs fail with properties & `format': XEmacs drops the
 330 ;; properties, Emacs does it wrong, i.e., keeps the original positions in the
 331 ;; format string
 332
 333 (defun x-symbol-fancy-string (spec)
 334   "Return a \"fancy\" string according to SPEC.
 335 SPEC has the form (STRING FACE-SPEC...).  Return a copy of STRING
 336 annotated with faces as duplicatable text properties.  FACE-SPEC has the
 337 form ([START [END]] FACE...).  All characters between START and END are
 338 attached with FACEs.  START and END can be positive numbers, denoting
 339 string positions, negative numbers, denoting positions from the end, and
 340 default to 0 or the end of the string, respectively."
 341   (if (cdr spec)
 342       (let* ((string (copy-sequence (pop spec)))
 343              (len (length string))
 344              faces start end)
 345         (while spec
 346           (setq faces (pop spec))
 347           (setq start (if (numberp (car faces)) (pop faces) 0)
 348                 end (if (numberp (car faces)) (pop faces) len))
 349           (put-text-property (if (natnump start) start (+ len start))
 350                              (if (natnump end) end (+ len end))
 351                              'face faces string))
 352         string)
 353     (car spec)))
 354
 355 (defun x-symbol-fancy-value (symbol &optional string-fn)
 356   "Return the \"fancy\" value of variable SYMBOL.
 357 If the value is not cached in SYMBOL's property `x-symbol-fancy-value',
 358 pass SYMBOL's value SPEC to `x-symbol-fancy-string', caching the result.
 359 If STRING-FN is non-nil, the STRING part of SPEC is passed to function
 360 STRING-FN before."
 361   (or (hash-table-p x-symbol-fancy-value-cache)
 362       (setq x-symbol-fancy-value-cache
 363             (make-hash-table :size x-symbol-fancy-cache-size :test 'eq)))
 364   (or (gethash symbol x-symbol-fancy-value-cache)
 365       (puthash symbol
 366                (let ((spec (symbol-value symbol)))
 367                  (x-symbol-fancy-string
 368                   (if string-fn
 369                       (cons (funcall string-fn (car spec)) (cdr spec))
 370                     spec)))
 371                x-symbol-fancy-value-cache)))
 372
 373
 374 (defun x-symbol-fancy-associations (symbols spec-alist pre sep post
 375                                             &optional default)
 376   "Return all \"fancy\" associations for SYMBOLS in SPEC-ALIST.
 377 SPEC-ALIST should have elements which look like (SYMBOL . SPEC).
 378 Collect all SPECs whose SYMBOL is a element in SYMBOLS or is equal to
 379 DEFAULT when no SPEC can be collected.
 380
 381 If SPECs is nil, concat the fancy value of PRE with all fancy strings of
 382 SPECs separated by the fancy value of SEP, and the fancy value of POST,
 383 see `x-symbol-fancy-string' and `x-symbol-fancy-value'."
 384   (let (spec result)
 385     (while symbols
 386       (and (setq spec (cdr (assq (pop symbols) spec-alist)))
 387            (push spec result)))
 388     (and (null result)
 389          (setq spec (cdr (assq default spec-alist)))
 390          (setq result (list spec)))
 391     (when result
 392       (concat (x-symbol-fancy-value pre)
 393               (mapconcat 'x-symbol-fancy-string
 394                          (nreverse result)
 395                          (x-symbol-fancy-value sep))
 396               (x-symbol-fancy-value post)))))
 397
 398
 399 ;;;===========================================================================
 400 ;;;  Tiny x-symbol specific functions
 401 ;;;===========================================================================
 402
 403 (defun x-symbol-language-value (access &optional language)
 404   "Return value of language dependent variable accessed by ACCESS.
 405 LANGUAGE defaults to `x-symbol-language'.  If necessary, load file
 406 providing the token language and initialize language.  For supported
 407 accesses, see `x-symbol-language-access-alist'."
 408   (or language (setq language x-symbol-language))
 409   (let ((symbol (get language access)))
 410     (if symbol (symbol-value symbol)
 411       (and language
 412            (null (get language 'x-symbol-initialized))
 413            (or (x-symbol-init-language language)
 414                (warn "Illegal X-Symbol token language `%s'" language))
 415            (symbol-value (get language access))))))
 416
 417 (defun x-symbol-charsym-face (charsym language)
 418   "Return face and face specs for CHARSYM in LANGUAGE.
 419 The returned value is (FACE . FACE-SPECS) where FACE is used for the
 420 grid and FACE-SPECS for the token in the info.  For the format of
 421 FACE-SPECS, see `x-symbol-fancy-string'.  The value depends on the first
 422 token class and the language access `x-symbol-LANG-class-face-alist'."
 423   (cdr (assq (car (gethash charsym
 424                            (x-symbol-generated-token-classes
 425                             (x-symbol-language-value
 426                              'x-symbol-LANG-generated-data language))))
 427              (x-symbol-language-value 'x-symbol-LANG-class-face-alist
 428                                       language))))
 429
 430 (defun x-symbol-image-available-p ()
 431   "Non-nil, if `x-symbol-image' can be set in current file."
 432   (and (x-symbol-language-value 'x-symbol-LANG-image-keywords)
 433        (null (file-remote-p default-directory))))
 434
 435 (defun x-symbol-default-context-info-ignore (context charsym)
 436   "Non-nil, if no info in the echo area should be shown for CONTEXT.
 437 The CONTEXT would be modified to the character represented by CHARSYM.
 438 Return non-nil, if the group of CHARSYM is a member of
 439 `x-symbol-context-info-ignore-groups' or the context is shorter than
 440 `x-symbol-context-info-threshold' or the context is matched by
 441 `x-symbol-context-info-ignore-regexp'.  This function is the default
 442 value for `x-symbol-context-info-ignore'."
 443   (or (memq (car (get charsym 'x-symbol-grouping))
 444             x-symbol-context-info-ignore-groups)
 445       (< (length context) x-symbol-context-info-threshold)
 446       (and x-symbol-context-info-ignore-regexp
 447            (string-match x-symbol-context-info-ignore-regexp context))))
 448
 449 (defun x-symbol-default-info-keys-keymaps (&optional dummy)
 450   ;; checkdoc-params: (dummy)
 451   "Used in keys info for not showing the prefix \\[x-symbol-map].
 452 Used as the default value for `x-symbol-info-keys-keymaps'."
 453   ;; probably just `x-symbol-map' with Emacs-20.4
 454   (list x-symbol-map))
 455
 456
 457 ;;;===========================================================================
 458 ;;;  Get Valid charsyms
 459 ;;;===========================================================================
 460
 461 (defun x-symbol-alias-charsym (pos+charsym)
 462   "Charsym of character alist, nil for other characters.
 463 If the character after the `car' of POS+CHARSYM is a character alias,
 464 return the `cdr' of POS+CHARSYM."
 465   (and (car pos+charsym)
 466        (not (eq (char-after (car pos+charsym))
 467                 (aref (gethash (cdr pos+charsym) x-symbol-cstring-table) 0)))
 468        (cdr pos+charsym)))
 469
 470 (defun x-symbol-default-valid-charsym (charsym &optional language)
 471   "Non-nil, if CHARSYM is valid in LANGUAGE.
 472 If LANGUAGE is non-nil or `x-symbol-mode' is on, CHARSYM must represent
 473 a token in LANGUAGE which defaults to `x-symbol-language'.  Otherwise,
 474 it should be a 8bit character according to `x-symbol-coding'.
 475 If LANGUAGE is non-nil, the result looks like (TOKEN . MISC)."
 476   (if (or language (and x-symbol-mode x-symbol-language))
 477       (and (or language
 478                (null x-symbol-coding)   ; default coding
 479                (assq x-symbol-coding x-symbol-fchar-tables) ; valid coding
 480                (not (gethash charsym    ; not a 8bit char in default coding
 481                              (cdr (assq (x-symbol-buffer-coding)
 482                                         x-symbol-fchar-tables)))))
 483            (gethash charsym (x-symbol-generated-encode-table
 484                              (x-symbol-language-value
 485                               'x-symbol-LANG-generated-data
 486                               (or language x-symbol-language)))))
 487     (gethash charsym (cdr (assq (or (x-symbol-buffer-coding)
 488                                     x-symbol-default-coding
 489                                     'iso-8859-1)
 490                                 x-symbol-fchar-tables)))))
 491
 492 (defun x-symbol-next-valid-charsym (charsym direction &optional prop tried)
 493   "Return a valid charsym starting with CHARSYM.
 494 Try CHARSYM first, if it is not valid, use CHARSYM's property PROP.  If
 495 DIRECTION is not t, charsym must have a rotate aspect direction with
 496 value DIRECTION.  Do not try to use charsyms in TRIED.  See
 497 `x-symbol-valid-charsym-function'."
 498   (let ((line (and (consp charsym) (prog1 (cdr charsym)
 499                                      (setq charsym (car charsym))))))
 500     (while (and charsym
 501                 (if (memq charsym tried)
 502                     (setq charsym nil)
 503                   (push charsym tried))
 504                 (not (and (gethash charsym x-symbol-cstring-table) ; CW: nec?
 505                           (funcall x-symbol-valid-charsym-function charsym)
 506                           (or (eq direction t)
 507                               (eq (plist-get
 508                                    (cdr (get charsym 'x-symbol-rotate-aspects))
 509                                    'direction)
 510                                   direction)))))
 511       (if line
 512           (setq charsym (car line)
 513                 line (cdr line))
 514         (if (consp (setq charsym (get charsym prop)))
 515             (setq line (cdr charsym)
 516                   charsym (car charsym)))))
 517     charsym))
 518
 519 (defun x-symbol-valid-context-charsym (atree &optional prop)
 520   "Return first valid charsym for longest context match before point.
 521 Return (START . CHARSYM) where the buffer substring between START and
 522 point is the key to the association VALUE in ATREE, see also
 523 `x-symbol-match-before'.  CHARSYM is the VALUE or the next valid charsym
 524 using PROP, see `x-symbol-next-valid-charsym'."
 525   (let* ((pos+charsym (x-symbol-match-before atree (point)))
 526          (charsym (and (cdr pos+charsym)
 527                        (x-symbol-next-valid-charsym (cdr pos+charsym) t prop))))
 528     (and charsym (cons (car pos+charsym) charsym))))
 529
 530 (defun x-symbol-next-valid-charsym-before (prop1 prop2)
 531   "Return next valid charsym for character before point.
 532 Return (POS . CHARSYM) where POS is usually the point position.  If
 533 character is an character alias, resolve it.  Otherwise, try chain
 534 according to PROP1, then use the OPPOSITE of the character, see
 535 `x-symbol-init-cset', then try chain according to PROP2."
 536   (let* ((pos+charsym (x-symbol-charsym-after (1- (point))))
 537          (charsym (cdr pos+charsym)))
 538     (and charsym
 539          (setq charsym (or (x-symbol-alias-charsym pos+charsym)
 540                            (x-symbol-next-valid-charsym
 541                             (get charsym prop1) t prop1 (list charsym))
 542                            (x-symbol-next-valid-charsym
 543                             (caddr (get charsym 'x-symbol-grouping)) t
 544                             'x-symbol-modify-to (list charsym))
 545                            (x-symbol-next-valid-charsym
 546                             (get charsym prop2) t prop2 (list charsym))))
 547          (cons (car pos+charsym) charsym))))
 548
 549
 550 ;;;===========================================================================
 551 ;;;  Text functions
 552 ;;;===========================================================================
 553
 554 (defun x-symbol-prefix-arg-texts (arg)
 555   "Return texts for prefix argument ARG."
 556   (if (consp arg)
 557       '("token" . "once")
 558     (cons (if (natnump (setq arg (prefix-numeric-value arg)))
 559               "valid character"
 560             "character")
 561           (if (= (abs arg) 1) "once" (format "%d times" (abs arg))))))
 562
 563 (defun x-symbol-region-text (&optional long)
 564   "Return \"Region\", \"Buffer\" or \"Narrowed Part\".
 565 When non-nil, use format string FORMAT."
 566   (cond ((region-active-p) "Region")
 567         ((and (= (point-min) 1) (= (point-max) (1+ (buffer-size))))
 568          "Buffer")
 569         (long "Buffer/narrowed")
 570         (t "Buffer/n")))
 571
 572 (defun x-symbol-language-text (&optional format language)
 573   "Return text for LANGUAGE, to be presented to the user.
 574 LANGUAGE defaults to `x-symbol-language'.  If LANGUAGE is nil, return
 575 `x-symbol-charsym-name'.  When non-nil, use format string FORMAT."
 576   (let ((text (or (x-symbol-language-value 'x-symbol-LANG-name language)
 577                   x-symbol-charsym-name)))
 578     (if format (format format text) text)))
 579
 580 (defun x-symbol-coding-text (coding &optional coding2 format)
 581   "Return text for coding, to be presented to the user.
 582 Use association in `x-symbol-coding-name-alist' if `x-symbol-8bits' is
 583 non-nil, \"Ascii\" otherwise.  If both CODING1 and CODING2 are provided
 584 use format FORMAT with the associations for CODING1 and CODING2,
 585 otherwise just return text for CODING1."
 586   (if format
 587       (if (or (null (and coding coding2)) (eq coding coding2))
 588           ""
 589         (format format
 590                 (x-symbol-coding-text coding)
 591                 (x-symbol-coding-text coding2)))
 592     (or (cdr (assq (or coding (x-symbol-buffer-coding))
 593                    x-symbol-coding-name-alist))
 594         "Ascii")))
 595
 596 ;;;(defvar x-symbol-unsupported-coding-modeline-alist nil)
 597
 598 (defun x-symbol-language-modeline-text (language)
 599   "Return text for LANGUAGE, to be presented in the modeline."
 600   (if language
 601       (x-symbol-language-value 'x-symbol-LANG-modeline-name language)
 602     x-symbol-charsym-modeline-name))
 603
 604 (defun x-symbol-coding-modeline-text (coding)
 605   "Return text for CODING, to be used in the modeline.
 606 Use association in `x-symbol-coding-modeline-alist' if CODING differs
 607 from `x-symbol-default-coding', \"\" otherwise."
 608   (let ((buffer-coding (x-symbol-buffer-coding)))
 609     (cdr (assq (cond ((null buffer-coding)
 610                       (if x-symbol-8bits 'error (if coding 'info 'none)))
 611                      ((or (null coding) (eq coding buffer-coding))
 612                       (if (eq buffer-coding x-symbol-default-coding)
 613                           'same
 614                         buffer-coding))
 615                      ((and (eq buffer-coding x-symbol-default-coding)
 616                            (assq coding x-symbol-fchar-tables))
 617                       coding)
 618                      (t
 619                       (if x-symbol-8bits 'error 'info)))
 620                x-symbol-coding-modeline-alist))))
 621 ;;;  (and (setq coding (and (boundp coding) (symbol-value coding)))
 622 ;;;       (null (eq coding x-symbol-default-coding))
 623 ;;;       (let ((string (cdr (assq coding x-symbol-coding-modeline-alist))))
 624 ;;;      (if (assq coding x-symbol-fchar-tables)
 625 ;;;          string
 626 ;;;        (format x-symbol-coding-modeline-warning-format (or string ""))))))
 627
 628 ;;;       (let ((string (assq coding x-symbol-coding-modeline-alist)))
 629 ;;;      (if (assq coding x-symbol-fchar-tables)
 630 ;;;          (cdr string)
 631 ;;;        (or string (setq coding 'error))
 632 ;;;        (or (cdr (assq coding x-symbol-unsupported-coding-modeline-alist))
 633 ;;;            (let ((fstring (copy-sequence
 634 ;;;                            (or (cdr (assq coding
 635 ;;;                                           x-symbol-coding-modeline-alist))
 636 ;;;                                "-err"))))
 637 ;;;              (put-text-property 0 (length fstring)
 638 ;;;                                 'face 'x-symbol-modeline-warning-face
 639 ;;;                                 fstring)
 640 ;;;              (push (cons coding fstring)
 641 ;;;                    x-symbol-unsupported-coding-modeline-alist)
 642 ;;;              fstring))))))
 643
 644
 645 ;;;===========================================================================
 646 ;;;  reftex support (could be useful otherwise, too)
 647 ;;;===========================================================================
 648
 649 ;;;###autoload
 650 (defun x-symbol-translate-to-ascii (string)
 651   "Translate STRING to an ascii string.
 652 Non-ascii characters in STRING are converted to charsyms.  Their ascii
 653 representation is determined by:
 654
 655  * If CHARSYM is a key in `x-symbol-charsym-ascii-alist', use its ASCII.
 656  * Charsym is defined in the table to have an ascii representation, see
 657    ASCII in `x-symbol-init-cset'.
 658  * Compute ascii representation according to the CHARSYM's GROUP,
 659    SUBGROUP and `x-symbol-charsym-ascii-groups'.
 660  * Use \"\" otherwise."
 661   (mapconcat (lambda (item)
 662                (if (characterp item)
 663                    (char-to-string item)
 664                  (let ((grouping (get item 'x-symbol-grouping)))
 665                    (or (cdr (assq item x-symbol-charsym-ascii-alist))
 666                        (cadddr grouping)
 667                        (and (memq (car grouping)
 668                                   x-symbol-charsym-ascii-groups)
 669                             (cadr grouping))))))
 670              (x-symbol-string-to-charsyms string)
 671              ""))
 672
 673
 674 ;;;===========================================================================
 675 ;;;  Key bindings
 676 ;;;===========================================================================
 677
 678
 679 ;;;===========================================================================
 680 ;;;  Package info / bug report
 681 ;;;===========================================================================
 682
 683 ;;;###autoload
 684 (defun x-symbol-package-web ()
 685   "Ask a WWW browser to load URL `x-symbol-package-url'."
 686   (interactive)
 687   (browse-url x-symbol-package-url)
 688   (message "Sent URL of package x-symbol to your web browser"))
 689
 690 ;;;###autoload
 691 (defun x-symbol-package-info ()
 692   "Read documentation for package X-Symbol in the info system."
 693   (interactive)
 694   (Info-goto-node "(x-symbol)"))
 695
 696 ;;;###autoload
 697 (defun x-symbol-package-bug (&optional arg)
 698   "Send a bug/problem report to the maintainer of package X-Symbol.
 699 Please try to contact person in `x-symbol-installer-address' first.
 700 Normal reports are sent without prefix argument ARG.
 701
 702 If you are sure that the problem cannot be solved locally, e.g., by
 703 contacting the person who has installed package X-Symbol, use prefix
 704 argument 2 to send the message to `x-symbol-maintainer-address'.
 705
 706 If your message has nothing to do with a problem or a bug, use prefix 9
 707 to send a short message to `x-symbol-maintainer-address'."
 708   (interactive "p")
 709   (or (= arg 9)
 710       (condition-case nil
 711           (progn (Info-goto-node "(x-symbol)Bug Reports") t)
 712         (error (setq arg 1) x-symbol-installer-address))
 713       (with-output-to-temp-buffer "*Help*"
 714         (beep)
 715         (set-buffer "*Help*")
 716         (princ "\
 717 The info files for package X-Symbol are not installed.
 718
 719 Please read the manual before contacting the maintainer of package
 720 X-Symbol.  If you want to send a bug/problem report or a question,
 721 please follow the instructions in the manual.
 722
 723 The manual is also available as an HTML document at the web page of
 724 package X-Symbol:
 725    ")
 726         (princ x-symbol-package-url)
 727         nil)
 728       (null (y-or-n-p "Send URL of package X-Symbol to your web browser? "))
 729       (x-symbol-package-web))
 730   (require 'reporter)
 731   (let ((reporter-prompt-for-summary-p t)) ;# dynamic
 732     ;; For some reasons, the package version in the subject line, which I
 733     ;; definitely want, is only inserted with value t.  Thus, I ignore user
 734     ;; wishes here.
 735     (reporter-submit-bug-report
 736      (or (unless (or (= arg 9) (= arg 2)) x-symbol-installer-address)
 737          x-symbol-maintainer-address)
 738      (concat "x-symbol " x-symbol-version)
 739      (unless (= arg 9)
 740        `(command-line-args x-symbol-auto-style-alist
 741                            x-symbol-default-coding
 742                            x-symbol-image-converter
 743                            ,@(and (featurep 'x-symbol-nomule)
 744                                   '(x-symbol-nomule-leading-faces-alist))
 745                            features)))))
 746
 747 ;;;###autoload
 748 (defun x-symbol-package-reply-to-report ()
 749   "Reply to a bug/problem report not using \\[x-symbol-package-bug]."
 750   (interactive)
 751   (insert "\
 752 Thank you for trying package X-Symbol.  If you have problems, please use
 753 `M-x x-symbol-package-bug' to contact the maintainer.  Do not assume
 754 that I remember the contents of your message (appended to this reply)...
 755 err, I have actually deleted it.")
 756   (goto-char (point-max))
 757   (when (get-buffer " *gnus article copy*")
 758     (newline)
 759     (insert-buffer " *gnus article copy*")))
 760
 761
 762 \f
 763 ;;;;##########################################################################
 764 ;;;;  Conversion, Minor Mode Control, Menu
 765 ;;;;##########################################################################
 766
 767
 768 (defvar x-symbol-encode-rchars 1
 769   "Internal variable.  Is always 1 with Mule support, 1 or 2 without.")
 770
 771
 772 ;;;===========================================================================
 773 ;;;  Conversion
 774 ;;;===========================================================================
 775
 776 (defun x-symbol-even-escapes-before-p (pos esc)
 777   (let ((even t))
 778     (while (eq (char-before pos) esc)
 779       (setq even (not even)
 780             pos (1- pos)))
 781     even))
 782
 783 ;;;###autoload
 784 (defun x-symbol-decode-region (beg end)
 785   "Decode all tokens between BEG and END.
 786 Make sure that X-Symbol characters are correctly displayed under
 787 XEmacs/no-Mule even when font-lock is disabled."
 788   (save-excursion
 789     (save-restriction
 790       (narrow-to-region beg end)
 791       (x-symbol-decode-all)
 792       ;; Is the following really necessary?  Anyway, it doesn't hurt...
 793       (unless (featurep 'mule) (x-symbol-nomule-fontify-cstrings))
 794       (point-max))))
 795
 796 ;;;###autoload
 797 (defun x-symbol-decode-all ()
 798   "Decode all tokens in buffer to characters.
 799 Use executables for decoding if buffer is larger than EXEC-THRESHOLD
 800 which defaults to `x-symbol-exec-threshold'.  Before decoding, decode
 801 8bit characters in CODING which defaults to `x-symbol-coding'."
 802   ;; Assumptions: ------------------------------------------------------------
 803   ;;  * Latin decode alists are ordered, see `x-symbol-init-latin-decoding'
 804   ;;  * No part of the association is a KEY in the conversion alists
 805   ;;  * Keys in conversion alists are ordered: long...short
 806   (let* ((grammar (x-symbol-language-value 'x-symbol-LANG-token-grammar))
 807          (decode-obarray (if x-symbol-language
 808                              (x-symbol-generated-decode-obarray
 809                               (x-symbol-language-value
 810                                'x-symbol-LANG-generated-data))))
 811          (buffer-coding (x-symbol-buffer-coding))
 812          (unique (and x-symbol-unique t)))
 813     ;; TODO: recheck.  Decode uniquely and do not decode to 8bit if current
 814     ;; coding is unknown, otherwise we would wrongly use the same char for a
 815     ;; token and an 8bit char in the file.  E.g., with latin1 as default and we
 816     ;; visit a tex file with latin9 encoding where both the euro character and
 817     ;; \textcurrency is used.  If you use XEmacs on Windows, there is no latin9
 818     ;; font and therefore no recoding would take place, i.e., you would see the
 819     ;; euro character as the currency character (as you would w/o X-Symbol).
 820     ;; But then it would be very bad if \textcurrency would be decoded to the
 821     ;; currency character.
 822     (when buffer-coding
 823       (let ((fchar-table (assq (or x-symbol-coding buffer-coding)
 824                                x-symbol-fchar-tables)))
 825         (if (eq buffer-coding x-symbol-default-coding)
 826             (let* ((case-fold-search nil)       ;#dynamic
 827                    (coding-alist (cdr (assq x-symbol-coding x-symbol-latin-decode-alists)))
 828                    from to)
 829               (while coding-alist
 830                 (setq from (caar coding-alist)
 831                       to   (cdar coding-alist)
 832                       coding-alist (cdr coding-alist))
 833                 (goto-char (point-min))
 834                 (while (search-forward from nil 'limit)
 835                   (replace-match to t t))))
 836           ;; TODO: unalias only with 8bit would be faster, but if done
 837           ;; interactively?
 838           (x-symbol-unalias nil nil buffer-coding)
 839           (or (null x-symbol-coding) (eq x-symbol-coding buffer-coding)
 840               (setq fchar-table nil)))
 841         (setq unique (if x-symbol-8bits
 842                          (if fchar-table
 843                              (and x-symbol-unique (cdr fchar-table))
 844                            ;; invalid coding w/ 8bit => unique
 845                            (cdr (assq buffer-coding x-symbol-fchar-tables)))
 846                        (and x-symbol-unique t)))))
 847     ;; the real decoding -----------------------------------------------------
 848     (when decode-obarray
 849       (let ((case-fold-search (x-symbol-grammar-case-function
 850                                grammar)) ;#dynamic
 851             (decode-spec (x-symbol-grammar-decode-spec grammar))
 852             (decode-regexp (x-symbol-grammar-decode-regexp grammar)))
 853         (goto-char (point-min))
 854         (if (functionp decode-spec)
 855             (funcall decode-spec decode-regexp decode-obarray unique)
 856           (x-symbol-decode-lisp decode-spec decode-regexp decode-obarray
 857                                 unique))))))
 858
 859 ;;;###autoload
 860 (defun x-symbol-decode-single-token (string)
 861   (when x-symbol-language
 862     (let ((token (symbol-value
 863                   (intern-soft string
 864                                (x-symbol-generated-decode-obarray
 865                                 (x-symbol-language-value
 866                                  'x-symbol-LANG-generated-data))))))
 867       (if token (gethash (car token) x-symbol-cstring-table)))))
 868
 869 (defun x-symbol-decode-lisp (contexts decode-regexp decode-obarray unique)
 870   (let ((case-fn (if (functionp case-fold-search) case-fold-search))
 871         (before-context (car contexts))
 872         (after-context (cdr contexts))
 873         charsym esc-char shape bad-regexp)
 874     (when (characterp before-context)
 875       (or (memq before-context '(?\ ?\t ?\n ?\r nil)) ; or warning?
 876           (setq esc-char before-context))
 877       (setq before-context nil))
 878     (or before-context after-context (setq contexts nil))
 879     ;; -----------------------------------------------------------------------
 880     (x-symbol-decode-for-charsym ((decode-regexp decode-obarray case-fn)
 881                                   token beg end)
 882         nil
 883       (cond ((x-symbol-decode-unique-test token unique))
 884             ((and esc-char (eq (char-before beg) esc-char)
 885                   (x-symbol-even-escapes-before-p (1- beg) esc-char)))
 886             ((not (and contexts (setq shape (cadr token))))
 887              (if (setq charsym (car token))
 888                  (replace-match (gethash charsym x-symbol-cstring-table) t t)))
 889             ((and (setq bad-regexp (assq shape after-context))
 890                   (not (memq (char-after) '(?\ ?\t ?\n ?\r nil)))
 891                   (looking-at (cdr bad-regexp))))
 892             ((and (setq bad-regexp (assq shape before-context))
 893                   (not (memq (char-before beg) '(?\ ?\t ?\n ?\r nil)))
 894                   (string-match (cdr bad-regexp)
 895                                 (char-to-string (char-before beg)))))
 896             ((setq charsym (car token))
 897              (insert-before-markers (gethash charsym x-symbol-cstring-table))
 898              (delete-region beg end))))))
 899
 900 ;;;###autoload
 901 (defun x-symbol-encode-string (string buffer)
 902   (save-excursion
 903     (set-buffer (get-buffer-create " x-symbol string conversion"))
 904     (erase-buffer)
 905     (insert string)
 906     (x-symbol-inherit-from-buffer buffer)
 907     ;;(setq x-symbol-mode t)            ; not needed
 908     (x-symbol-encode-all)
 909     (buffer-string)))
 910
 911 ;;;###autoload
 912 (defun x-symbol-encode-all (&optional buffer start end)
 913   "Encode all characters in buffer to tokens.
 914 Use executables for decoding if buffer is larger than EXEC-THRESHOLD
 915 which defaults to `x-symbol-exec-threshold'.  If CODING is non-nil, do
 916 not encode 8bit characters in CODING.  Otherwise, do not encode 8bit
 917 characters in `x-symbol-coding' or `x-symbol-default-coding' if
 918 `x-symbol-8bits' is non-nil.  If BUFFER is non-nil, copy contexts
 919 between START and END to BUFFER, make BUFFER current and do conversion
 920 there.  If BUFFER is non-nil, START and END must be buffer positions or
 921 START is a string, see kludgy feature of `write-region'."
 922   (let ((grammar (x-symbol-language-value 'x-symbol-LANG-token-grammar))
 923         (encode-table (x-symbol-generated-encode-table
 924                        (x-symbol-language-value
 925                         'x-symbol-LANG-generated-data)))
 926         (buffer-coding (x-symbol-buffer-coding))
 927         (coding (if x-symbol-coding
 928                     (if (assq x-symbol-coding x-symbol-fchar-tables)
 929                         x-symbol-coding
 930                       t)))
 931         (store8 x-symbol-8bits))
 932     (if buffer
 933         (if start
 934             (let ((curr-buffer (current-buffer)))
 935               (if (featurep 'mule)
 936                   (let ((coding-system buffer-file-coding-system))
 937                     (set-buffer buffer)
 938                     (setq buffer-file-coding-system coding-system))
 939                 (set-buffer buffer))
 940               (x-symbol-set-buffer-multibyte)
 941               (if write-region-annotations-so-far
 942                   (format-insert-annotations write-region-annotations-so-far
 943                                              start))
 944               (if (stringp start)
 945                   (insert start)        ; kludgy feature of `write-region'
 946                 (insert-buffer-substring curr-buffer start end))
 947               ;;(set-text-properties (point-min) (point-max) nil)
 948               (map-extents (lambda (e dummy) (delete-extent e) nil)))
 949           (if (featurep 'mule)          ; TODO: should be done by format.el
 950               (let ((coding-system buffer-file-coding-system))
 951                 (set-buffer buffer)
 952                 (setq buffer-file-coding-system coding-system))
 953             (set-buffer buffer))))
 954     ;;    (set-buffer buffer)))
 955     ;; format.el should now set multibyte itself, we'll see
 956     ;;    (x-symbol-set-buffer-multibyte)))
 957     ;; the encoding ----------------------------------------------------------
 958     (let* ((case-fold-search (x-symbol-grammar-case-function grammar)) ;#dynamic
 959            (encode-spec (x-symbol-grammar-encode-spec grammar))
 960            (fchar-fb-table (cdr (if buffer-coding
 961                                     (if (eq buffer-coding x-symbol-default-coding) ; should always be the case for non-mule
 962                                         (or (assq coding x-symbol-fchar-tables) ; valid specified coding
 963                                             (assq buffer-coding x-symbol-fchar-tables)) ; invalid coding or not specified
 964                                       (assq buffer-coding x-symbol-bchar-tables))
 965                                   (assq (or x-symbol-default-coding 'iso-8859-1)
 966                                         x-symbol-fchar-tables))))
 967            (fchar-table (if store8 fchar-fb-table)))
 968       (goto-char (point-min))
 969       (if (functionp encode-spec)
 970           (funcall encode-spec encode-table fchar-table fchar-fb-table)
 971         (x-symbol-encode-lisp encode-spec encode-table
 972                               fchar-table fchar-fb-table)))))
 973
 974 (defun x-symbol-encode-lisp (contexts encode-table fchar-table fchar-fb-table)
 975   (let ((before-context (car contexts))
 976         (after-context (cdr contexts))
 977         esc-char shape bad-regexp)
 978     (when (characterp before-context)
 979       (or (memq before-context '(?\ ?\t ?\n ?\r nil)) ; or warning?
 980           (setq esc-char before-context))
 981       (setq before-context nil))
 982     (or before-context after-context (setq contexts nil))
 983
 984     (x-symbol-encode-for-charsym ((encode-table fchar-table fchar-fb-table)
 985                                   token)
 986       (and esc-char (eq (char-before) esc-char)
 987            (x-symbol-even-escapes-before-p (1- (point)) esc-char)
 988            (insert ?\ ))
 989       (if (not (and contexts (setq shape (cdr token))))
 990           (progn
 991             (insert (car token))
 992             (delete-char x-symbol-encode-rchars))
 993         (and (setq bad-regexp (assq shape before-context))
 994              (not (memq (char-before) '(?\ ?\t ?\n ?\r nil)))
 995              (string-match (cdr bad-regexp) (char-to-string (char-before)))
 996              (insert ?\ ))
 997         (insert (car token))
 998         (delete-char x-symbol-encode-rchars)
 999         (and (setq bad-regexp (assq shape after-context))
1000              (not (memq (char-after) '(?\ ?\t ?\n ?\r nil)))
1001              (looking-at (cdr bad-regexp))
1002              (insert-before-markers " "))))))
1003
1004
1005 ;;;===========================================================================
1006 ;;;  Interactive conversion
1007 ;;;===========================================================================
1008
1009 ;;;###autoload
1010 (defun x-symbol-decode-recode (&optional beg end interactive-flag)
1011   "Decode all tokens in active region or buffer to characters.
1012 If called interactively and if the region is active, BEG and END are the
1013 boundaries of the region.  BEG and END default to the buffer boundaries.
1014 8bit characters are treated according to `x-symbol-coding'.  See also
1015 commands `x-symbol-encode' and `x-symbol-mode'.
1016
1017 Note that in most token languages, different tokens might be decoded to
1018 the same character, e.g., \\neq and \\ne in `tex', &Auml\; and &#196\;
1019 in `sgml', see `x-symbol-unique'!"
1020   (interactive (and (region-active-p) (list (region-beginning) (region-end))))
1021   (unless x-symbol-language
1022     (error "No token language which can be used for decoding"))
1023   (or beg (setq beg (point-min)))
1024   (or end (setq end (point-max)))
1025   (save-excursion
1026     (save-restriction
1027       (narrow-to-region beg end)
1028       (let ((first-change-hook nil) ; no `flyspell-mode' here
1029             (after-change-functions nil)) ; no fontification!
1030         (x-symbol-decode-all))
1031       (if font-lock-mode (x-symbol-fontify (point-min) (point-max)))))
1032   (if (or interactive-flag (interactive-p))
1033       (message "%sDecoded %s to Character in %s"
1034                (x-symbol-coding-text x-symbol-coding x-symbol-default-coding
1035                                      "Recoded %s to %s, ")
1036                (x-symbol-language-text)
1037                (x-symbol-region-text t))))
1038
1039 ;;;###autoload
1040 (defun x-symbol-decode (&optional beg end)
1041   "Decode all tokens in active region or buffer to characters.
1042 As opposed to `x-symbol-decode-recode', this function performs no
1043 recoding, i.e., `x-symbol-coding' is considered to have the value of
1044 `x-symbol-default-coding'."
1045   (interactive (and (region-active-p) (list (region-beginning) (region-end))))
1046   (if (or (null x-symbol-coding)
1047           (eq x-symbol-coding x-symbol-default-coding))
1048       (x-symbol-decode-recode beg end t)
1049     (let ((x-symbol-coding (or x-symbol-default-coding t)))
1050       (x-symbol-decode-recode beg end t))))
1051
1052 ;;;###autoload
1053 (defun x-symbol-encode-recode (&optional beg end interactive-flag)
1054   "Encode all characters in active region or buffer to tokens.
1055 If called interactively and if the region is active, BEG and END are the
1056 boundaries of the region.  BEG and END default to the buffer boundaries.
1057 Variables `x-symbol-8bits' and `x-symbol-coding' determine whether to
1058 encode 8bit characters.  See also commands `x-symbol-decode' and
1059 `x-symbol-mode'."
1060   (interactive (and (region-active-p) (list (region-beginning) (region-end))))
1061   (unless x-symbol-language
1062     (error "No token language which can be used for encoding"))
1063   (or beg (setq beg (point-min)))
1064   (or end (setq end (point-max)))
1065   (save-excursion
1066     (save-restriction
1067       (narrow-to-region beg end)
1068       (let ((first-change-hook nil)     ; no `flyspell-mode' here
1069             (after-change-functions nil)) ; no fontification!
1070         (x-symbol-encode-all))
1071       (if font-lock-mode (x-symbol-fontify (point-min) (point-max)))))
1072   (if (or interactive-flag (interactive-p))
1073       (message "Encoded Non-%s to %s in %s%s"
1074                (x-symbol-coding-text x-symbol-coding)
1075                (x-symbol-language-text)
1076                (x-symbol-region-text t)
1077                (x-symbol-coding-text x-symbol-coding x-symbol-default-coding
1078                                      ", Recoded %s to %s"))))
1079
1080 ;;;###autoload
1081 (defun x-symbol-encode (&optional beg end)
1082   "Encode all characters in active region or buffer to tokens.
1083 As opposed to `x-symbol-encode-recode', this function performs no
1084 recoding, i.e., `x-symbol-coding' is considered to have the value of
1085 `x-symbol-default-coding'.  Additionally, `x-symbol-8bits' is assumed to
1086 be nil if `x-symbol-coding' is not nil or not having the same value as
1087 `x-symbol-default-coding'."
1088   (interactive (and (region-active-p) (list (region-beginning) (region-end))))
1089   (if (or (null x-symbol-coding)
1090           (eq x-symbol-coding x-symbol-default-coding))
1091       (x-symbol-encode-recode beg end t)
1092     (let ((x-symbol-coding (or x-symbol-default-coding t))
1093           (x-symbol-8bits nil))
1094       (x-symbol-encode-recode beg end t))))
1095
1096 ;;;###autoload
1097 (defun x-symbol-unalias (&optional beg end coding)
1098   ;; TODO: use char-tables, noe
1099   ;; checkdoc-params: (beg end)
1100   "Resolve all character aliases in active region or buffer.
1101 A char alias is a character which is also a character in a font with
1102 another registry, e.g., `adiaeresis' is defined in all supported latin
1103 fonts.  XEmacs distinguish between these four characters.  In package
1104 x-symbol, one of them, with `x-symbol-default-coding' if possible, is
1105 supported by the input methods, the other ones are char aliases to the
1106 supported one.  The character and all the aliases are represented by the
1107 same charsym.  The info in the minibuffer displays char aliases, you can
1108 resolve a single character before point with \\[x-symbol-modify-key].
1109
1110 8bit characters in files with a file coding `x-symbol-coding' other than
1111 `x-symbol-default-coding' are converted to the \"normal\" form.  E.g.,
1112 if you have a latin-1 font by default, the `adiaeresis' in a latin-2
1113 encoded file is a latin-1 `adiaeresis' in the buffer.  When saving the
1114 buffer, its is again the right 8bit character in the latin-2 encoded
1115 file.  Seven positions in latin-3 fonts are not used, the corresponding
1116 8bit bytes in latin-3 encoded files are not changed.
1117
1118 In normal cases, buffers do not have char aliases: with Mule support,
1119 this is only possible if you copy characters from buffers with
1120 characters considered as char aliases by package x-symbol, e.g., from
1121 the Mule file \"european.el\".  Without Mule support, this is only
1122 possible if you use commands like `\\[universal-argument] 2 3 4'.
1123
1124 The reason why package x-symbol does not support all versions of
1125 `adiaeresis'es:
1126  * It is confusing to the user to choose among four similar characters.
1127  * These four versions are not distinguished in Unicode.
1128  * There are not different tokens for them, neither in the token
1129    language \"TeX macro\", nor \"SGML entity\"."
1130   (interactive (and (region-active-p) (list (region-beginning) (region-end))))
1131   (or beg (setq beg (point-min)))
1132   (or end (setq end (point-max)))
1133   (and coding (featurep 'mule)
1134        (setq coding (cdr (assq coding
1135                                '((iso-8859-1 . latin-iso8859-1)
1136                                  (iso-8859-2 . latin-iso8859-2)
1137                                  (iso-8859-3 . latin-iso8859-3)
1138                                  (iso-8859-9 . latin-iso8859-9)
1139                                  (iso-8859-15 . latin-iso8859-15))))))
1140   (let ((alist x-symbol-unalias-alist)
1141         (case-fold-search nil)
1142         (count 0)
1143         from to)
1144     (save-excursion
1145       (save-restriction
1146         (narrow-to-region beg end)
1147         (while alist
1148           (setq from (caar alist)
1149                 to   (cdar alist)
1150                 alist (cdr alist))
1151           ;; with CODING: unalias just for chars with that coding
1152           (when (or (null coding)
1153                     (eq (char-charset (aref from 0)) coding))
1154             (goto-char (point-min))
1155             (while (search-forward from nil 'limit)
1156               (setq count (1+ count))
1157               (replace-match to t t))))))
1158     (if (interactive-p)
1159         (message "Normalized %d Character Aliases in %s"
1160                  count (x-symbol-region-text t)))))
1161
1162 (defun x-symbol-copy-region-encoded (start end)
1163   "Save the region encoded, as if killed.
1164 Encode characters as `x-symbol-encode' does, but without traces in
1165 current buffer.  Save the region as `copy-region-as-kill' does."
1166   ;; WARNING: args might change (for prefix arg: kill, append/prepend).  No,
1167   ;; this command does not append after a kill as `copy-region-as-kill' does.
1168   ;; I think it's quite strange to append after a kill, but not after another
1169   ;; copy...
1170   (interactive "r")
1171   (if x-symbol-language                 ; yes, not `x-symbol-mode'
1172       (kill-new
1173        (save-excursion
1174          (let* ((x-symbol-8bits
1175                  ;; do not use 8bit chars if not default coding
1176                  (and (or (null x-symbol-coding)
1177                           (eq x-symbol-coding x-symbol-default-coding))
1178                       (eq (x-symbol-buffer-coding) x-symbol-default-coding)
1179                       x-symbol-8bits))
1180                 ;; if 8bit chars remain, do not recode, 8bit chars in the
1181                 ;; `kill-ring' always have default coding
1182                 (x-symbol-coding (or x-symbol-default-coding t))
1183                 (write-region-annotations-so-far nil)) ; safety
1184            (x-symbol-encode-all (get-buffer-create " x-symbol conversion")
1185                                 start end)
1186            (prog1 (buffer-substring (point-min) (point-max))
1187              (kill-buffer (current-buffer))))))
1188     (copy-region-as-kill start end)))
1189
1190 (defun x-symbol-yank-decoded (&optional arg)
1191   "Reinsert and decode the last stretch of killed text.
1192 Reinsert text as `yank' does.  Decode characters as `x-symbol-decode'
1193 does, but without adding unnessary entries to the `buffer-undo-list'."
1194   ;; Can also be inserted+decoded directly.  But it would be much longer when
1195   ;; doing it right (`buffer-undo-list', disable font-lock, etc).
1196   (interactive "*P")
1197   (if x-symbol-mode                     ; yes, not `x-symbol-language'
1198       (let* ((orig-buffer (current-buffer))
1199              (string
1200               (save-excursion
1201                 (set-buffer (get-buffer-create " x-symbol conversion"))
1202                 (x-symbol-inherit-from-buffer orig-buffer)
1203                 ;; 8bit chars in the `kill-ring' always have default coding
1204                 (setq x-symbol-coding (or x-symbol-default-coding t))
1205                 (yank arg)
1206                 (x-symbol-decode-all)
1207                 (prog1 (buffer-substring (point-min) (point-max))
1208                   (kill-buffer (current-buffer))))))
1209         (insert string))
1210     (yank arg)))
1211
1212
1213 ;;;===========================================================================
1214 ;;;  Modeline
1215 ;;;===========================================================================
1216
1217 (defun x-symbol-update-modeline ()
1218   "Update modeline according to `x-symbol-modeline-state-list'."
1219   (let ((alist x-symbol-modeline-state-list)
1220         strings string sep)
1221     (while alist
1222       (cond ((stringp (car alist))
1223              (or sep (setq sep (car alist))))
1224             ((setq string (let ((value (symbol-value (caar alist))))
1225                             (if (functionp (cdar alist))
1226                                 (funcall (cdar alist) value)
1227                               (if value (cadar alist) (cddar alist)))))
1228              (when sep (push sep strings) (setq sep nil))
1229              (push string strings)))
1230       (setq alist (cdr alist)))
1231     (setq x-symbol-modeline-string
1232           (apply 'concat (nreverse strings))))
1233   (force-mode-line-update))
1234
1235
1236 ;;;===========================================================================
1237 ;;;  Minor mode control
1238 ;;;===========================================================================
1239
1240 ;;;###autoload
1241 (defun x-symbol-auto-coding-alist (alist &optional limit no-match)
1242   "Return first match for ALIST in buffer limited by LIMIT.
1243 Each element in ALIST looks like
1244   (REGEXP . RESULT) or (REGEXP MATCH (KEY . RESULT)...)
1245
1246 Search forward from the start of the buffer for a match with REGEXP.
1247 With the first form, return RESULT.  With the second form, return RESULT
1248 where KEY is equal to the MATCH'th regexp group of the match."
1249   (or limit (setq limit x-symbol-auto-coding-search-limit))
1250   (if (eq limit 'point-max) (setq limit nil))
1251   (let ((lim (if limit
1252                  (if (eq limit 'point-max) nil limit)
1253                x-symbol-auto-coding-search-limit))
1254         (alist-copy alist)
1255         regexp value result)
1256     (save-excursion
1257       (save-restriction
1258         (widen)
1259         (while alist
1260           (setq regexp (caar alist)
1261                 value  (cdar alist))
1262           (goto-char (point-min))
1263           (if (re-search-forward regexp lim t)
1264               (setq alist nil
1265                     no-match nil
1266                     result (if (consp value)
1267                                (cdr (assoc (match-string (car value))
1268                                            (cdr value)))
1269                              value))
1270             (setq alist (cdr alist))))
1271         (if no-match
1272             (funcall no-match alist-copy limit)
1273           result)))))
1274
1275 ;; TODO: quick hack
1276 ;;;###autoload
1277 (defun x-symbol-auto-8bit-search (limit)
1278   (let ((cs (if (featurep 'mule)
1279                 (cdr (assq (x-symbol-buffer-coding)
1280                            '((iso-8859-1 . latin-iso8859-1)
1281                              (iso-8859-2 . latin-iso8859-2)
1282                              (iso-8859-3 . latin-iso8859-3)
1283                              (iso-8859-9 . latin-iso8859-9)
1284                              (iso-8859-15 . latin-iso8859-15))))
1285               'latin-iso8859-1)))
1286     (when cs
1287       (save-excursion
1288         (save-restriction
1289           (widen)
1290           (and limit (< limit (point-max))
1291                (narrow-to-region (point-min) limit))
1292           (goto-char (point-min))
1293           (if (eq cs 'latin-iso8859-1)
1294               (progn (skip-chars-forward "^\200-\377" limit)
1295                      (and (< (point) (point-max)) 'buffer))
1296             (when cs
1297               (block nil
1298                 (while (not (eobp))
1299                   (if (eq (char-charset (char-after)) cs) (return 'buffer))
1300                   (forward-char))))))))))
1301
1302 (defvar x-symbol-font-family-postfixes
1303   (if x-symbol-font-lock-with-extra-props '("" "" "") '("" "_sub" "_sup")))
1304
1305 (defvar x-symbol-font-lock-property-alist
1306   '((x-symbol-sub-face face x-symbol-sub-face display (raise -0.33))
1307     (x-symbol-sup-face face x-symbol-sub-face display (raise 0.5))))
1308
1309 (defvar x-symbol-font-lock-keywords
1310   `((x-symbol-font-lock-start)
1311     ,(if x-symbol-font-lock-with-extra-props
1312          (if (eq x-symbol-font-lock-with-extra-props 'invisible)
1313              '(x-symbol-match-subscript
1314                (1 '(face x-symbol-revealed-face invisible t) prepend)
1315                (2 (or (cdr (assq x-symbol-subscript-type
1316                                  x-symbol-font-lock-property-alist))
1317                       x-symbol-subscript-type)
1318                   prepend)
1319                (3 '(face x-symbol-revealed-face invisible t) prepend t))
1320            '(x-symbol-match-subscript
1321              (1 x-symbol-invisible-face t)
1322              (2 (or (cdr (assq x-symbol-subscript-type
1323                                x-symbol-font-lock-property-alist))
1324                     x-symbol-subscript-type)
1325                 prepend)
1326              (3 x-symbol-invisible-face t t)))
1327        '(x-symbol-match-subscript
1328          (1 x-symbol-invisible-face t)
1329          (2 (progn x-symbol-subscript-type) prepend)
1330          (3 x-symbol-invisible-face t t)))
1331     ,@(unless (featurep 'mule)
1332         '((x-symbol-nomule-match-cstring
1333            (0 (progn x-symbol-nomule-font-lock-face) prepend)))))
1334   "TODO")
1335
1336 (defvar x-symbol-subscript-matcher nil
1337   "Internal.
1338 Used during the font-lock highlighting process.")
1339
1340 (defvar x-symbol-subscript-type nil
1341   "Internal")
1342
1343 (defun x-symbol-subscripts-available-p ()
1344   "Non-nil, if KEYWORDS are a part of `font-lock-keywords'."
1345   (x-symbol-font-lock-start nil)
1346   (and x-symbol-subscript-matcher
1347        (assq 'x-symbol-match-subscript x-symbol-font-lock-keywords)))
1348
1349 (defun x-symbol-font-lock-start (limit)
1350   (setq x-symbol-subscript-matcher
1351         (and x-symbol-mode x-symbol-subscripts
1352              (find-face 'x-symbol-sub-face) ; TODO: not if in Emacs-21.4
1353              (find-face 'x-symbol-sup-face) ; ditto
1354              (x-symbol-language-value 'x-symbol-LANG-subscript-matcher)))
1355   (if (eq x-symbol-subscript-matcher 'ignore)
1356       (setq x-symbol-subscript-matcher nil)))
1357
1358 (defun x-symbol-match-subscript (limit)
1359   (if x-symbol-subscript-matcher
1360       (setq x-symbol-subscript-type
1361             (funcall x-symbol-subscript-matcher limit))))
1362
1363 ;; TODO: make easier, is no language access anymore
1364 (defun x-symbol-init-font-lock ()
1365   "Initialize all font-lock keywords for current `major-mode'.
1366 The additional x-symbol keywords are determined by the language access
1367 `x-symbol-font-lock-keywords' for `major-mode's symbol property
1368 `x-symbol-font-lock-language' and the XEmacs/no-Mule cstring
1369 fontification, if necessary.  The font-lock keywords variables are those
1370 mentioned in `font-lock-defaults' or in the symbol property
1371 `font-lock-defaults' of `major-mode'."
1372   (if (assq 'x-symbol-match-subscript x-symbol-font-lock-keywords)
1373       (let ((symbols (car (or font-lock-defaults
1374                               (if (fboundp 'font-lock-find-font-lock-defaults)
1375                                   (font-lock-find-font-lock-defaults
1376                                    major-mode))))))
1377         (dolist (symbol (if (listp symbols) symbols (list symbols)))
1378           (or (assq 'x-symbol-match-subscript (symbol-value symbol))
1379               (set symbol (append (symbol-value symbol)
1380                                   x-symbol-font-lock-keywords))))
1381         (or (null font-lock-keywords)
1382             (assq 'x-symbol-match-subscript font-lock-keywords)
1383             (setq font-lock-keywords (append font-lock-keywords
1384                                              x-symbol-font-lock-keywords)))
1385         (when x-symbol-font-lock-with-extra-props
1386           (make-local-variable 'font-lock-extra-managed-props)
1387           ;; see `x-symbol-font-lock-keywords':
1388           (if (eq x-symbol-font-lock-with-extra-props 'invisible)
1389               (pushnew 'invisible font-lock-extra-managed-props))
1390           (pushnew 'display font-lock-extra-managed-props)))
1391     (when x-symbol-font-lock-keywords
1392       (lwarn 'x-symbol 'error
1393         "Additional font-lock keywords are invalid, set to nil")
1394       (setq x-symbol-font-lock-keywords nil))))
1395
1396 (defun x-symbol-set-image (dummy value)
1397   ;; checkdoc-params: (dummy)
1398   "Set function for buffer local variable `x-symbol-image'.
1399 If VALUE is non-nil, call `x-symbol-image-parse-buffer', otherwise
1400 delete existing x-symbol image extents in buffer."
1401   (if (and (setq x-symbol-image (and value (x-symbol-image-available-p)))
1402            x-symbol-mode)
1403       (progn
1404         (make-local-hook 'after-change-functions)
1405         (x-symbol-image-parse-buffer)
1406         (add-hook 'after-change-functions
1407                   'x-symbol-image-after-change-function nil t))
1408     (if (local-variable-p 'x-symbol-image-buffer-extents (current-buffer))
1409         (x-symbol-image-delete-extents 1 (1+ (buffer-size))))
1410     (remove-hook 'after-change-functions 'x-symbol-image-after-change-function
1411                  t)))
1412
1413 ;;;###autoload
1414 (defun x-symbol-mode-internal (conversion)
1415   "Setup X-Symbol mode according to buffer-local variables.
1416 If CONVERSION is non-nil, do conversion with EXEC-THRESHOLD.  See
1417 command `x-symbol-mode' for details."
1418   (unless (featurep 'xemacs)
1419     (unless enable-multibyte-characters
1420       ;; Emacs: we need to convert the buffer from unibyte to multibyte
1421       ;; since we'll use multibyte support for the symbol charset.
1422       ;; TODO: try to do it less often
1423       (let ((modified (buffer-modified-p))
1424             (inhibit-read-only t)
1425             (inhibit-modification-hooks t))
1426         (unwind-protect
1427             (progn
1428               (decode-coding-region (point-min) (point-max) 'undecided)
1429               (set-buffer-multibyte t))
1430           (set-buffer-modified-p modified))))
1431     (and x-symbol-mode
1432          x-symbol-set-coding-system-if-undecided
1433          x-symbol-default-coding
1434          (let ((cs (car (rassq x-symbol-default-coding
1435                                '((iso-latin-1 . iso-8859-1)
1436                                  (iso-latin-2 . iso-8859-2)
1437                                  (iso-latin-3 . iso-8859-3)
1438                                  (iso-latin-9 . iso-8859-9)
1439                                  (iso-latin-15 . iso-8859-15))))))
1440            (if cs (set-buffer-file-coding-system cs)))))
1441   (if x-symbol-mode (x-symbol-init-font-lock))
1442   (if conversion
1443       (let ((modified (buffer-modified-p))
1444             (buffer-read-only nil)      ; always allow conversion
1445             (buffer-file-name nil)      ; no file-locking, TODO: dangerous?
1446             (inhibit-read-only t)
1447             (first-change-hook nil)     ; no `flyspell-mode' here
1448             (after-change-functions nil) ; no fontification!
1449             (no-undo (null buffer-undo-list)))
1450         (if no-undo (setq buffer-undo-list t))
1451         (save-excursion
1452           (save-restriction
1453             (if x-symbol-mode
1454                 (let ((buffer-coding (x-symbol-buffer-coding)))
1455                   ;; cannot do this in `x-symbol-mode': `x-symbol-fchar-tables' might not be defined
1456                   (if buffer-coding
1457                       (or (null x-symbol-coding) ; no coding specified
1458                           (eq x-symbol-coding buffer-coding) ; specified = buffer-file-coding
1459                           (and (eq buffer-coding x-symbol-default-coding)
1460                                         ; valid coding and buffer-fc = default
1461                                (assq x-symbol-coding x-symbol-fchar-tables))
1462                           (setq x-symbol-8bits
1463                                 (x-symbol-auto-8bit-search nil)))
1464                     (setq x-symbol-8bits nil))
1465                   (x-symbol-decode-all))
1466               (x-symbol-encode-all))
1467             (if font-lock-mode (x-symbol-fontify (point-min) (point-max)))))
1468         (if no-undo (setq buffer-undo-list nil))
1469         (or modified (set-buffer-modified-p nil))))
1470   (x-symbol-set-image nil x-symbol-image)
1471   (if x-symbol-mode
1472       (progn
1473         (make-local-hook 'pre-command-hook)
1474         (make-local-hook 'post-command-hook)
1475         (add-hook 'pre-command-hook 'x-symbol-pre-command-hook nil t)
1476         (add-hook 'post-command-hook 'x-symbol-post-command-hook nil t)
1477         (if (assq 'x-symbol format-alist)
1478             (pushnew 'x-symbol buffer-file-format))
1479         (easy-menu-add x-symbol-menu)
1480         (x-symbol-update-modeline))
1481     (remove-hook 'pre-command-hook 'x-symbol-pre-command-hook t)
1482     (remove-hook 'post-command-hook  'x-symbol-post-command-hook t)
1483     (setq buffer-file-format (delq 'x-symbol buffer-file-format))
1484     (if (local-variable-p 'current-menubar (current-buffer))
1485         ;; XEmacs bug workaround
1486         (ignore-errors (easy-menu-remove x-symbol-menu)))))
1487
1488 (defun nuke-x-symbol ()
1489   "Turn off X-Symbol mode and make sure that tokens are encoded.
1490 Used in `change-major-mode-hook'."
1491   (when x-symbol-mode
1492     (setq x-symbol-mode nil)
1493     (x-symbol-mode-internal x-symbol-language)))
1494 (add-hook 'change-major-mode-hook 'nuke-x-symbol)
1495
1496
1497 ;;;===========================================================================
1498 ;;;  Menu filters
1499 ;;;===========================================================================
1500
1501 (defun x-symbol-options-filter (menu-items)
1502   (let (item menu var options)
1503     (while (setq item (pop menu-items))
1504       (push (if (not (and (vectorp item)
1505                           (= (length item) 3)
1506                           (setq var (aref item 1))
1507                           (symbolp var)
1508                           (setq options (get var 'x-symbol-options))))
1509                 item
1510               (let ((header (aref item 0))
1511                     (active (and (eval (aref item 2)) t))
1512                     (value (symbol-value var))
1513                     fallback submenu option)
1514                 (if (functionp options) (setq options (funcall options)))
1515                 (setq fallback (pop options))
1516                 ;; VARIABLE with VALUE, allowed OPTIONS with FALLBACK
1517                 (if (null options)
1518                     (vector header
1519                             `(x-symbol-set-variable
1520                               (quote ,var) ,(if value nil `(quote ,fallback)))
1521                             :active active
1522                             :style 'toggle
1523                             :selected (and value t))
1524                   (or (assq value options) (setq value fallback))
1525                   (while (setq option (pop options))
1526                     (push (vector (cdr option)
1527                                   `(x-symbol-set-variable
1528                                     (quote ,var) (quote ,(car option)))
1529                                   :active active
1530                                   :style 'radio
1531                                   :selected (eq (car option) value))
1532                           submenu))
1533                   (cons header (nreverse submenu)))))
1534             menu))
1535     (nreverse menu)))
1536
1537 (defun x-symbol-extra-filter (menu-items)
1538   (let ((extra (assoc (aref (car menu-items) 0)
1539                       (x-symbol-language-value
1540                        'x-symbol-LANG-extra-menu-items))))
1541     (if extra
1542         (append (cdr menu-items) (cdr extra))
1543       (cdr menu-items))))
1544
1545 (defun x-symbol-menu-filter (menu-items)
1546   "Menu filter `x-symbol-menu'.
1547 Append the global or token-language specific menu to MENU-ITEMS."
1548   (nconc (mapcar (lambda (item)
1549                    (if (and (consp item)
1550                             (eq (caddr item) 'x-symbol-extra-filter)
1551                             (aref (cadddr item) 2))
1552                        (cons (format (car item)
1553                                      (funcall (aref (cadddr item) 2)))
1554                              (cdr item))
1555                      item))
1556                  menu-items)
1557          (or (and x-symbol-local-menu
1558                   x-symbol-language
1559                   (x-symbol-generated-menu-alist
1560                    (x-symbol-language-value 'x-symbol-LANG-generated-data)))
1561              x-symbol-menu-alist)))
1562
1563
1564 \f
1565 ;;;;##########################################################################
1566 ;;;;  Info, List-Mode
1567 ;;;;##########################################################################
1568
1569
1570 (put 'x-symbol-list-mode 'mode-class 'special) ; where is it used?
1571
1572 (defvar x-symbol-list-mode-map
1573   (let ((map (make-sparse-keymap)))
1574     (define-key map " " 'x-symbol-list-selected)
1575     (define-key map "\C-m" 'x-symbol-list-selected)
1576     (define-key map "q" 'x-symbol-list-bury)
1577     (define-key map "?" 'x-symbol-list-info)
1578     (define-key map "i" 'x-symbol-list-info)
1579     (define-key map "h" 'x-symbol-list-info)
1580     ;; TODO: either XEmacs or Emacs bindings
1581     ;; Bindings for XEmacs.
1582     (when (lookup-key global-map [(button2)])
1583       (define-key map 'button2 'x-symbol-list-mouse-selected)
1584       (define-key map 'button2up 'undefined)
1585       (define-key map 'button3 'x-symbol-list-menu-selected)
1586       (define-key map 'button3up 'undefined))
1587     ;; Same bindings but for Emacs.
1588     (when (lookup-key global-map [(mouse-2)])
1589       (define-key map [mouse-2] 'x-symbol-list-mouse-selected)
1590       (define-key map [up-mouse-2] 'undefined)
1591       (define-key map [down-mouse-3] 'x-symbol-list-menu-selected)
1592       (define-key map [mouse-3] 'undefined)
1593       (define-key map [up-mouse-3] 'undefined))
1594     (set-keymap-parent map list-mode-map)
1595     map)
1596   "Mode map used in grid buffers and the key completion buffer.")
1597
1598 (defvar x-symbol-list-buffer nil
1599   "Internal.  Recently used list buffer.")
1600 (defvar x-symbol-list-win-config nil
1601   "Internal buffer-local in list buffer.  Win-config before invocation.")
1602 (defvar x-symbol-invisible-spec nil
1603   "Internal.  Used by `x-symbol-hide-revealed-at-point'.
1604 Looks like (BUFFER START END . FACE-OR-FACES) or nil.")
1605
1606 (defvar x-symbol-itimer nil
1607   "Internal.  Used by `x-symbol-start-itimer-once'.")
1608
1609 (defvar x-symbol-invisible-display-table
1610   (let ((table (make-display-table))
1611         (i 0))
1612     (while (< i 256)
1613       (put-display-table i "" table)
1614       (setq i (1+ i)))
1615     table)
1616   "Internal variable.  Display table for `x-symbol-invisible-face'.")
1617
1618 (defvar x-symbol-invisible-font "-XSYMB-nil-*"
1619   ;; Note that the `nil' font uses a `fontspecific' encoding, so we need to go
1620   ;; through a fontset to convince Emacs to use this font when displaying ASCII
1621   ;; chars.
1622   "Internal variable.  Font to use for `x-symbol-invisible-face'.
1623 It is not used if faces can have a property \"display table\", i.e., if
1624  `x-symbol-invisible-display-table' has a non-nil value.")
1625
1626 (make-face 'x-symbol-invisible-face
1627            "*Face for displaying invisible things like \"_\" and \"^\" in TeX.")
1628 (unless noninteractive                  ; CW: see noninteractive below
1629   (cond (x-symbol-invisible-display-table
1630          (set-face-display-table 'x-symbol-invisible-face
1631                                  x-symbol-invisible-display-table))
1632         ((and (fboundp 'create-fontset-from-ascii-font)
1633               x-symbol-invisible-font
1634               (try-font-name x-symbol-invisible-font))
1635          ;; This is a mean and ugly hack.  Since Emacs seems unable to create a
1636          ;; face that makes text invisible, we simulate it by using a minuscule
1637          ;; pseudo-font.
1638          (set-face-font 'x-symbol-invisible-face
1639                         (create-fontset-from-ascii-font
1640                          x-symbol-invisible-font)))))
1641
1642 (defvar x-symbol-charsym-info-cache nil
1643   "Internal.  Cache for `x-symbol-charsym-info'.")
1644 (defvar x-symbol-language-info-caches nil
1645   "Internal.  Cache for `x-symbol-language-info'.")
1646 (defvar x-symbol-coding-info-cache nil
1647   "Internal.  Cache for `x-symbol-coding-info'.")
1648 (defvar x-symbol-keys-info-cache nil
1649   "Internal.  Cache for `x-symbol-keys-info'.")
1650
1651
1652 ;;;===========================================================================
1653 ;;;  X-Symbol List Mode (for GRID and KEYBOARD completion)
1654 ;;;===========================================================================
1655
1656 (defun x-symbol-list-bury ()
1657   "Bury current buffer while trying to use the old window configuration."
1658   (interactive)
1659   (setq x-symbol-list-buffer (current-buffer))
1660   (x-symbol-list-restore t))
1661
1662 (defun x-symbol-list-restore (&optional bury)
1663   "Restore window configuration used before invoking the list buffer.
1664 If optional argument BURY is non-nil, bury current buffer if
1665 configuration cannot be restored.  See `x-symbol-temp-grid' and
1666 `x-symbol-temp-help'.  Used by `x-symbol-insert-command'."
1667   (and x-symbol-list-buffer
1668        (get-buffer-window x-symbol-list-buffer)
1669        (let ((orig (current-buffer))
1670              reference win-config)
1671          (set-buffer x-symbol-list-buffer)
1672          (setq reference completion-reference-buffer)
1673          ;; CW: a first try:
1674          (or (and (buffer-live-p reference)
1675                   (get-buffer-window reference t)
1676                   (cond ((null x-symbol-use-refbuffer-once))
1677                         ((functionp x-symbol-use-refbuffer-once)
1678                          (not (funcall x-symbol-use-refbuffer-once
1679                                        reference)))))
1680              (setq completion-reference-buffer nil))
1681          (setq win-config x-symbol-list-win-config
1682                x-symbol-list-win-config nil)
1683          (if (or (eq orig reference)
1684                  (and (eq orig x-symbol-list-buffer) (buffer-live-p reference)))
1685              (if (window-configuration-p win-config)
1686                  (set-window-configuration win-config)
1687                (pop-to-buffer reference))
1688            (set-buffer orig)
1689            (if bury (bury-buffer)))))
1690   (setq x-symbol-list-buffer nil))
1691
1692 (defun x-symbol-list-store (reference win-config)
1693   "Store window configuration WIN-CONFIG and reference buffer REFERENCE.
1694 Used by `x-symbol-list-restore'."
1695   (setq x-symbol-list-buffer (and reference (current-buffer)))
1696   (make-local-variable 'completion-reference-buffer)
1697   (setq completion-reference-buffer reference)
1698   (make-local-variable 'x-symbol-list-win-config)
1699   (setq x-symbol-list-win-config win-config))
1700
1701 (defun x-symbol-list-mode (&optional language reference win-config)
1702   "Major mode for buffers containing x-symbol items.
1703 Invoked for token language LANGUAGE form buffer REFERENCE.  WIN-CONFIG
1704 is the window configuration before invoking the grid or key completion
1705 buffer, used by `x-symbol-list-restore'.  Runs hook
1706 `x-symbol-list-mode-hook'.
1707
1708 \\{x-symbol-list-mode-map}"
1709   (list-mode)
1710   (setq major-mode 'x-symbol-list-mode)
1711   (use-local-map x-symbol-list-mode-map)
1712   (setq mode-name "XS-List")
1713   (setq x-symbol-language language)
1714   (x-symbol-list-store reference win-config)
1715   (run-hooks 'x-symbol-list-mode-hook))
1716
1717
1718 ;;;===========================================================================
1719 ;;;  List Mode Selection
1720 ;;;===========================================================================
1721
1722 (defun x-symbol-list-scroll (pos buffer)
1723   "Scrolls BUFFER up/down according to POS.
1724 In POS is in the upper half of the window, scroll down, otherwise,
1725 scroll up."
1726   (let ((window (get-buffer-window buffer 'visible)))
1727     (if window
1728         (progn
1729           (select-window window)
1730           (set-buffer buffer))
1731       (pop-to-buffer buffer)))
1732   (let ((old-pos (point)))
1733     (move-to-window-line nil)
1734     (if (> (point) pos)
1735         (scroll-down)
1736       (scroll-up)
1737       (when (pos-visible-in-window-p (point-max))
1738         (goto-char (point-max))
1739         (recenter -1)))
1740     (if (pos-visible-in-window-p old-pos)
1741         (goto-char old-pos)
1742       (move-to-window-line nil))))
1743
1744 ;;;###autoload
1745 (defun x-symbol-init-language-interactive (language)
1746   "Initialize token language LANGUAGE.
1747 See `x-symbol-init-language'."
1748   (interactive (list (x-symbol-read-language
1749                       "Initialize Token Language: " nil
1750                       (lambda (elem)
1751                         (and (cdr elem)
1752                              (null (get (cdr elem) 'x-symbol-initialized)))))))
1753   (if language
1754       (if (get language 'x-symbol-initialized)
1755           (message "Token language %S is already initialized"
1756                    (x-symbol-language-value 'x-symbol-LANG-name language))
1757         (if (x-symbol-init-language language)
1758             (message "Token language %S has been initialized"
1759                      (x-symbol-language-value 'x-symbol-LANG-name language))
1760           (error "Failed to initialize token language `%s'" language)))))
1761
1762 (defun x-symbol-list-menu (reference charsym)
1763   "Popup menu for the insertion of the character under mouse.
1764 Insert character or one of its tokens, represented by CHARSYM into
1765 buffer REFERENCE, see `x-symbol-insert-command'."
1766   (let ((keys (where-is-internal (get charsym 'x-symbol-insert-command)
1767                                  nil t))
1768         (alist (cons (cons nil x-symbol-charsym-name)
1769                      x-symbol-language-alist))
1770         menu menu1
1771         language token)
1772     (while alist
1773       (if (or (null (car (setq language (pop alist))))
1774               (get (car language) 'x-symbol-initialized))
1775           (if (setq token (if (car language)
1776                               (car (gethash charsym
1777                                             (x-symbol-generated-encode-table
1778                                              (x-symbol-language-value
1779                                               'x-symbol-LANG-generated-data
1780                                               (car language)))))
1781                             (symbol-name charsym)))
1782               (push (vector token
1783                             `(x-symbol-insert-command -1 (quote ,charsym)
1784                                                       ,token)
1785                             :keys (format (if (eq (car language)
1786                                                   x-symbol-language)
1787                                               "(%s)*"
1788                                             "(%s)")
1789                                           (cdr language)))
1790                     menu))
1791         (push (vector "Initialize..." `(x-symbol-init-language-interactive
1792                                         (quote ,(car language)))
1793                       :keys (cdr language))
1794               menu1)))
1795     (popup-menu
1796      (list* (if (symbol-value-in-buffer 'buffer-read-only reference)
1797                 "Store in kill-ring as:"
1798               (if (eq (current-buffer) reference)
1799                   "Insert as:"
1800                 (format "Insert in \"%s\" as:" (buffer-name reference))))
1801             (vector
1802              "Character"
1803              `(x-symbol-insert-command -1 (quote ,charsym) nil)
1804              :active (gethash charsym x-symbol-cstring-table)
1805              :keys (if keys
1806                        (if (funcall x-symbol-valid-charsym-function charsym)
1807                            (key-description keys)
1808                          (concat (key-description
1809                                   (where-is-internal 'negative-argument nil t))
1810                                  " "
1811                                  (key-description keys)))))
1812             "---"
1813             (nconc (nreverse menu)
1814                    (and menu1 (cons "--:shadowDoubleEtchedIn"
1815                                     (nreverse menu1))))))))
1816
1817 (defun x-symbol-list-selected (&optional arg pos buffer)
1818   "Handle selection of a x-symbol list item at POS in BUFFER.
1819 When called interactively, insert character with prefix argument ARG for
1820 list item at point, see `x-symbol-insert-command'.  Also called by
1821 `x-symbol-list-menu-selected' and `x-symbol-list-mouse-selected'."
1822   (interactive "P")
1823   (or pos (setq pos (point)))
1824   ;; SM: we rely too much on list-mode's implementation (and properties).  CW:
1825   ;; I don't think so, at least these are XEmacs' documented properties...
1826   (let* ((extent (extent-at pos buffer 'list-mode-item)))
1827     (if extent
1828         (let ((charsym (extent-property extent 'list-mode-item-user-data))
1829               (reference (or completion-reference-buffer (current-buffer))))
1830           ;; current list buffer must be equal
1831           (setq x-symbol-list-buffer (or buffer (current-buffer)))
1832           (if (and buffer (consp arg))
1833               (x-symbol-list-menu reference charsym)
1834             (x-symbol-insert-command arg charsym)))
1835       (or buffer (error "Not over an x-symbol selection"))
1836       (if (consp arg)
1837           (popup-menu x-symbol-menu)
1838         (let ((selected (selected-window)))
1839           (unwind-protect
1840               (x-symbol-list-scroll pos buffer)
1841             (select-window selected)))))))
1842
1843 (defun x-symbol-list-menu-selected (event)
1844   ;; checkdoc-params: (event)
1845   "Popup menu for x-symbol list item under mouse.
1846 If mouse is over a list item, popup menu for the insertion of the
1847 corresponding character or one of its tokens, see
1848 `x-symbol-insert-command'.  Otherwise, popup the X-Symbol menu."
1849   (interactive "e")
1850   ;;(run-hooks 'mouse-leave-buffer-hook)
1851   (x-symbol-list-selected '(4) (event-closest-point event)
1852                           (event-buffer event)))
1853
1854 (defun x-symbol-list-mouse-selected (arg event)
1855   ;; checkdoc-params: (arg event)
1856   "Select x-symbol list item under mouse.
1857 If mouse is over a list item, insert the corresponding character, see
1858 `x-symbol-insert-command'.  Otherwise, scroll the list buffer down, if
1859 mouse is in the upper half of the window, scroll up, otherwise."
1860   (interactive "P\ne")
1861   ;;(run-hooks 'mouse-leave-buffer-hook)
1862   (x-symbol-list-selected arg (event-closest-point event)
1863                           (event-buffer event)))
1864 (put 'x-symbol-list-mouse-selected 'isearch-command t)
1865
1866
1867 ;;;===========================================================================
1868 ;;;  Character Info Parts
1869 ;;;===========================================================================
1870
1871 (defun x-symbol-charsym-info (charsym)
1872   "Return info for CHARSYM describing the charsym."
1873   (x-symbol-ensure-hashtable 'x-symbol-charsym-info-cache)
1874   (or (gethash charsym x-symbol-charsym-info-cache)
1875       (x-symbol-puthash
1876        charsym
1877        (concat (x-symbol-fancy-string
1878                 (cons (format (car x-symbol-info-token-charsym) charsym)
1879                       (cdr x-symbol-info-token-charsym)))
1880                (x-symbol-fancy-value 'x-symbol-info-classes-pre)
1881                (x-symbol-fancy-value 'x-symbol-info-classes-charsym)
1882                (x-symbol-fancy-value 'x-symbol-info-classes-post))
1883        x-symbol-charsym-info-cache)))
1884
1885 (defun x-symbol-language-info (charsym language)
1886   "Return info for CHARSYM describing the token and classes in LANGUAGE."
1887   (let ((cache (plist-get x-symbol-language-info-caches language)))
1888     (unless cache
1889       (x-symbol-ensure-hashtable 'cache)
1890       (setq x-symbol-language-info-caches
1891             (plist-put x-symbol-language-info-caches language cache)))
1892     (or (gethash charsym cache)
1893         (let* ((data (x-symbol-language-value
1894                       'x-symbol-LANG-generated-data language))
1895                (token (gethash charsym
1896                                (x-symbol-generated-encode-table data))))
1897           (x-symbol-puthash
1898            charsym
1899            (concat (if token
1900                        (x-symbol-fancy-string
1901                         (cons (car token)
1902                               (cdr (x-symbol-charsym-face charsym language))))
1903                      (x-symbol-fancy-string
1904                       (cons (format (car x-symbol-info-token-charsym) charsym)
1905                             (cdr x-symbol-info-token-charsym))))
1906                    (x-symbol-fancy-associations
1907                     (gethash charsym
1908                              (x-symbol-generated-token-classes data))
1909                     (x-symbol-language-value 'x-symbol-LANG-class-alist
1910                                              language)
1911                     'x-symbol-info-classes-pre
1912                     'x-symbol-info-classes-sep
1913                     'x-symbol-info-classes-post
1914                     (if token 'VALID 'INVALID)))
1915            cache)))))
1916
1917 (defun x-symbol-coding-info (charsym)
1918   "Return info for CHARSYM describing possible 8bit codings."
1919   (x-symbol-ensure-hashtable 'x-symbol-coding-info-cache)
1920   (or (gethash charsym x-symbol-coding-info-cache)
1921       (let ((tables x-symbol-info-coding-alist) coding table charsym-codings)
1922         (while tables
1923           (setq coding (car (pop tables)))
1924           (and (setq table (assq coding x-symbol-fchar-tables))
1925                (gethash charsym (cdr table))
1926                (push coding charsym-codings)))
1927         (x-symbol-puthash charsym
1928                           (or (x-symbol-fancy-associations
1929                                (nreverse charsym-codings)
1930                                x-symbol-info-coding-alist
1931                                'x-symbol-info-coding-pre
1932                                'x-symbol-info-coding-sep
1933                                'x-symbol-info-coding-post)
1934                               "")
1935                           x-symbol-coding-info-cache))))
1936
1937 (defun x-symbol-keys-info (charsym)
1938   "Return info for CHARSYM describing key bindings.
1939 See `x-symbol-info-keys-keymaps'."
1940   (x-symbol-ensure-hashtable 'x-symbol-keys-info-cache)
1941   (or (gethash charsym x-symbol-keys-info-cache)
1942       ;;(if x-symbol-input-initialized
1943       (x-symbol-puthash
1944        charsym
1945        (concat (x-symbol-fancy-value 'x-symbol-info-keys-pre
1946                                      'substitute-command-keys)
1947                (sorted-key-descriptions
1948                 (where-is-internal
1949                  (get charsym 'x-symbol-insert-command)
1950                  (and (functionp x-symbol-info-keys-keymaps)
1951                       (funcall x-symbol-info-keys-keymaps charsym)))
1952                 (x-symbol-fancy-value 'x-symbol-info-keys-sep))
1953                (x-symbol-fancy-value 'x-symbol-info-keys-post))
1954        x-symbol-keys-info-cache)))
1955
1956
1957 ;;;===========================================================================
1958 ;;;  Character Info
1959 ;;;===========================================================================
1960
1961 (defun x-symbol-info (charsym language long intro)
1962   "Return info for CHARSYM in LANGUAGE with introduction INTRO.
1963 See `x-symbol-character-info'.  When LONG is nil, do not show info
1964 describing key bindings."
1965   (concat intro
1966           (gethash charsym x-symbol-fontified-cstring-table)
1967           (x-symbol-fancy-value 'x-symbol-info-token-pre)
1968           (if (get language 'x-symbol-LANG-name)
1969               (x-symbol-language-info charsym language)
1970             (x-symbol-charsym-info charsym))
1971           (x-symbol-coding-info charsym)
1972           (and long (x-symbol-keys-info charsym))))
1973
1974 (defun x-symbol-list-info ()
1975   "Display info for character under point in echo area."
1976   (interactive)
1977   ;; FIXME: we rely too much on list-mode's implementation (and properties).
1978   (let* ((extent (extent-at (point) nil 'list-mode-item))
1979          (charsym (and extent
1980                        (extent-property extent 'list-mode-item-user-data))))
1981     (if charsym
1982         (display-message 'no-log
1983           (x-symbol-info charsym x-symbol-language t
1984                          (x-symbol-fancy-value 'x-symbol-info-intro-list
1985                                                'substitute-command-keys)))
1986       (error "No charsym selected"))))
1987
1988 (defun x-symbol-highlight-echo (extent &optional window pos)
1989   "Return info for character covered by EXTENT."
1990   ;; CW: check -- seems to work
1991   ;; Emacs-21 provides `window' but as the first argument.
1992   (if (windowp extent) (let ((w extent)) (setq extent window window w)))
1993   ;; FIXME: we rely too much on list-mode's implementation (and properties).
1994   (let ((charsym (extent-property extent 'list-mode-item-user-data)))
1995     (if charsym
1996         (x-symbol-info charsym x-symbol-language t
1997                        (x-symbol-fancy-value 'x-symbol-info-intro-highlight)))))
1998
1999 (defun x-symbol-point-info (after before)
2000   "Return info for characters around point.
2001 See `x-symbol-character-info' and `x-symbol-context-info'.  AFTER and
2002 BEFORE represent the characters after and before point.  They have the
2003 same type as the return values of `x-symbol-charsym-after'."
2004   (let (charsym context pos)
2005     (cond ((and x-symbol-character-info (setq charsym (cdr after)))
2006            (if (x-symbol-alias-charsym after)
2007                (x-symbol-info
2008                 charsym x-symbol-language nil
2009                 (x-symbol-fancy-value 'x-symbol-info-alias-after
2010                                       'substitute-command-keys))
2011              (x-symbol-info
2012               charsym x-symbol-language t
2013               (x-symbol-fancy-value 'x-symbol-info-intro-after))))
2014           ((and (eq x-symbol-character-info t) (setq charsym (cdr before)))
2015            (if (x-symbol-alias-charsym before)
2016                (x-symbol-info
2017                 charsym x-symbol-language nil
2018                 (x-symbol-fancy-value 'x-symbol-info-alias-before
2019                                       'substitute-command-keys))
2020              (x-symbol-info
2021               charsym x-symbol-language t
2022               (x-symbol-fancy-value 'x-symbol-info-intro-before))))
2023           ((and x-symbol-context-info
2024                 (setq pos (or (car after) (point)))
2025                 (setq before (x-symbol-match-before x-symbol-context-atree pos))
2026                 (setq charsym (x-symbol-next-valid-charsym
2027                                (cdr before) t 'x-symbol-modify-to))
2028                 (null (x-symbol-call-function-or-regexp
2029                        x-symbol-context-info-ignore
2030                        (setq context (buffer-substring (car before) pos))
2031                        charsym)))
2032            (x-symbol-info
2033             charsym x-symbol-language t
2034             ;; no fancy context (too fancy, would break no-Mule cstrings)
2035             (concat (x-symbol-fancy-value 'x-symbol-info-context-pre
2036                                           'substitute-command-keys)
2037                     context
2038                     (x-symbol-fancy-value 'x-symbol-info-context-post)))))))
2039
2040
2041 ;;;===========================================================================
2042 ;;;  Hide & Reveal Invisible
2043 ;;;===========================================================================
2044
2045 (defun x-symbol-hide-revealed-at-point ()
2046   "Hide characters at point revealed by `x-symbol-reveal-invisible'.
2047 Used by `x-symbol-pre-command-hook'.  To avoid flickering, commands
2048 which do not change the buffer contents and just move point by a
2049 predictable number of characters right or left should have a function
2050 MOVE as the symbol property `x-symbol-point-function'.  MOVE is called
2051 with argument `point' and should return the position of `point' after
2052 the execution of the command.  E.g., `forward-char' uses `1+'."
2053   (when x-symbol-invisible-spec
2054     (unless (let (fun pos)
2055               (and (symbolp this-command)
2056                    (functionp (setq fun (get this-command
2057                                              'x-symbol-point-function)))
2058                    (setq pos (funcall fun (point)))
2059                    (<= (cadr x-symbol-invisible-spec) pos)
2060                    (if (eq x-symbol-reveal-invisible t)
2061                        (>= (caddr x-symbol-invisible-spec) pos)
2062                      (> (caddr x-symbol-invisible-spec) pos))))
2063       (when (buffer-live-p (car x-symbol-invisible-spec))
2064         (x-symbol-ignore-property-changes
2065           (if (eq x-symbol-font-lock-with-extra-props 'invisible)
2066               (progn
2067                 (put-text-property (cadr x-symbol-invisible-spec)
2068                                    (caddr x-symbol-invisible-spec)
2069                                    'invisible 'hide)
2070                 (unless (eq this-command 'eval-expression)
2071                   (setq x-symbol-trace-invisible
2072                         (text-properties-at (cadr x-symbol-invisible-spec)))))
2073             (funcall (if (consp (cdddr x-symbol-invisible-spec))
2074                          'put-text-property
2075                        'put-nonduplicable-text-property)
2076                      (cadr x-symbol-invisible-spec)
2077                      (caddr x-symbol-invisible-spec)
2078                      'face (cdddr x-symbol-invisible-spec)
2079                      (car x-symbol-invisible-spec))))
2080         (setq x-symbol-invisible-spec nil)))))
2081
2082 (defun x-symbol-reveal-invisible (after before)
2083   "Reveal invisible characters around point.
2084 See `x-symbol-reveal-invisible'.  AFTER and BEFORE represent the
2085 characters after and before point.  They have the same type as the
2086 return values of `x-symbol-charsym-after'.  The characters are hidden
2087 with `x-symbol-hide-revealed-at-point'."
2088   (let ((faces (and after (get-text-property after 'face)))
2089         (iface (if (eq x-symbol-font-lock-with-extra-props 'invisible)
2090                    'x-symbol-revealed-face
2091                  'x-symbol-invisible-face)))
2092     (setq x-symbol-invisible-spec nil)  ; safety (should be precondition)
2093     (when (or (if (consp faces) (memq iface faces) (eq faces iface))
2094               (and (eq x-symbol-reveal-invisible t)
2095                    (setq after before)
2096                    (setq faces (get-text-property after 'face))
2097                    (if (consp faces) (memq iface faces) (eq faces iface))))
2098       (let ((start (previous-single-property-change (1+ after) 'face nil
2099                                                     (point-at-bol)))
2100             (end (next-single-property-change after 'face nil
2101                                               (point-at-eol))))
2102         (when (featurep 'xemacs)
2103           ;; `isearch-secondary' face would induce a prop change
2104           (unless (eq x-symbol-font-lock-with-extra-props 'invisible) ; safety
2105             (let (faces2 start2)
2106               (while
2107                   (and (setq faces2 (get-text-property (1- start) 'face))
2108                        (if (consp faces2) (memq iface faces2) (eq faces2 iface))
2109                        (setq start2 (previous-single-property-change
2110                                      start 'face nil (point-at-bol))))
2111                 (setq start start2)))))
2112         (setq x-symbol-invisible-spec
2113               (list* (current-buffer) start end faces))
2114         (x-symbol-ignore-property-changes
2115           (if (eq x-symbol-font-lock-with-extra-props 'invisible)
2116               (progn (remove-text-properties start end '(invisible nil))
2117                      (setq x-symbol-trace-invisible (text-properties-at start)))
2118             (put-nonduplicable-text-property
2119              start end 'face (if (consp faces)
2120                                  (cons 'x-symbol-revealed-face
2121                                        (delq 'x-symbol-invisible-face
2122                                              (copy-sequence faces)))
2123                                'x-symbol-revealed-face))))))))
2124
2125
2126 ;;;===========================================================================
2127 ;;;  Entry Points
2128 ;;;===========================================================================
2129
2130 (defun x-symbol-show-info-and-invisible ()
2131   "Reveal invisible characters and show info in echo area.
2132 See `x-symbol-reveal-invisible', `x-symbol-character-info' and
2133 `x-symbol-context-info'.  Expiry function for itimer started with
2134 `x-symbol-start-itimer-once'."
2135   (when x-symbol-mode
2136     (let* ((after (x-symbol-charsym-after))
2137            (pos (1- (or (car after) (point))))
2138            (before (and (null (eq (char-after pos) ?\n))
2139                         (x-symbol-charsym-after pos)))
2140            info)
2141       (and x-symbol-reveal-invisible
2142            (null x-symbol-invisible-spec)
2143            (x-symbol-reveal-invisible (car after) (car before)))
2144       (and (null message-stack)         ; no message in echo area
2145            (not (eq (selected-window) (minibuffer-window)))
2146            ;; Quail:
2147            (not (and (local-variable-p 'quail-guidance-buf (current-buffer))
2148                      (buffer-live-p quail-guidance-buf)
2149                      (> (buffer-size quail-guidance-buf) 0)))
2150 ;;         (not (and (local-variable-p 'current-input-method (current-buffer))
2151 ;;                   current-input-method
2152 ;;                   (fboundp 'quail-point-in-conversion-region)
2153 ;;                   (boundp 'quail-conv-overlay)
2154 ;;                   (setq cw quail-overlay)
2155 ;;                   (overlayp quail-overlay) ; ehem, this test should be in that function
2156 ;;                   (setq cw2 quail-overlay)))
2157 ;;                   ;;(quail-point-in-conversion-region)))
2158            (setq info (x-symbol-point-info after before))
2159            (if (featurep 'xemacs)
2160                (display-message 'no-log info)
2161              (let ((resize-mini-windows nil))
2162                (display-message 'no-log info)
2163                ;;(sit-for 0.01) ; does not work, resizes after 0.01s
2164                ))))))
2165
2166 (defun x-symbol-start-itimer-once ()
2167   "Start idle timer for function `x-symbol-show-info-and-invisible'.
2168 Used in `x-symbol-post-command-hook.'"
2169   (if (and (numberp x-symbol-idle-delay) (> x-symbol-idle-delay 0))
2170       (unless (itimer-live-p x-symbol-itimer)
2171         (setq x-symbol-itimer
2172               (start-itimer "X-Symbol Idle Timer"
2173                             'x-symbol-show-info-and-invisible
2174                             x-symbol-idle-delay nil t)))
2175     (x-symbol-show-info-and-invisible)))
2176
2177
2178 ;;;===========================================================================
2179 ;;;  Minibuffer Setup
2180 ;;;===========================================================================
2181
2182 (defun x-symbol-setup-minibuffer ()
2183   "Inherit buffer-local x-symbol variables for minibuffer."
2184   (let (mode language)
2185     (save-excursion
2186       (set-buffer (window-buffer minibuffer-scroll-window))
2187       (setq mode x-symbol-mode
2188             language x-symbol-language))
2189     (setq x-symbol-mode mode
2190           x-symbol-language language)))
2191 (add-hook 'minibuffer-setup-hook 'x-symbol-setup-minibuffer)
2192
2193
2194 \f
2195 ;;;;##########################################################################
2196 ;;;;  Input Methods
2197 ;;;;##########################################################################
2198
2199
2200 (defvar x-symbol-language-history nil
2201   "History of token languages, long form.
2202 See language access `x-symbol-LANG-name'.")
2203 (defvar x-symbol-token-history nil
2204   "History of tokens of any language.")
2205
2206 (defvar x-symbol-last-abbrev ""
2207   "Internal.  Used by input methods CONTEXT, ELECTRIC, TOKEN.")
2208 (defvar x-symbol-electric-pos nil
2209   "Internal.  Used by input method ELECTRIC.")
2210
2211 (defvar x-symbol-command-keys nil
2212   "Internal.  Key sequence set and used by `x-symbol-help'.
2213 Also used by temporary functions.")
2214
2215 (defvar x-symbol-help-keys nil
2216   "Internal.  Key description used by `x-symbol-help-mapper'.")
2217 (defvar x-symbol-help-language nil
2218   "Internal.  Token language used for `x-symbol-help-mapper'.")
2219 (defvar x-symbol-help-completions nil
2220   "Internal.  Characters displayed prior to others.")
2221 (defvar x-symbol-help-completions1 nil
2222   "Internal.  Characters displayed late.")
2223
2224
2225 ;;;===========================================================================
2226 ;;;  Miscellaneous key functions
2227 ;;;===========================================================================
2228
2229 (defun x-symbol-map-default-binding (&optional arg)
2230   ;; checkdoc-params: (arg)
2231   "Default binding in X-Symbol key map.
2232 Check `x-symbol-map-default-keys-alist' for commands to execute.
2233 Otherwise signal error `undefined-keystroke-sequence'."
2234   (interactive "P")
2235   (let* ((this (this-command-keys))
2236          (last (aref this (1- (length this))))
2237          (alist x-symbol-map-default-keys-alist)
2238          definition)
2239     (while alist
2240       (if (x-symbol-event-matches-key-specifier-p last (caar alist))
2241           (setq definition (car alist)
2242                 alist nil)
2243         (setq alist (cdr alist))))
2244     (if definition
2245         (let ((cmd (or (cadr definition) (key-binding (vector last)))))
2246           (if (caddr definition)
2247               (progn
2248                 (command-execute cmd)
2249                 (setq prefix-arg arg)
2250                 (setq unread-command-events x-symbol-command-keys))
2251             (setq prefix-arg arg)
2252             (command-execute cmd)))
2253       (signal-error 'undefined-keystroke-sequence (list this)))))
2254
2255
2256 ;;;===========================================================================
2257 ;;;  self-insert
2258 ;;;===========================================================================
2259
2260 (defun x-symbol-read-charsym-token (charsym)
2261   "Read one of the languages for defined tokens of CHARSYM."
2262   (let* ((token (if x-symbol-language
2263                     (car (gethash charsym (x-symbol-generated-encode-table
2264                                            (x-symbol-language-value
2265                                             'x-symbol-LANG-generated-data))))))
2266          (language (x-symbol-read-language
2267                     (format "Insert %s in token language (default %s): "
2268                             charsym
2269                             (if token
2270                                 (x-symbol-language-text)
2271                               x-symbol-charsym-name))
2272                     (if token x-symbol-language)
2273                     (lambda (lang)
2274                       (or (null (setq lang (cdr lang)))
2275                           (gethash charsym (x-symbol-generated-encode-table
2276                                             (x-symbol-language-value
2277                                              'x-symbol-LANG-generated-data
2278                                              lang))))))))
2279     (or (if language
2280             (car (gethash charsym (x-symbol-generated-encode-table
2281                                    (x-symbol-language-value
2282                                     'x-symbol-LANG-generated-data
2283                                     language)))))
2284         (symbol-name charsym))))
2285
2286 (defun x-symbol-insert-command (arg &optional charsym cstring)
2287   "Insert character for CHARSYM.
2288 If ARG is a cons, e.g., when the current command is preceded by one or
2289 more \\[universal-argument]'s with no digits, select initialized
2290 language in minibuffer for token to insert.  Otherwise insert character
2291 abs(ARG) times.  If ARG is negative, do not barf if character is not
2292 valid, see `x-symbol-valid-charsym-function'.
2293
2294 Restore window configuration if necessary, see `x-symbol-list-restore'.
2295 If buffer is read-only, store in `kill-ring'.  If optional argument
2296 CSTRING is non-nil, insert that string instead the character.  Optional
2297 CHARSYM defaults to `this-command's symbol property `x-symbol-charsym'."
2298   (interactive "P")
2299   (x-symbol-list-restore)
2300   (or charsym (setq charsym (get this-command 'x-symbol-charsym)))
2301   (if cstring
2302       (setq charsym nil)
2303     (if (consp arg)
2304         (setq cstring (x-symbol-read-charsym-token charsym)
2305               charsym nil
2306               arg -1)
2307       (setq cstring (gethash charsym x-symbol-cstring-table))))
2308   (cond (isearch-mode
2309          (if cstring (isearch-process-search-string cstring cstring)))
2310         ((null cstring)
2311          (error "Charsym %s has no character" charsym))
2312         (buffer-read-only
2313          (kill-new cstring)
2314          (display-message 'message
2315            (if charsym
2316                (x-symbol-info charsym x-symbol-language nil
2317                               (x-symbol-fancy-value 'x-symbol-info-intro-yank
2318                                                     'substitute-command-keys))
2319              (concat (x-symbol-fancy-value 'x-symbol-info-intro-yank
2320                                            'substitute-command-keys)
2321                      cstring))))
2322         (t
2323          (if (natnump (setq arg (prefix-numeric-value arg)))
2324              (or buffer-read-only
2325                  (null charsym)
2326                  (funcall x-symbol-valid-charsym-function charsym)
2327                  (error "Charsym %s not valid in current buffer" charsym))
2328            (setq arg (- arg)))
2329          (while (>= (decf arg) 0) (insert cstring)))))
2330
2331
2332 ;;;===========================================================================
2333 ;;;  Read token
2334 ;;;===========================================================================
2335
2336 ;;;###autoload
2337 (defun x-symbol-read-language (prompt default &optional predicate)
2338   "Read token language in the minibuffer with completion.
2339 Use PROMPT in minibuffer.  If the inserted string is empty, use DEFAULT
2340 as return value.  If PREDICATE non-nil, only match languages if
2341 PREDICATE with argument (NAME . LANGUAGE) returns non-nil."
2342   (let* ((languages (cons (cons x-symbol-charsym-name nil)
2343                           (mapcar (lambda (x) (cons (cdr x) (car x)))
2344                                   x-symbol-language-alist)))
2345          (completion-ignore-case t)
2346          (language (completing-read prompt languages predicate t nil
2347                                     'x-symbol-language-history)))
2348     (if (string-equal language "")
2349         default
2350       (cdr (assoc language languages)))))
2351
2352 (defun x-symbol-read-token (&optional arg currentp)
2353   "Select language and token to insert a character.
2354 Use `x-symbol-language' if optional CURRENTP is non-nil.  If a number or
2355 nil, argument ARG is passed to `x-symbol-insert-command'."
2356   (interactive "P")
2357   (let* ((arg-strings (x-symbol-prefix-arg-texts arg))
2358          (language (if currentp
2359                        x-symbol-language
2360                      (x-symbol-read-language
2361                       (format "Select %s by token language (current %s): "
2362                               (car arg-strings) (x-symbol-language-text))
2363                       x-symbol-language)))
2364          (decode-obarray (if language
2365                              (x-symbol-generated-decode-obarray
2366                               (x-symbol-language-value
2367                                'x-symbol-LANG-generated-data language))
2368                            x-symbol-charsym-decode-obarray))
2369          (completion (try-completion "" decode-obarray))
2370          (completion-ignore-case (if language
2371                                      (x-symbol-grammar-case-function
2372                                       (x-symbol-language-value
2373                                        'x-symbol-LANG-token-grammar language))))
2374          (cstring (completing-read
2375                    (format "Insert %s %s: " (car arg-strings) (cdr arg-strings))
2376                    decode-obarray
2377                    (and (or (null arg) (natnump arg))
2378                         (lambda (x)
2379                           (funcall x-symbol-valid-charsym-function
2380                                    (car (symbol-value x)))))
2381                    t
2382                    (and (stringp completion) completion)
2383                    'x-symbol-token-history)))
2384     (if (string-equal cstring "")
2385         (error "No token entered")
2386       (if (consp arg)
2387           (x-symbol-insert-command -1 nil cstring)
2388         (x-symbol-insert-command
2389          arg (car (symbol-value (intern-soft cstring decode-obarray))))))))
2390
2391 (defun x-symbol-read-token-direct (&optional arg)
2392   "Select token in current language to insert a character.
2393 Argument ARG is passed to `x-symbol-insert-command'."
2394   (interactive "P")
2395   (x-symbol-read-token arg t))
2396
2397
2398 ;;;===========================================================================
2399 ;;;  GRID
2400 ;;;===========================================================================
2401
2402 ;;;###autoload
2403 (defun x-symbol-grid (&optional arg)
2404   "Displays characters in a grid-like fashion for mouse selection.
2405 Display global or language dependent grid, see `x-symbol-local-grid'.
2406 See `x-symbol-list-mode' for key and mouse bindings.  Without optional
2407 argument ARG and non-nil `x-symbol-grid-reuse', just popup old grid
2408 buffer if it already exists, but is not displayed.  Store window
2409 configuration current before the invocation if `x-symbol-temp-grid' is
2410 non-nil, see `x-symbol-list-restore'."
2411   (interactive "P")
2412   (let* ((grid-alist (and x-symbol-local-grid
2413                           x-symbol-language
2414                           (x-symbol-generated-grid-alist
2415                            (x-symbol-language-value
2416                             'x-symbol-LANG-generated-data))))
2417          (language (and grid-alist x-symbol-language))
2418          (win-config (and x-symbol-temp-grid (current-window-configuration)))
2419          ;;(ref-buffer (and x-symbol-temp-grid (current-buffer)))
2420          (ref-buffer (current-buffer))
2421          (default-enable-multibyte-characters t)
2422          (buffer (x-symbol-language-text x-symbol-grid-buffer-format))
2423          (font (and (fboundp 'face-font-instance)
2424                     (face-font-instance 'x-symbol-heading-face))))
2425     (x-symbol-init-input)
2426     (or grid-alist (setq grid-alist x-symbol-grid-alist))
2427     (and (null arg)
2428          (get-buffer buffer)
2429          (not (get-buffer-window buffer 'visible)) ; CW: new `visible'
2430          (save-excursion
2431            (set-buffer buffer)
2432            ;; CW: in XEmacs, `pop-up-frames'=t seems to be broken.
2433            (x-symbol-list-store ref-buffer win-config)
2434            (funcall (or temp-buffer-show-function 'display-buffer) buffer)
2435            (setq grid-alist nil)))      ; exit
2436     (when grid-alist
2437       (save-excursion
2438         (ignore-errors
2439           ;; CW: in XEmacs, `pop-up-frames'=t seems to be broken, ignore error
2440           (with-output-to-temp-buffer buffer))
2441         (set-buffer buffer)
2442         (if (featurep 'scrollbar)
2443             (set-specifier scrollbar-height 0 (current-buffer)))
2444         (setq truncate-lines t)
2445         (and font (featurep 'xemacs)
2446              (set-face-font 'default font (current-buffer)))
2447         (setq tab-width x-symbol-grid-tab-width)
2448         (let ((max (- (x-symbol-window-width
2449                        (get-buffer-window buffer 'visible))
2450                       x-symbol-grid-tab-width))
2451               charsyms charsym pos extent face
2452               (inhibit-read-only t))
2453           (while grid-alist
2454             (setq extent (insert-face (concat (caar grid-alist) ": ")
2455                                       'x-symbol-heading-face))
2456             (set-extent-end-glyph extent x-symbol-heading-strut-glyph)
2457
2458             (set-extent-property extent 'help-echo
2459                                  (x-symbol-fancy-value
2460                                   'x-symbol-grid-header-echo))
2461             (insert "\t")
2462             (setq charsyms (cdar grid-alist)
2463                   grid-alist (cdr grid-alist))
2464             (while charsyms
2465               (unless (memq (setq charsym (pop charsyms))
2466                             x-symbol-grid-ignore-charsyms)
2467                 (if (>= (current-column) max) (insert "\n\t"))
2468                 (setq pos (point))
2469                 (insert (gethash charsym x-symbol-fontified-cstring-table)
2470                         "\t")
2471                 (setq extent (add-list-mode-item pos (point) nil t charsym))
2472                 ;; for no-Mule -- CW: cannot be avoided, in x-symbol-nomule?
2473                 (if (fboundp 'set-extent-priority)
2474                     (set-extent-priority extent -10))
2475                 (set-extent-property extent 'help-echo 'x-symbol-highlight-echo)
2476                 (and language
2477                      (setq face (car (x-symbol-charsym-face charsym language)))
2478                      (set-extent-face extent face))))
2479             (if grid-alist (insert "\n"))))
2480         (set-buffer-modified-p nil)
2481         (x-symbol-list-mode language ref-buffer win-config)
2482         (setq tab-width x-symbol-grid-tab-width)
2483         (and font (featurep 'xemacs)
2484              (set-face-font 'default font (current-buffer)))))))
2485
2486
2487 ;;;===========================================================================
2488 ;;;  General Insertion
2489 ;;;===========================================================================
2490
2491 (defun x-symbol-replace-from (from cstring &optional ignore)
2492   "Replace buffer contents between FROM and `point' by CSTRING.
2493 If IGNORE is non-nil, the current command, which should be a
2494 self-inserting character, is ignored by providing a zero prefix
2495 argument.  Also prepare the use of `undo' and `unexpand-abbrev'."
2496   (or (stringp cstring)
2497       (setq cstring (gethash cstring x-symbol-cstring-table)))
2498   (when cstring
2499     (and ignore
2500          (null prefix-arg)
2501          (self-insert-command 1))
2502     (undo-boundary)
2503     (let ((pos (point)))
2504       (if (listp buffer-undo-list)      ; put point position on undo-list...
2505           (push pos buffer-undo-list))  ; ...necessary for aggressive CONTEXT
2506       (setq x-symbol-last-abbrev cstring ; allow use of `unexpand-abbrev'
2507             last-abbrev-location from
2508             last-abbrev 'x-symbol-last-abbrev
2509             last-abbrev-text (buffer-substring from pos))
2510       ;; `replace-region': first insert, then delete (reason: markers)
2511       (insert-before-markers cstring)
2512       (delete-region from pos)
2513       (if ignore (setq prefix-arg 0))
2514       (setq abbrev-start-location pos   ; this hack stops expand-abbrev
2515             abbrev-start-location-buffer (current-buffer)))
2516     (undo-boundary)
2517     t))
2518
2519
2520 ;;;===========================================================================
2521 ;;;  Input method TOKEN
2522 ;;;===========================================================================
2523
2524 ;; Hint: if you trace one of these function in XEmacs, you break the handling
2525 ;; of consecutive `self-insert-command's...
2526
2527 (defvar x-symbol-token-search-prelude-size 10)
2528
2529 (defun x-symbol-replace-token (&optional command-char)
2530   "Replace token by corresponding character.
2531 If COMMAND-STRING is non-nil, check token shape."
2532   (let* ((grammar (x-symbol-language-value 'x-symbol-LANG-token-grammar))
2533          (generated (x-symbol-language-value 'x-symbol-LANG-generated-data))
2534          (decode-obarray (x-symbol-generated-decode-obarray generated))
2535          (case-fold-search (x-symbol-grammar-case-function ;#dynamic
2536                             (x-symbol-language-value
2537                              'x-symbol-LANG-token-grammar)))
2538          (input-regexp (x-symbol-grammar-input-regexp grammar))
2539          (input-spec (x-symbol-grammar-input-spec grammar))
2540          (beg (- (point) (x-symbol-generated-max-token-len generated)
2541                  x-symbol-token-search-prelude-size))
2542          (res (save-excursion
2543                 (save-restriction
2544                   (narrow-to-region (max beg (point-at-bol)) (point))
2545                   (if (functionp input-spec)
2546                       (funcall input-spec input-regexp decode-obarray
2547                                command-char)
2548                     (x-symbol-match-token-before input-spec
2549                                                  input-regexp
2550                                                  decode-obarray
2551                                                  command-char))))))
2552     (if res (x-symbol-replace-from (car res) (cadr res)))))
2553
2554 (defun x-symbol-match-token-before (contexts token-regexps decode-obarray
2555                                              command-char)
2556   (let ((case-fn (if (functionp case-fold-search) case-fold-search))
2557         (before-context (car contexts))
2558         (after-context (cdr contexts))
2559         token charsym beg esc-char shape bad-regexp)
2560     (when (characterp before-context)
2561       (or (memq before-context '(?\ ?\t ?\n ?\r nil)) ; or warning?
2562           (setq esc-char before-context))
2563       (setq before-context nil))
2564     (or before-context after-context (setq contexts nil))
2565
2566     (or (listp token-regexps) (setq token-regexps (list token-regexps)))
2567     (while token-regexps
2568       (goto-char (point-min))
2569       (and (re-search-forward (pop token-regexps) nil t)
2570            (setq beg (match-beginning 0))
2571            (eobp)                       ; regexp should always end with \\'
2572            (setq token
2573                  (symbol-value
2574                   (intern-soft
2575                    (if case-fn
2576                        (funcall case-fn (buffer-substring beg (point-max)))
2577                      (buffer-substring beg (point-max)))
2578                    decode-obarray)))
2579            (cond ((and esc-char (eq (char-before beg) esc-char)
2580                        (x-symbol-even-escapes-before-p (1- beg) esc-char)))
2581                  ((not (and contexts (setq shape (cadr token))))
2582                   (if (setq charsym (car token)) (setq token-regexps nil)))
2583                  ((and (setq bad-regexp (assq shape after-context))
2584                        (not (memq command-char '(?\ ?\t ?\n ?\r nil)))
2585                        (string-match (cdr bad-regexp)
2586                                      (char-to-string command-char))))
2587                  ((and (setq bad-regexp (assq shape before-context))
2588                        (not (memq (char-before beg) '(?\ ?\t ?\n ?\r nil)))
2589                        (string-match (cdr bad-regexp)
2590                                      (char-to-string (char-before beg)))))
2591                  ((setq charsym (car token))
2592                   (setq token-regexps nil)))))
2593     (and charsym
2594          (not (and x-symbol-unique (cddr token)))
2595          (funcall x-symbol-valid-charsym-function charsym)
2596          (cons beg token))))
2597
2598 (defun x-symbol-token-input ()
2599   "Provide input method TOKEN.
2600 Called in `x-symbol-pre-command-hook', see `x-symbol-token-input'."
2601   (cond ((not (and x-symbol-language x-symbol-token-input)))
2602         ((and prefix-arg (not (zerop (prefix-numeric-value prefix-arg)))))
2603         ((and (symbolp this-command)
2604               (fboundp this-command)
2605               (or (get this-command 'x-symbol-input)
2606                   (and (symbolp (symbol-function this-command))
2607                        (get (symbol-function this-command) 'x-symbol-input))))
2608          (x-symbol-replace-token))
2609         ((not (eq this-command 'self-insert-command)))
2610         (t
2611          (x-symbol-replace-token (if prefix-arg nil last-command-char)))))
2612
2613
2614 ;;;===========================================================================
2615 ;;;  Input method context
2616 ;;;===========================================================================
2617
2618 ;;;###autoload
2619 (defun x-symbol-modify-key (&optional beg end)
2620   "Modify key for input method CONTEXT.
2621 If character before point is a char alias, resolve alias, see
2622 \\[x-symbol-unalias].  If character before point is a character
2623 supported by package x-symbol, replace it by the next valid character in
2624 the modify-to chain.
2625
2626 Otherwise replace longest context before point by a character which
2627 looks similar to it.  See also \\[x-symbol-rotate-key] and
2628 `x-symbol-electric-input'.  If called interactively and if the region is
2629 active, restrict context to the region between BEG and END."
2630   (interactive (and (region-active-p)
2631                     (list (region-beginning) (region-end))))
2632   (if (and beg end)
2633       (save-excursion
2634         (save-restriction
2635           (narrow-to-region beg end)
2636           (goto-char (point-max))
2637           (x-symbol-modify-key)))
2638     (x-symbol-init-input)
2639     (let ((pos+charsym (or (x-symbol-valid-context-charsym
2640                             x-symbol-context-atree 'x-symbol-modify-to)
2641                            (x-symbol-next-valid-charsym-before
2642                             'x-symbol-modify-to 'x-symbol-rotate-to))))
2643       (if (and pos+charsym
2644                (null (x-symbol-call-function-or-regexp
2645                       x-symbol-context-ignore
2646                       (buffer-substring (car pos+charsym) (point))
2647                       (cdr pos+charsym))))
2648           (x-symbol-replace-from (car pos+charsym) (cdr pos+charsym))
2649         (error "Nothing to modify")))))
2650
2651 ;;;###autoload
2652 (defun x-symbol-rotate-key (&optional arg beg end)
2653   "Rotate key for input method CONTEXT.
2654 If character before point is a char alias, resolve alias, see
2655 \\[x-symbol-unalias].  If character before point is a character
2656 supported by package x-symbol, replace it by the next valid character in
2657 the rotate-to chain.  With optional prefix argument ARG, the
2658 \"direction\" of the new character should be according to ARG and
2659 `x-symbol-rotate-prefix-alist'.
2660
2661 Otherwise replace longest context before point by a character which
2662 looks similar to it, assuming an additional context suffix
2663 `x-symbol-rotate-suffix-char'.  See also \\[x-symbol-modify-key] and
2664 `x-symbol-electric-input'.  If called interactively and if the region is
2665 active, restrict context to the region between BEG and END."
2666   (interactive (cons current-prefix-arg
2667                      (and (region-active-p)
2668                           (list (region-beginning) (region-end)))))
2669   (if (and beg end)
2670       (save-excursion
2671         (save-restriction
2672           (narrow-to-region beg end)
2673           (goto-char (point-max))
2674           (x-symbol-rotate-key arg)))
2675     (x-symbol-init-input)
2676     (if arg
2677         (let* ((pos+charsym (x-symbol-charsym-after (1- (point))))
2678                (charsym (cdr pos+charsym))
2679                (direction (assq (prefix-numeric-value arg)
2680                                 x-symbol-rotate-prefix-alist)))
2681           (if charsym
2682               (if direction
2683                   (if (setq charsym
2684                             (x-symbol-next-valid-charsym
2685                              charsym (cdr direction) 'x-symbol-rotate-to))
2686                       (x-symbol-replace-from (car pos+charsym) charsym)
2687                     (error "Cannot rotate %s to direction %s"
2688                            (cdr pos+charsym) (cdr direction)))
2689                 (error "Prefix argument %s does not represent a valid direction"
2690                        arg))
2691             (error "Nothing to rotate")))
2692       (let ((pos+charsym (or (x-symbol-valid-context-charsym
2693                               (assq x-symbol-rotate-suffix-char
2694                                     x-symbol-context-atree)
2695                               'x-symbol-modify-to)
2696                              (x-symbol-next-valid-charsym-before
2697                               'x-symbol-rotate-to 'x-symbol-modify-to))))
2698         (if (and pos+charsym
2699                  (null (x-symbol-call-function-or-regexp
2700                         x-symbol-context-ignore
2701                         (buffer-substring (car pos+charsym) (point))
2702                         (cdr pos+charsym))))
2703             (x-symbol-replace-from (car pos+charsym) (cdr pos+charsym))
2704           (error "Nothing to rotate"))))))
2705
2706 (defun x-symbol-electric-input ()
2707   "Provide input method ELECTRIC.
2708 Called in `x-symbol-post-command-hook', see `x-symbol-electric-input'."
2709   (setq x-symbol-electric-pos
2710         (and x-symbol-electric-input
2711              x-symbol-mode
2712              (symbolp this-command)
2713              (fboundp this-command)
2714              (or (eq this-command 'self-insert-command)
2715                  (get this-command 'x-symbol-input)
2716                  (and (symbolp (symbol-function this-command))
2717                       (get (symbol-function this-command) 'x-symbol-input)))
2718              (null current-prefix-arg)
2719              (not (and (local-variable-p 'current-input-method (current-buffer))
2720                        (equal current-input-method "x-symbol")))
2721              (or x-symbol-electric-pos (1- (point)))))
2722   (if x-symbol-electric-pos
2723       (let ((pos+charsym (x-symbol-valid-context-charsym
2724                           x-symbol-electric-atree))
2725             context)
2726         (and pos+charsym
2727              (>= (car pos+charsym) x-symbol-electric-pos)
2728              (setq context (buffer-substring (car pos+charsym) (point)))
2729              (or (let ((pos+charsym2 (x-symbol-valid-context-charsym
2730                                       x-symbol-context-atree)))
2731                    (and pos+charsym2
2732                         (> (car pos+charsym) (car pos+charsym2)))) ; suffix
2733                  (x-symbol-call-function-or-regexp
2734                   x-symbol-context-ignore context (cdr pos+charsym))
2735                  (x-symbol-call-function-or-regexp
2736                   x-symbol-electric-ignore context (cdr pos+charsym))
2737                  (x-symbol-call-function-or-regexp
2738                   (x-symbol-language-value 'x-symbol-LANG-electric-ignore)
2739                   context (cdr pos+charsym))
2740                  (x-symbol-replace-from (car pos+charsym)
2741                                         (cdr pos+charsym)))))))
2742
2743
2744 ;;;===========================================================================
2745 ;;;  Keyboard Completion Help
2746 ;;;===========================================================================
2747
2748 (defun x-symbol-help-mapper (key binding)
2749   "Collect help for specific KEY with BINDING."
2750   (let ((x-symbol-help-keys (cons (single-key-description key)
2751                                   x-symbol-help-keys))
2752         charsym)
2753     (if (keymapp binding)
2754         (map-keymap #'x-symbol-help-mapper binding t)
2755       (and (commandp binding)
2756            (symbolp binding)
2757            (setq charsym (get binding 'x-symbol-charsym))
2758            (or (eq x-symbol-help-language t)
2759                (funcall x-symbol-valid-charsym-function charsym
2760                         x-symbol-help-language))
2761            (if (or (cdr x-symbol-help-keys)
2762                    (null (member (car x-symbol-help-keys)
2763                                  (eval-when-compile
2764                                    (mapcar 'single-key-description
2765                                            (append "1234567890" nil))))))
2766                (push (cons x-symbol-help-keys charsym)
2767                      x-symbol-help-completions)
2768              (push (cons x-symbol-help-keys charsym)
2769                    x-symbol-help-completions1))))))
2770
2771 (defun x-symbol-help-output (arg keys)
2772   "Popup completions buffer for KEYS with prefix argument ARG."
2773   (let ((win-config (and x-symbol-temp-help (current-window-configuration)))
2774         (ref-buffer (current-buffer))
2775         (read-only buffer-read-only)
2776         (mode-on x-symbol-mode)
2777         (language x-symbol-language)
2778         (default-enable-multibyte-characters t)
2779         (arg-texts (x-symbol-prefix-arg-texts arg)))
2780     (with-output-to-temp-buffer x-symbol-completions-buffer
2781       (save-excursion
2782         (set-buffer x-symbol-completions-buffer)
2783         (message "Working...")
2784         (setq ctl-arrow 'ts)            ; non-t-non-nil
2785         (insert "You are typing a x-symbol key sequence to insert a "
2786                 (car arg-texts) " " (cdr arg-texts)
2787                 (if read-only "\ninto read-only buffer \"" "\ninto buffer \"")
2788                 (buffer-name ref-buffer)
2789                 (if language
2790                     (x-symbol-language-text
2791                      (if mode-on "\" (%s)" "\" (%s, turned-off)")
2792                      language)
2793                   "\"")
2794                 ".\nSo far you have typed \""
2795                 (key-description keys)
2796                 "\".  "
2797                 (if (eq x-symbol-help-language t)
2798                     "Completions from here are:\n"
2799                   "Valid completions from here are:\n"))
2800         (while x-symbol-help-completions
2801           (insert "\n")
2802           (let ((completion (pop x-symbol-help-completions))
2803                 (start (point)))
2804             (when completion
2805               (insert (mapconcat #'identity (reverse (car completion)) " "))
2806               ;; no nreverse!
2807               (indent-to 16)
2808               (insert (x-symbol-info (cdr completion) language nil ""))
2809               (set-extent-property
2810                (add-list-mode-item start (point) nil t (cdr completion))
2811                'help-echo 'x-symbol-highlight-echo))))
2812         (x-symbol-list-mode language ref-buffer win-config)))))
2813
2814 (defun x-symbol-help (&optional arg)
2815   ;; checkdoc-params: (arg)
2816   "Display some help during a x-symbol key sequence.
2817 Displays some info for all characters which can be inserted by a key
2818 sequence starting with the current one.  See `x-symbol-temp-help'."
2819   (interactive "P")
2820   (setq x-symbol-command-keys
2821         (or (nbutlast (append (this-command-keys) nil))
2822             x-symbol-command-keys))
2823   (setq x-symbol-help-language
2824         (or (consp arg) (< (prefix-numeric-value arg) 0)
2825             (and x-symbol-mode x-symbol-language)))
2826   (let* ((keys (apply 'vector x-symbol-command-keys))
2827          (map (key-binding keys)))
2828     (while (and x-symbol-command-keys (not (keymapp map)))
2829       (setq x-symbol-command-keys (cdr x-symbol-command-keys)
2830             keys (apply 'vector x-symbol-command-keys)
2831             map (key-binding keys)))
2832     (or x-symbol-command-keys
2833         (error "Can't find map?  %s" (this-command-keys)))
2834     (setq x-symbol-help-completions nil
2835           x-symbol-help-completions1 nil)
2836     (map-keymap #'x-symbol-help-mapper map t)
2837     (setq x-symbol-help-completions
2838           (if x-symbol-help-completions1
2839               (nconc (nreverse x-symbol-help-completions1)
2840                      (list nil) ; not! '(nil)
2841                      (nreverse x-symbol-help-completions))
2842             (nreverse x-symbol-help-completions))
2843           x-symbol-help-completions1 nil)
2844     (if x-symbol-help-completions
2845         (progn
2846           (x-symbol-help-output arg keys)
2847           ;; the code in x11/x-compose doesn't work here, this is easier anyway
2848           (setq prefix-arg arg)
2849           (setq unread-command-events x-symbol-command-keys))
2850       (ding)   ; CW: was (ding nil 'no-completion), not that important...
2851       (message (if (eq x-symbol-help-language t)
2852                    "%s [No completions]"
2853                  "%s [No valid completions]")
2854                (key-description keys))
2855       ;; don't remember key sequence prefix until now
2856       (setq x-symbol-command-keys nil
2857             unread-command-events nil))))
2858       ;;;(x-symbol-shrink-grid-buffer display))
2859
2860
2861 \f
2862 ;;;;##########################################################################
2863 ;;;;  Init code
2864 ;;;;##########################################################################
2865
2866
2867 (defvar x-symbol-face-docstrings
2868    '("Face used for normal characters."
2869      "Face used for subscripts."
2870      "Face used for superscripts.")
2871    "Docstrings for special x-symbol faces.")
2872
2873 (defvar x-symbol-all-key-prefixes nil
2874   "Internal.  Key prefixes not shorter than `x-symbol-key-min-length'.")
2875 (defvar x-symbol-all-key-chain-alist nil
2876   "Internal.  Alist with elements (CONTEXT CHARSYM...).")
2877 (defvar x-symbol-all-horizontal-chain-alist nil
2878   "Internal.  Alist with elements (MODIFY-CONTEXT CHARSYM...).")
2879 (defvar x-symbol-all-chain-subchains-alist nil
2880   "Internal.  Alist with elements (CHAIN-REP (FIRST . LAST)...).")
2881 (defvar x-symbol-all-exclusive-context-alist nil
2882   "Internal.  Alist with elements (MODIFY-CONTEXT . CHAIN-REP).")
2883
2884
2885 ;;;===========================================================================
2886 ;;;  Tiny functions
2887 ;;;===========================================================================
2888
2889 (defalias 'x-symbol-table-grouping 'car)
2890 (defalias 'x-symbol-table-aspects 'cadr)
2891 (defalias 'x-symbol-table-score 'caddr)
2892 (defalias 'x-symbol-table-input 'cadddr)
2893 (defsubst x-symbol-table-prefixes (xs) (nth 4 xs))
2894 (defsubst x-symbol-table-junk (xs) (nthcdr 5 xs))
2895
2896 (defsubst x-symbol-charsym-defined-p (charsym)
2897   (get charsym 'x-symbol-score))
2898
2899
2900 ;;;===========================================================================
2901 ;;;  Init code per cset, called from x-symbol-{mule/nomule}
2902 ;;;===========================================================================
2903
2904 (defun x-symbol-try-font-name-0 (font raise)
2905   (let ((sizes x-symbol-font-sizes)
2906         (idx 0)
2907         size args)
2908     (while sizes
2909       (if (string-match (caar sizes) font)
2910           (setq size (cdar sizes)
2911                 sizes nil)
2912         (setq sizes (cdr sizes))))
2913     (setq size (or (nth raise size) (car (last size))
2914                    (if (zerop raise) 14 12)))
2915     (while (string-match "%d" font idx)
2916       (push size args)
2917       (setq idx (match-end 0)))
2918     (when (string-match "%s" font)
2919       (push (nth raise x-symbol-font-family-postfixes) args))
2920     (if args (apply 'format font args) font)))
2921
2922 (defun x-symbol-try-font-name (fonts &optional raise)
2923   "Return name of first valid font in FONTS."
2924   (when fonts
2925     (let ((fonts1 fonts) result)
2926       (while fonts1
2927         (if (setq result (try-font-name
2928                           (x-symbol-try-font-name-0 (car fonts1) (or raise 0))))
2929             (setq fonts1 nil)
2930           (setq fonts1 (cdr fonts1))))
2931       (unless (or result (null raise))
2932         (lwarn 'x-symbol 'warning
2933           "Cannot find font in %s"
2934           (mapconcat (lambda (f) (x-symbol-try-font-name-0 f raise))
2935                      fonts
2936                      ", ")))
2937       result)))
2938
2939 (defun x-symbol-set-cstrings (charsym coding cstring fchar face)
2940   "Set cstrings of CHARSYM to CSTRING.
2941 Set string with duplicatable text property FACE.  Also set file and buffer
2942 cstrings if CODING is non-nil.  File cstrings are the representation as
2943 8bit characters in file with encoding CODING.  Buffer cstrings are the
2944 representation in the buffer.  Prefer using the buffer-cstring in
2945 `x-symbol-default-coding' as the default cstring, all other cstrings
2946 will be considered as char aliases, see \\[x-symbol-unalias]."
2947   (unless (and coding
2948                (let ((fchar-table (cdr (assq coding x-symbol-fchar-tables)))
2949                      (bchar-table (cdr (assq coding x-symbol-bchar-tables))))
2950                  (unless fchar-table    ; for 96 chars
2951                    (setq fchar-table
2952                          ;; Emacs uses :size directly, XEmacs uses higher prime
2953                          (make-hash-table :size 113 :test 'eq)) ; (primep 113)
2954                    (setq x-symbol-fchar-tables
2955                          (nconc x-symbol-fchar-tables
2956                                 (list (cons coding fchar-table)))))
2957                  (puthash charsym fchar fchar-table)
2958
2959                  (unless bchar-table    ; for 96 chars
2960                    (setq bchar-table
2961                          ;; Emacs uses :size directly, XEmacs uses higher prime
2962                          (make-hash-table :size 113 :test 'eq)) ; (primep 113)
2963                    (setq x-symbol-bchar-tables
2964                          (nconc x-symbol-bchar-tables
2965                                 (list (cons coding bchar-table)))))
2966                  (puthash charsym cstring bchar-table)
2967                  (not (eq coding (or x-symbol-default-coding 'iso-8859-1))))
2968                (gethash charsym x-symbol-cstring-table))
2969     (or (stringp cstring) (setq cstring (char-to-string cstring)))
2970     (puthash charsym cstring x-symbol-cstring-table)
2971     (puthash charsym
2972              (if face
2973                  (let ((copy (copy-sequence cstring)))
2974                    (put-text-property 0 (length copy) 'face face copy)
2975                    copy)
2976                cstring)
2977              x-symbol-fontified-cstring-table)))
2978
2979
2980 ;;;===========================================================================
2981 ;;;  Init code per cset, MAIN: `x-symbol-init-cset'
2982 ;;;===========================================================================
2983
2984 (defun x-symbol-init-charsym-command (charsym)
2985   "Init self insert command for CHARSYM.  See `x-symbol-insert-command'."
2986   (let ((command (intern (format "x-symbol-INSERT-%s" charsym))))
2987     (fset command 'x-symbol-insert-command)
2988     (put charsym 'x-symbol-insert-command command)
2989     (put command 'isearch-command t)
2990     (put command 'x-symbol-charsym charsym)))
2991
2992 (defun x-symbol-init-charsym-input (charsym grouping score cset-score input
2993                                             prefixes)
2994   "Check and init input definitions for CHARSYM.
2995 Set GROUPING, SCORE, CSET-SCORE, INPUT, PREFIXES according to
2996 `x-symbol-init-cset'."
2997   (let* ((group (car grouping))
2998          (ginput (cdr (assq group x-symbol-group-input-alist)))
2999          (subgroup (cadr grouping))
3000          (opposite (caddr grouping))
3001          (ascii (cadddr grouping))
3002          (syntax (cdr (assq group x-symbol-group-syntax-alist)))
3003          (syntax-special (assq subgroup (cdr syntax)))
3004          context-strings electric-strings electric-ok
3005          (case-fold-search nil))
3006     (unless ginput
3007       (warn "X-Symbol charsym %s: undefined group %S" charsym group)
3008       (setq group nil
3009             ginput '(0)))
3010     (and subgroup (symbolp subgroup)
3011          (setq subgroup (cdr (assq subgroup x-symbol-subgroup-string-alist))))
3012     (unless (or (stringp subgroup) (null subgroup))
3013       (warn "X-Symbol charsym %s: illegal subgroup %S" charsym (cadr grouping))
3014       (setq subgroup nil))
3015     (unless (symbolp opposite)
3016       (warn "X-Symbol charsym %s: illegal opposite %S" charsym opposite)
3017       (setq opposite nil))
3018     (unless (or (stringp ascii) (null ascii))
3019       (warn "X-Symbol charsym %s: illegal Ascii representation %S"
3020             charsym ascii)
3021       (setq ascii nil))
3022     (if (numberp score)
3023         (setq score (+ score (car ginput)))
3024       (if score (warn "X-Symbol charsym %s: illegal score %S" charsym score))
3025       (setq score (car ginput)))
3026     (and (null input)
3027          (stringp subgroup)
3028          (progn
3029            (setq input (mapcar (lambda (x)
3030                                  (if (stringp x) (format x subgroup) x))
3031                                (cdr ginput)))
3032            ;; accents: not only use "' " and " '", use "'" also
3033            (and (string-equal subgroup " ")
3034                 (progn
3035                   (while (eq (car (setq ginput (cdr ginput))) t))
3036                   (stringp (car ginput)))
3037                 (push (format (car ginput) "") input))))
3038     (dolist (context (reverse input))
3039       (cond ((stringp context)
3040              (push context context-strings)
3041              (setq electric-ok t))
3042             ((not (eq context t))
3043              (warn "X-Symbol charsym %s: illegal input element %S"
3044                    charsym context))
3045             (electric-ok
3046              (push (car context-strings) electric-strings)
3047              (setq electric-ok nil))
3048             (t
3049              (warn "X-Symbol charsym %s: misuse of input tag `t'" charsym))))
3050     (put charsym 'x-symbol-grouping
3051          (and group (list group subgroup opposite ascii)))
3052     (put charsym 'x-symbol-syntax
3053          (and syntax (cons (car syntax)
3054                            (and syntax-special opposite
3055                                 (cons (cdr syntax-special) opposite)))))
3056     (put charsym 'x-symbol-score (+ cset-score score))
3057     (put charsym 'x-symbol-context-strings context-strings)
3058     (put charsym 'x-symbol-electric-strings electric-strings)
3059     (put charsym 'x-symbol-electric-prefixes prefixes)))
3060
3061 (defun x-symbol-init-charsym-aspects (charsym aspects)
3062   "Check and init ASPECTS of CHARSYM.  See `x-symbol-init-cset'."
3063   (let (modify-aspects
3064         rotate-aspects
3065         aspect value type)
3066     (while (consp aspects)
3067       (setq aspect (pop aspects)
3068             value (and (consp aspects) (pop aspects)))
3069       (cond ((setq type (assq aspect x-symbol-modify-aspects-alist))
3070              (if (assq value (cdr type))
3071                  (setq modify-aspects (plist-put modify-aspects aspect value))
3072                (warn "X-Symbol charsym %s: illegal modify aspect %s:%s"
3073                      charsym aspect value)))
3074             ((setq type (assq aspect x-symbol-rotate-aspects-alist))
3075              (if (assq value (cdr type))
3076                  (setq rotate-aspects (plist-put rotate-aspects aspect value))
3077                (warn "X-Symbol charsym %s: illegal rotate aspect %s:%s"
3078                      charsym aspect value)))
3079             (t
3080              (warn "X-Symbol charsym %s: illegal aspect %s:%s"
3081                    charsym aspect value))))
3082     (unless (symbolp aspects)
3083       (warn "X-Symbol charsym %s: illegal parent %S" charsym aspects)
3084       (setq aspects nil))
3085     (put charsym 'x-symbol-modify-aspects (cons nil modify-aspects))
3086     (put charsym 'x-symbol-rotate-aspects (cons nil rotate-aspects))
3087     (put charsym 'x-symbol-parent (or aspects charsym))))
3088
3089 (eval-when-compile (defvar x-symbol-no-of-charsyms))
3090
3091 (defun x-symbol-init-cset (cset fonts table)
3092   "Define and initialize a new character set.
3093 CSET looks like
3094   (((REGISTRY . CODING) LEADING CSET-SCORE) MULE-LEFT . MULE-RIGHT)
3095
3096 REGISTRY is the charset registry of the fonts in FONTS.  If CODING is
3097 non-nil, characters defined in TABLE are considered to be 8bit
3098 characters if `x-symbol-coding' has value CODING.  CSET-SCORE is the
3099 base score for characters defined in TABLE, see below.
3100
3101 Under XEmacs/no-Mule, cstrings for characters defined in TABLE consist
3102 of the character LEADING and the octet ENCODING, explained below, if
3103 CODING is different to `x-symbol-default-coding'.  LEADING should be in
3104 the range \\200-\\237.
3105
3106 Under XEmacs/Mule, MULE-LEFT and MULE-RIGHT are used.  They look like
3107   nil or (NAME) or (NAME DOCSTRING CHARS FINAL)
3108 With the first form, no charset is used in that half of the font.  With
3109 the second form, it is assumed that there exists a charset NAME.  The
3110 third forms defines a new charset with name NAME, docstring DOCSTRING
3111 and the charset properties CHARS and FINAL, see `make-charset' for
3112 details.
3113
3114 FONTS look like (NORMAL-FONT SUBSCRIPT-FONT SUPERSCRIPT-FONT) where each
3115 FONT is a list of fonts.  They are tried until the first which is
3116 installed on your system, see `try-font-name'.
3117
3118 Each element of TABLE looks like:
3119   (CHARSYM ENCODING GROUPING ASPECTS SCORE INPUT PREFIXES) or
3120   (CHARSYM ENCODING . t)
3121 Its character descriptions, not the ENCODING, can be shadowed by
3122 elements in `x-symbol-user-table'.
3123
3124 Define a character with \"descriptions\" in current cset with encoding
3125 ENCODING.  It is represented by the symbol CHARSYM.  If CHARSYM already
3126 represents another character, the second form is used.  This is only
3127 useful if both definitions were defined for csets with non-nil CODING.
3128 In this case, only one of the characters are normally used, the others
3129 are char aliases, see \\[x-symbol-unalias].
3130
3131 GROUPING = (GROUP SUBGROUP OPPOSITE ASCII).  GROUP defines the grid and
3132 submenu headers of the character, see `x-symbol-header-groups-alist'.
3133 SUBGROUP with `x-symbol-subgroup-string-alist' defines some order in the
3134 grid.  OPPOSITE is used for \\[x-symbol-rotate-key] if no other
3135 character in the rotate chain has been defined.  ASCII is the ascii
3136 representation, see `x-symbol-translate-to-ascii'.
3137
3138 GROUP and SUBGROUP define the default INPUT and SCORE, see below and
3139 `x-symbol-group-input-alist', and default ascii representations, see
3140 `x-symbol-charsym-ascii-groups'.  GROUP, SUBGROUP and OPPOSITE define
3141 the char syntax under XEmacs/Mule, see `x-symbol-group-syntax-alist'.
3142
3143 ASPECTS = PARENT | (ASPECT VALUE . PARENT).  Define modify and rotate
3144 aspects with corresponding values, see `x-symbol-modify-aspects-alist'
3145 and `x-symbol-rotate-aspects-alist'.  If PARENT is non-nil, CHARSYM and
3146 PARENT are in the same component and CHARSYM inherits all remaining
3147 aspects from PARENT which should be defined in the same or earlier csets
3148 as the original definition of CHARSYM.  See `x-symbol-init-input'.
3149
3150 The charsym score is the addition of SCORE, or 0 if nil, the GROUP
3151 SCORE, see `x-symbol-group-input-alist', and CSET-SCORE, see above.
3152
3153 INPUT = nil | (CONTEXT . INPUT) | (t CONTEXT . INPUT).  Contexts
3154 defining key bindings and contexts for input method context.  If CONTEXT
3155 is prefixed by t, it is also a context for input method electric.  The
3156 first CONTEXT is called modify context and determines the modify-to
3157 chain.  If INPUT is nil, use INPUT from `x-symbol-group-input-alist'
3158 with substitutions SUBGROUP/%s.  See `x-symbol-init-input' for details.
3159
3160 PREFIXES are charsyms which are considered prefixes for input method
3161 electric.  Default prefixes are provided, though."
3162   (let ((size (if (featurep 'xemacs)
3163                   x-symbol-no-of-charsyms
3164                 (x-symbol-get-prime-for x-symbol-no-of-charsyms))))
3165     (unless x-symbol-cstring-table
3166       (setq x-symbol-cstring-table
3167             (make-hash-table :size size :test 'eq)))
3168     (unless x-symbol-fontified-cstring-table
3169       (setq x-symbol-fontified-cstring-table
3170             (make-hash-table :size size :test 'eq)))
3171     (unless x-symbol-charsym-decode-obarray
3172       (setq x-symbol-charsym-decode-obarray
3173             (make-vector (x-symbol-get-prime-for x-symbol-no-of-charsyms) 0))))
3174   ;;--------------------------------------------------------------------------
3175   (setq x-symbol-input-initialized nil)
3176   (let* ((faces (x-symbol-make-cset cset
3177                                     (if (stringp (car fonts))
3178                                         (list fonts fonts fonts)
3179                                       fonts)))
3180          (cset-score (x-symbol-cset-score cset))
3181          (coding (x-symbol-cset-coding cset))
3182          (force-use (or x-symbol-latin-force-use
3183                         (eq (or x-symbol-default-coding 'iso-8859-1) coding)))
3184          new-charsyms)
3185     (unless faces
3186       (when fonts
3187         (warn (if (and coding force-use)
3188                   "X-Symbol characters with registry %S will look strange"
3189                 "X-Symbol characters with registry %S are not used")
3190               (x-symbol-cset-registry cset))))
3191     (dolist (entry table)
3192       (let ((charsym (car entry))
3193             definition)
3194         (if (or faces (and coding force-use))
3195             (x-symbol-make-char cset (cadr entry) charsym (car faces) coding))
3196         (set (intern (symbol-name charsym) x-symbol-charsym-decode-obarray)
3197              (list charsym))
3198         (if (memq (cddr entry) '(t unused))
3199             (if coding
3200                 (if (x-symbol-charsym-defined-p charsym)
3201                     (if (eq (cddr entry) 'unused)
3202                         (warn "X-Symbol charsym %s: redefinition as unused"
3203                               charsym))
3204                   (if (eq (cddr entry) 'unused)
3205                       (push charsym new-charsyms)
3206                     (warn "X-Symbol charsym %s: alias without definition"
3207                           charsym)))
3208               (warn "X-Symbol charsym %s: alias or unused without coding system"
3209                     charsym))
3210           (if (x-symbol-charsym-defined-p charsym)
3211               (progn
3212                 (warn "X-Symbol charsym %s: redefinition (not used)" charsym)
3213                 (or (assq charsym new-charsyms)
3214                     (assq charsym x-symbol-all-charsyms)
3215                     (push charsym new-charsyms))) ; ie, re-run
3216             (push charsym new-charsyms)
3217             (setq definition (cddr (or (assq charsym x-symbol-user-table)
3218                                        entry)))
3219             (when (x-symbol-table-junk definition)
3220               (warn "X-Symbol charsym %s: unused elements in definition"
3221                     charsym))
3222             (x-symbol-init-charsym-command charsym)
3223             (x-symbol-init-charsym-input charsym
3224                                          (x-symbol-table-grouping definition)
3225                                          (x-symbol-table-score definition)
3226                                          cset-score
3227                                          (x-symbol-table-input definition)
3228                                          (x-symbol-table-prefixes definition))
3229             (x-symbol-init-charsym-aspects charsym
3230                                            (x-symbol-table-aspects
3231                                             definition))))))
3232     (x-symbol-init-charsym-syntax new-charsyms) ; after all (reason: opposite)
3233     (setq x-symbol-all-charsyms         ; cosmetic reverse
3234           (nconc x-symbol-all-charsyms (nreverse new-charsyms)))))
3235
3236
3237 ;;;===========================================================================
3238 ;;;  New data-type atree
3239 ;;;===========================================================================
3240
3241 (defun x-symbol-make-atree ()
3242   "Create a new association tree."
3243   (list nil))
3244
3245 (defun x-symbol-atree-push (value key atree)
3246   "Insert VALUE as the association for KEY in ATREE.
3247 KEY should be a string, VALUE is typically recovered by calling
3248 `x-symbol-match-before'."
3249   (let ((path (nreverse (append key nil)))
3250         branch)
3251     (while path
3252       (if (setq branch (assoc (car path) (cdr atree)))
3253           (setq atree (cdr branch))
3254         (setq branch (list (car path) nil))
3255         (setcdr atree (cons branch (cdr atree)))
3256         (setq atree (cdr branch)))
3257       (setq path (cdr path)))
3258     (setcar atree value)))
3259
3260
3261 ;;;===========================================================================
3262 ;;;  Charsym components
3263 ;;;===========================================================================
3264
3265 (defun x-symbol-component-root-p (node)
3266   "Non-nil, if NODE is the root of a symbol component."
3267   (listp (get node 'x-symbol-component)))
3268
3269 (defun x-symbol-component-elements (node)
3270   "Return all elements in symbol component of NODE."
3271   (or (listp (get node 'x-symbol-component))
3272       (setq node (get node 'x-symbol-component)))
3273   (or (get node 'x-symbol-component)
3274       (list node)))
3275
3276 (defun x-symbol-component-merge (node1 node2)
3277   "Merge components of NODE1 and NODE2, return root of merged component."
3278   (or (listp (get node1 'x-symbol-component))
3279       (setq node1 (get node1 'x-symbol-component)))
3280   (or (eq node1 node2)
3281       (eq node1 (get node2 'x-symbol-component))
3282       (let ((elements2 (x-symbol-component-elements node2)))
3283         (when node1
3284           (put node1 'x-symbol-component
3285                (nconc (x-symbol-component-elements node1) elements2))
3286           (while elements2
3287             (put (pop elements2) 'x-symbol-component node1)))))
3288   node1)
3289
3290 (defun x-symbol-component-space (root prop)
3291   "Classify component of ROOT according to symbol property PROP.
3292 Return an alist with elements (PROP-VALUE NODE...) where `cdr' of the
3293 symbol property PROP of all NODEs are `equal' to PROP-VALUE."
3294   (let (space)
3295     (dolist (charsym (x-symbol-component-elements root))
3296       (x-symbol-push-assoc charsym (cdr (get charsym prop)) space))
3297     space))
3298
3299
3300 ;;;===========================================================================
3301 ;;;  Code for charsym aspects
3302 ;;;===========================================================================
3303
3304 (defun x-symbol-modify-less-than (charsym1 charsym2)
3305   "Non-nil, if CHARSYM1 has a lower modify score than CHARSYM2."
3306   (< (car (get charsym1 'x-symbol-modify-aspects))
3307      (car (get charsym2 'x-symbol-modify-aspects))))
3308
3309 (defun x-symbol-inherit-aspects (charsym prop parent)
3310   "CHARSYM inherits all aspects in `cdr' of property PROP from PARENT.
3311 The `cdr' of properties PROP of CHARSYM and PARENT should be plists."
3312   (let ((aspects (cdr (get charsym prop))))
3313     (x-symbol-do-plist (aspect value (cdr (get parent prop)))
3314       (or (plist-member aspects aspect)
3315           (setq aspects (plist-put aspects aspect value))))
3316     (put charsym prop (cons nil aspects))))
3317
3318 (defun x-symbol-compute-aspects (charsym prop score-alists score)
3319   "Compute CHARSYM's aspects stored in PROP with their scores.
3320 Each element of SCORE-ALISTS looks like (ASPECT (VALUE . VSCORE)...).
3321 Order aspects according to SCORE-ALISTS.  For all ASPECTs with their
3322 VALUEs, add corresponding VSCOREs to SCORE.  Finally, set car of PROP to
3323 the sum."
3324   (let* ((aspect-plist (cdr (get charsym prop)))
3325          (aspect-alist
3326           (mapcar (lambda (elem)
3327                     (let ((type (assq (plist-get aspect-plist (car elem))
3328                                       (cdr elem))))
3329                       (if type (setq score (+ score (cdr type))))
3330                       (cons (car elem) (car type))))
3331                   score-alists)))
3332     (put charsym prop (cons score (destructive-alist-to-plist aspect-alist)))))
3333
3334 (defun x-symbol-init-aspects ()
3335   "Initialize the aspects of all currently defined charsyms.
3336 This includes component merging, inheritance and aspect scores."
3337   (let (parent)
3338     ;; Check parents ---------------------------------------------------------
3339     (dolist (charsym x-symbol-all-charsyms)
3340       (when (setq parent (get charsym 'x-symbol-parent))
3341         (put charsym 'x-symbol-component nil)
3342         (if (eq charsym parent)
3343             (remprop charsym 'x-symbol-parent)
3344           (unless (x-symbol-charsym-defined-p parent)
3345             (warn "X-Symbol charsym %s: undefined parent %s" charsym parent)
3346             (remprop charsym 'x-symbol-parent)))))
3347     ;; Aspects inheritance, component building -------------------------------
3348     (dolist (charsym
3349              ;; Maximum path length is small enough => fast enough
3350              (x-symbol-dolist-delaying (charsym x-symbol-all-charsyms)
3351                  (and (setq parent (get charsym 'x-symbol-parent))
3352                       (get parent 'x-symbol-parent))
3353                (when parent
3354                  (x-symbol-inherit-aspects charsym 'x-symbol-modify-aspects
3355                                            parent)
3356                  (x-symbol-inherit-aspects charsym 'x-symbol-rotate-aspects
3357                                            parent)
3358                  (x-symbol-component-merge parent charsym)
3359                  (remprop charsym 'x-symbol-parent))))
3360       (warn "X-Symbol charsym %s: circular inheritance %s"
3361             charsym (get charsym 'x-symbol-parent))))
3362   ;; Compute aspects scores --------------------------------------------------
3363   (dolist (charsym x-symbol-all-charsyms)
3364     (when (get charsym 'x-symbol-insert-command)
3365       (x-symbol-compute-aspects charsym 'x-symbol-modify-aspects
3366                                 x-symbol-modify-aspects-alist
3367                                 (get charsym 'x-symbol-score))
3368       (x-symbol-compute-aspects charsym 'x-symbol-rotate-aspects
3369                                 x-symbol-rotate-aspects-alist 0)
3370       (remprop charsym 'x-symbol-parent)
3371       (remprop charsym 'x-symbol-modify-to)
3372       (remprop charsym 'x-symbol-rotate-to))))
3373
3374
3375 ;;;===========================================================================
3376 ;;;  Init global modify chain/subchain alists
3377 ;;;===========================================================================
3378
3379 (defun x-symbol-sort-modify-chain (chain)
3380   "Sort charsyms in CHAIN according to modify score.
3381 Issue warning of two charsyms have the same score."
3382   (setq chain (sort chain 'x-symbol-modify-less-than))
3383   (let (score previous-score previous-charsym)
3384     (dolist (charsym chain)
3385       (setq score (car (get charsym 'x-symbol-modify-aspects)))
3386       (and previous-charsym
3387            (= previous-score score)
3388            (warn "X-Symbol charsyms %s and %s: same modify score %d"
3389                  previous-charsym charsym score))
3390       (setq previous-score score
3391             previous-charsym charsym)))
3392   chain)
3393
3394 (defun x-symbol-init-horizontal/key-alist (chain contexts)
3395   "Create horizontal and key chains for all charsyms in CHAIN.
3396 Do it for all contexts in CHAIN starting with CONTEXTS.  The first
3397 context in CONTEXTS is the modify context.  Also set key prefixes."
3398   (dolist (charsym chain)
3399     (setq contexts (or (get charsym 'x-symbol-context-strings)
3400                        contexts))
3401     (x-symbol-push-assoc charsym (car contexts)
3402                          x-symbol-all-horizontal-chain-alist)
3403     (dolist (key contexts)
3404       (unless (x-symbol-push-assoc charsym key x-symbol-all-key-chain-alist)
3405         (while (and (> (length key) x-symbol-key-min-length)
3406                     (null (member (setq key (substring key 0 -1))
3407                                   x-symbol-all-key-prefixes)))
3408           (push key x-symbol-all-key-prefixes))))))
3409
3410 (defun x-symbol-init-exclusive-alist (chain context)
3411   "Check whether CHAIN uses its CONTEXT exclusively.
3412 If so, store all subchains in `x-symbol-all-chain-subchains-alist', in
3413 reverse order.  If not, delete previously stored subchains for CONTEXT."
3414   (let ((chain-rep (car chain))
3415         subchain-beg subchain-end subchains
3416         (exclusive t)
3417         charsym next-context temp)
3418     (while chain
3419       (setq subchain-beg (pop chain)
3420             subchain-end subchain-beg)
3421       (while (and (setq charsym (car chain))
3422                   (or (null (setq next-context
3423                                   (car (get charsym
3424                                             'x-symbol-context-strings))))
3425                       (string-equal next-context context)))
3426         (setq subchain-end charsym)
3427         (setq chain (cdr chain)))
3428       (push (cons subchain-beg subchain-end) subchains)
3429       ;; Delete subchains for chain which previously used the same context
3430       ;; exclusively.
3431       (if (setq temp (assoc context x-symbol-all-exclusive-context-alist))
3432           (progn
3433             (setq exclusive nil)
3434             (x-symbol-set-assq nil (cdr temp)
3435                                x-symbol-all-chain-subchains-alist)
3436             (setcdr temp nil))          ; for debugging
3437         (push (cons context chain-rep) x-symbol-all-exclusive-context-alist))
3438       (setq context next-context))
3439     ;; Store begin and end of subchains, if all contexts were used exclusively.
3440     (x-symbol-set-assq (and exclusive subchains) chain-rep
3441                        x-symbol-all-chain-subchains-alist)))
3442
3443
3444 ;;;===========================================================================
3445 ;;;  Init modify and rotate chains, context and electric atrees, keys
3446 ;;;===========================================================================
3447
3448 (defun x-symbol-init-horizontal-chain (chain previous)
3449   "Set modify-to behavior for all charsyms in CHAIN.
3450 PREVIOUS modifies to the first charsym in CHAIN."
3451   ;; Warning about same scores will appear when defining key bindings
3452   (dolist (charsym chain)
3453     (put previous 'x-symbol-modify-to charsym)
3454     (setq previous charsym)))
3455
3456 (defun x-symbol-init-exclusive-chain (subchains previous)
3457   "Connect SUBCHAINS since all their contexts are used exclusively.
3458 PREVIOUS should be the first charsym of the chain."
3459   (dolist (subchain subchains)          ; subchains are reversed
3460     (put (cdr subchain) 'x-symbol-modify-to previous)
3461     (setq previous (car subchain))))
3462
3463 (defun x-symbol-init-rotate-chain (chain)
3464   "Set rotate-to behavior for all charsyms in CHAIN.
3465 Divide CHAIN in blocks containing charsyms with the same rotate score
3466 which are sorted according to their modify score.  The blocks are sorted
3467 according to their rotate score.  All charsyms in a block rotate to the
3468 first charsym in the next block."
3469   (let (blocks)
3470     (dolist (charsym chain)
3471       (x-symbol-push-assq charsym
3472                           (car (get charsym 'x-symbol-rotate-aspects))
3473                           blocks))
3474     (setq blocks (mapcar (lambda (block)
3475                            (sort (cdr block) 'x-symbol-modify-less-than))
3476                          (sort blocks 'car-less-than-car)))
3477     ;; For each CHARSYM in a BLOCK, set `rotate-to' to (circular) next BLOCK.
3478     (let ((last-block (car (last blocks))))
3479       (dolist (block blocks)
3480         (dolist (charsym last-block)
3481           (put charsym 'x-symbol-rotate-to block))
3482         (setq last-block block)))))
3483
3484 (defun x-symbol-init-context-atree (context chain)
3485   "Init atrees for input method CONTEXT and ELECTRIC for CONTEXT.
3486 \\[x-symbol-modify-key] modifies CONTEXT to the first charsym in CHAIN.
3487 Prefixes of CONTEXT could have been already converted to x-symbol
3488 characters.  Contexts with these prefixes being replaced by the
3489 corresponding cstring of the x-symbol character are also considered."
3490   (let ((charsym (car chain)))  ; lowest score
3491     (x-symbol-atree-push charsym context x-symbol-context-atree)
3492     (if (member context (get charsym 'x-symbol-electric-strings))
3493         (x-symbol-atree-push charsym context x-symbol-electric-atree)))
3494   (let ((len (length context))
3495         prefix-chain prefix-cstring)
3496     (while (> (decf len) 0)
3497       (when (setq prefix-chain (assoc (substring context 0 len)
3498                                       x-symbol-all-key-chain-alist))
3499         (dolist (prefix (cdr prefix-chain))
3500           (catch 'x-symbol-init-context-atree
3501             (or (setq prefix-cstring (gethash prefix x-symbol-cstring-table))
3502                 (throw 'x-symbol-init-context-atree t))
3503             (let ((context1 (concat prefix-cstring (substring context len))))
3504               ;; If any of the charsyms defines PREFIX as an electric prefix,
3505               ;; use that one as the target.
3506               (dolist (charsym chain)
3507                 (when (memq prefix (get charsym 'x-symbol-electric-prefixes))
3508                   (x-symbol-atree-push charsym context1 x-symbol-context-atree)
3509                   (x-symbol-atree-push charsym context1 x-symbol-electric-atree)
3510                   (throw 'x-symbol-init-context-atree t)))
3511               ;; Otherwise, use charsym with same aspects as target.
3512               (dolist (charsym chain)
3513                 (when (and (plists-eq
3514                             (cdr (get charsym 'x-symbol-modify-aspects))
3515                             (cdr (get prefix 'x-symbol-modify-aspects)))
3516                            (plists-eq
3517                             (cdr (get charsym 'x-symbol-rotate-aspects))
3518                             (cdr (get prefix 'x-symbol-rotate-aspects))))
3519                   (x-symbol-atree-push charsym context1 x-symbol-context-atree)
3520                   (if (member context (get charsym 'x-symbol-electric-strings))
3521                       (x-symbol-atree-push charsym context1
3522                                            x-symbol-electric-atree))
3523                   (throw 'x-symbol-init-context-atree t)))
3524               ;; Otherwise, use first charsym in chain (the one with the
3525               ;; lowest score), but never for input method ELECTRIC.
3526               (x-symbol-atree-push (car chain) context1
3527                                    x-symbol-context-atree))))))))
3528
3529 (defun x-symbol-init-key-bindings (context chain)
3530   "Define key bindings for all charsyms in key chain CHAIN.
3531 The key bindings use CONTEXT and, if necessary, a digit."
3532   (if (or (cdr chain)           ; more than one charsym
3533           (< (length context) x-symbol-key-min-length)
3534           (member context x-symbol-all-key-prefixes))
3535       (let ((suffix (eval-when-compile
3536                       (mapcar 'char-to-string (append "1234567890" nil)))))
3537         (dolist (charsym chain)
3538           (if suffix
3539               (define-key x-symbol-map
3540                 (concat context (pop suffix))
3541                 (get charsym 'x-symbol-insert-command))
3542             (warn "X-Symbol charsym %s: more than 10 bindings for key prefix %S"
3543                   charsym context))))
3544     (define-key x-symbol-map context
3545       (get (car chain) 'x-symbol-insert-command))))
3546
3547
3548 ;;;===========================================================================
3549 ;;;  Grid and Menu
3550 ;;;===========================================================================
3551
3552 (defun x-symbol-rotate-modify-less-than (charsym1 charsym2)
3553   "Non-nil, if the scores of CHARSYM1 are lower than those in CHARSYM2.
3554 The rotate score is more important than the modify score."
3555   (let ((diff (- (car (get charsym1 'x-symbol-rotate-aspects))
3556                  (car (get charsym2 'x-symbol-rotate-aspects)))))
3557     (or (< diff 0)
3558         (and (zerop diff) (x-symbol-modify-less-than charsym1 charsym2)))))
3559
3560 (defun x-symbol-subgroup-less-than (charsym1 charsym2)
3561   "Non-nil, if subgroup string of CHARSYM1 is less than that of CHARSYM2."
3562   (string-lessp (or (cadr (get charsym1 'x-symbol-grouping)) "\377")
3563                 (or (cadr (get charsym2 'x-symbol-grouping)) "\377")))
3564
3565 (defun x-symbol-header-charsyms (&optional language)
3566   "Return an alists with headers and their charsyms.
3567 If optional argument LANGUAGE is non-nil, only collect valid charsym in
3568 that language.  Used for menu and grid.  See variable and language
3569 access `x-symbol-LANG-header-groups-alist'."
3570   (let (group-alist)
3571     (dolist (charsym x-symbol-all-charsyms)
3572       (when (or (null language)
3573                 ;; This is part of the initialization, we rely on the semantics
3574                 ;; => no (funcall x-symbol-valid-charsym-function ...)
3575                 (x-symbol-default-valid-charsym charsym language))
3576         (x-symbol-push-assq charsym (car (get charsym 'x-symbol-grouping))
3577                             group-alist)))
3578     (mapcar (lambda (header-groups)
3579               (cons (car header-groups)
3580                     (apply #'nconc
3581                            (mapcar (lambda (group)
3582                                      (sort (nreverse
3583                                             (cdr (assq group group-alist)))
3584                                            #'x-symbol-subgroup-less-than))
3585                                    (cdr header-groups)))))
3586             (or (and language
3587                      (symbol-value
3588                       (get language 'x-symbol-LANG-header-groups-alist)))
3589                 x-symbol-header-groups-alist))))
3590
3591 (defun x-symbol-init-grid/menu (&optional language)
3592   "Initialize the grid and the menu.
3593 If optional argument LANGUAGE is non-nil, init local grid/menu for that
3594 language."
3595   (let (grid-alist menu-alist)
3596     (dolist (header-charsyms (x-symbol-header-charsyms language))
3597       (when (cdr header-charsyms)
3598         (let ((header (car header-charsyms))
3599               (charsyms (cdr header-charsyms)))
3600           ;; Grid ------------------------------------------------------------
3601           (let (charsyms1 charsyms2)
3602             (dolist (charsym charsyms)
3603               (unless (memq charsym charsyms1)
3604                 (setq charsyms1
3605                       (nconc charsyms1
3606                              (sort (intersection
3607                                     (x-symbol-component-elements charsym)
3608                                     charsyms)
3609                                    'x-symbol-rotate-modify-less-than)))))
3610             (dolist (charsym charsyms1)
3611               (if (gethash charsym x-symbol-cstring-table)
3612                   (push charsym charsyms2)))
3613             (if charsyms2
3614                 (push (cons header (nreverse charsyms2)) grid-alist)))
3615           ;; Menu ------------------------------------------------------------
3616           (setq charsyms
3617                 (sort (mapcar
3618                        (lambda (charsym)
3619                          (vector (if language
3620                                      (car (x-symbol-default-valid-charsym
3621                                            charsym language))
3622                                    (symbol-name charsym))
3623                                  (get charsym 'x-symbol-insert-command)
3624                                  t))
3625                        charsyms)
3626                       (lambda (a b) (string-lessp (aref a 0) (aref b 0)))))
3627           (if (<= (length charsyms) x-symbol-menu-max-items)
3628               (push (cons header charsyms) menu-alist)
3629             (let* ((len (length charsyms))
3630                    (submenus (1+ (/ (1- len) x-symbol-menu-max-items)))
3631                    (items (/ len submenus))
3632                    (submenus (% len items))
3633                    (number 0)
3634                    charsyms1 i)
3635               (while charsyms
3636                 (if (= submenus number) (decf items))
3637                 (setq charsyms1 nil
3638                       i items)
3639                 (while (>= i 0)
3640                   (decf i)
3641                   (push (pop charsyms) charsyms1))
3642                 (push (cons (format "%s %d" header (incf number))
3643                             (nreverse charsyms1))
3644                       menu-alist)))))))
3645     ;; Set alists ------------------------------------------------------------
3646     (setq grid-alist (nreverse grid-alist)
3647           menu-alist (nreverse menu-alist))
3648     (if language
3649         (let ((generated (symbol-value
3650                           (get language 'x-symbol-LANG-generated-data))))
3651           (setf (x-symbol-generated-menu-alist generated) menu-alist)
3652           (setf (x-symbol-generated-grid-alist generated) grid-alist))
3653       (setq x-symbol-menu-alist menu-alist
3654             x-symbol-grid-alist grid-alist))))
3655
3656
3657 ;;;===========================================================================
3658 ;;;  Init code for all charsyms.  MAIN: `x-symbol-init-input'
3659 ;;;===========================================================================
3660
3661 ;;;###autoload
3662 (defun x-symbol-init-input ()
3663   "Initialize all input methods for all charsyms defined so far.
3664 Run `x-symbol-after-init-input-hook' afterwards.  This function should
3665 be called if new charsyms have been added, but not too often since it
3666 takes some time to complete.  Input methods TOKEN and READ-TOKEN are
3667 defined with `x-symbol-init-language'.
3668
3669 As explained in the docstring of `x-symbol-init-cset', charsyms are
3670 defined with \"character descriptions\" which consist of different
3671 \"aspects\" and \"contexts\", which can also be inherited from a
3672 \"parent\" character.  All characters which are connected with parents,
3673 form a \"component\".  Aspects and contexts are used to determine the
3674 Modify-to and Rotate-to chain for characters, the contexts for input
3675 method CONTEXT and ELECTRIC, the key bindings, and the position in the
3676 MENU and the GRID.
3677
3678 If a table entry of a charsym does not define its own contexts, they are
3679 the same as the contexts of the charsym in an earlier position in the
3680 \"modify chain\" (see below), or the contexts of the first charsym with
3681 defined contexts in the modify chain.  The modify context of a charsym
3682 is the first context.
3683
3684 Characters in the same component whose aspects only differ by their
3685 \"direction\" (east,...), a key in `x-symbol-rotate-aspects-alist', are
3686 circularly connected by \"rotate-to\".  The sequence in the \"rotate
3687 chain\" is determined by rotate scores depending on the values in the
3688 rotate aspects.  Charsyms with the same \"rotate-aspects\" are not
3689 connected (charsyms with the smallest modify scores are preferred).
3690
3691 Characters in the same components whose aspects only differ by their
3692 \"size\" (big,...), \"shape\" (round, square,...) and/or \"shift\" (up,
3693 down,...), keys in `x-symbol-modify-aspects-alist', are circularly
3694 connected by \"modify-to\", if all their modify contexts are used
3695 exclusively, i.e., no other modify chain uses any of them.  The sequence
3696 in the \"modify chain\" is determined by modify scores depending on the
3697 values in the modify aspects and the charsym score.
3698
3699 Otherwise, the \"modify chain\" is divided into modify subchains, which
3700 are those charsyms sharing the same modify context.  All modify
3701 subchains using the same modify context, build a \"horizontal chain\"
3702 whose charsyms are circularly connected by \"modify-to\".
3703
3704 We build a \"key chain\" for all contexts (not just modify contexts),
3705 consisting of all charsyms (sorted according to modify scores) having
3706 the context.  Input method CONTEXT modifies the context to the first
3707 charsym in the \"key chain\".
3708
3709 If there is only one charsym in the key chain, `x-symbol-compose-key'
3710 plus the context inserts the charsym.  Otherwise, we use a digit \(1..9,
3711 0\) as a suffix for each charsym in the key chain.
3712 `x-symbol-compose-key' plus the context plus the optional suffix inserts
3713 the charsym."
3714   (unless x-symbol-input-initialized
3715     (let ((gc-cons-threshold most-positive-fixnum)
3716           (quail-ignore (regexp-quote x-symbol-quail-suffix-string)))
3717       (setq x-symbol-input-initialized t)
3718       (x-symbol-init-aspects)
3719       (setq x-symbol-all-key-prefixes nil)
3720       (setq x-symbol-all-key-chain-alist nil)
3721       (setq x-symbol-all-horizontal-chain-alist nil)
3722       (setq x-symbol-all-chain-subchains-alist nil)
3723       (setq x-symbol-all-exclusive-context-alist nil)
3724       (dolist (root x-symbol-all-charsyms)
3725         (when (and (get root 'x-symbol-insert-command)
3726                    (x-symbol-component-root-p root))
3727           (dolist (chain (x-symbol-component-space root
3728                                                    'x-symbol-modify-aspects))
3729             (x-symbol-init-rotate-chain (cdr chain)))
3730           (dolist (chain (x-symbol-component-space root
3731                                                    'x-symbol-rotate-aspects))
3732             (setq chain (x-symbol-sort-modify-chain (cdr chain)))
3733             (let ((input (some (lambda (charsym)
3734                                  (get charsym 'x-symbol-context-strings))
3735                                chain)))
3736               (if input
3737                   (progn
3738                     (x-symbol-init-horizontal/key-alist chain input)
3739                     (x-symbol-init-exclusive-alist chain (car input)))
3740                 (dolist (charsym chain)
3741                   (warn "X-Symbol charsym %s: no input" charsym)))))))
3742       (dolist (chain x-symbol-all-horizontal-chain-alist)
3743         ;; Do not use `x-symbol-sort-modify-chain', since same warnings will
3744         ;; appear later again.
3745         (setq chain (setcdr chain       ; do not destroy horizontal chain
3746                             (sort (cdr chain) 'x-symbol-modify-less-than)))
3747         (x-symbol-init-horizontal-chain chain (car (last chain))))
3748       (dolist (entry x-symbol-all-chain-subchains-alist)
3749         (x-symbol-init-exclusive-chain (cdr entry) (car entry)))
3750       (setq x-symbol-context-atree (x-symbol-make-atree)
3751             x-symbol-electric-atree (x-symbol-make-atree))
3752       (setq x-symbol-map (make-keymap))
3753       (dolist (entry x-symbol-all-key-chain-alist) ; first sort
3754         (setcdr entry (x-symbol-sort-modify-chain (cdr entry))))
3755       (if x-symbol-define-input-method-quail
3756           (x-symbol-init-quail-bindings nil nil))
3757       (dolist (entry x-symbol-all-key-chain-alist) ; then use
3758         (let ((context (car entry))
3759               (chain (cdr entry)))
3760           (or (and x-symbol-context-init-ignore
3761                    (string-match x-symbol-context-init-ignore context))
3762               (x-symbol-init-context-atree context chain))
3763           (unless (string-match "[0-9]" context 1) ; no digit from 2nd char on
3764             (or (null x-symbol-define-input-method-quail)
3765                 (string-match quail-ignore context 1) ; no semi from 2nd char
3766                 (and x-symbol-quail-init-ignore
3767                      (string-match x-symbol-quail-init-ignore context))
3768                 (x-symbol-init-quail-bindings context chain))
3769             (or (and x-symbol-key-init-ignore
3770                      (string-match x-symbol-key-init-ignore context))
3771                 (x-symbol-init-key-bindings context chain))))))
3772     (or (featurep 'xemacs)              ; CW: is OK in XEmacs, but slow
3773         (dolist (m (mapcar 'cdr (accessible-keymaps x-symbol-map)))
3774           (set-keymap-default-binding m 'x-symbol-map-default-binding)))
3775     (defalias 'x-symbol-map x-symbol-map)
3776     (x-symbol-init-grid/menu)
3777     (substitute-key-definition 'x-symbol-map-autoload 'x-symbol-map global-map)
3778     (dolist (binding x-symbol-map-default-bindings)
3779       (define-key x-symbol-map
3780         (or (car binding) (vector x-symbol-compose-key))
3781         (cadr binding)))
3782     ;; always set the following (or only if `x-symbol-map-default-keys-alist'
3783     ;; is non-nil?):
3784     (set-keymap-default-binding x-symbol-map 'x-symbol-map-default-binding)
3785     (run-hooks 'x-symbol-after-init-input-hook)))
3786
3787
3788 ;;;===========================================================================
3789 ;;;  Latin recoding
3790 ;;;===========================================================================
3791
3792 (defun x-symbol-init-latin-decoding ()
3793   "Init alists for latin decoding and \\[x-symbol-unalias].
3794 This function should be run after all csets with CODING have been
3795 defined, see `x-symbol-init-cset'."
3796   (let (normalize-alist decode-alists)
3797     ;; set alists ------------------------------------------------------------
3798     (dolist (charsym (reverse x-symbol-all-charsyms)) ; rev cosmetic
3799       (let ((cstring (gethash charsym x-symbol-cstring-table)) bfstring)
3800         (dolist (table x-symbol-bchar-tables)
3801           (and (setq bfstring (gethash charsym (cdr table)))
3802                (not (equal (if (stringp bfstring)
3803                                bfstring
3804                              (setq bfstring (char-to-string bfstring)))
3805                            cstring))
3806                (push (cons bfstring cstring) normalize-alist)))
3807         (dolist (table x-symbol-fchar-tables)
3808           (and (setq bfstring (gethash charsym (cdr table)))
3809                (not (equal (setq bfstring (char-to-string bfstring)) cstring))
3810                (x-symbol-push-assq (cons bfstring cstring) (car table)
3811                                    decode-alists)))))
3812     (setq x-symbol-unalias-alist (nreverse normalize-alist))
3813                                         ; rev cosmetic
3814     ;; order recodings in decoding -------------------------------------------
3815     (setq x-symbol-latin-decode-alists nil)
3816     (dolist (coding+alist decode-alists)
3817       (let (decode-alist)
3818         (when (x-symbol-dolist-delaying
3819                   (decode-elem (nreverse (cdr coding+alist)) working delayed)
3820                   (let ((octet (substring (cdr decode-elem) -1)))
3821                     (or (assoc octet (cdr working)) (assoc octet delayed)))
3822                 (push decode-elem decode-alist))
3823           (error "Circular recoding between latin characters"))
3824         (push (cons (car coding+alist)
3825                     (nreverse decode-alist)) ; rev important
3826               x-symbol-latin-decode-alists)))))
3827
3828
3829 ;;;===========================================================================
3830 ;;;  Token languages
3831 ;;;===========================================================================
3832
3833 (defun x-symbol-get-prime-for (size)
3834   (setq size (/ (* size 5) 4))
3835   ;; not all primes
3836   (let ((primes '(127 149 173 197 223 251 283 317 359 409 463 523 599 683 773
3837                       883 1009 1151 1307 1493 1709 1951 2341 2819 3389 4073))
3838         result)
3839     (while (and (setq result (pop primes)) (< result size)))
3840     (or result size)))
3841
3842 (defun x-symbol-alist-to-obarray (alist)
3843   (let ((ob-array (make-vector (x-symbol-get-prime-for (length alist)) 0)))
3844     (dolist (elt alist)
3845       (set (intern (car elt) ob-array) (cdr elt)))
3846     ob-array))
3847
3848 (defun x-symbol-alist-to-hash-table (alist)
3849   (let ((hash-table (make-hash-table
3850                      :size (if (featurep 'xemacs)
3851                                (length alist) ; does already use higher prime
3852                              (x-symbol-get-prime-for (length alist)))
3853                      :test 'eq)))
3854     (dolist (elt alist)
3855       (puthash (car elt) (cdr elt) hash-table))
3856     hash-table))
3857
3858 (defun x-symbol-init-language (language)
3859   "Load and init token language LANGUAGE.
3860 Set language dependent accesses in `x-symbol-language-access-alist'.
3861 Set conversion alists according to table and initialize executables, see
3862 `x-symbol-init-executables'.  Initialize all input methods, see
3863 `x-symbol-init-input'.  LANGUAGE should have been registered with
3864 `x-symbol-register-language' before.
3865
3866 Each element in TABLE, the language access `x-symbol-LANG-table', looks
3867 like
3868   (CHARSYM CLASSES . TOKEN-SPEC) or nil.
3869
3870 With the first form, pass TOKEN-SPEC to the language aspect
3871 `x-symbol-token-list' to get a list of TOKENs.  Decoding converts all
3872 TOKENs to the cstring of CHARSYM, encoding converts the cstring to the
3873 first TOKEN.
3874
3875 IF CHARSYM or the first TOKEN is used a second time in the table, issue
3876 a warning and do not define entries for decoding and encoding.  If any
3877 TOKEN appears a second time, do not define the corresponding entry for
3878 decoding.  If the third form nil has appeared in TABLE, do not issue a
3879 warning for the next entries in TABLE.
3880
3881 CLASSES are a list of symbols which are used for the character info in
3882 the echo are, see `x-symbol-character-info', the grid coloring scheme,
3883 and probably by the token language dependent control of input method
3884 ELECTRIC, see `x-symbol-electric-input'.  They are used by the language
3885 accesses `x-symbol-LANG-class-alist' and
3886 `x-symbol-LANG-class-face-alist'.
3887
3888 If non-nil, the language aspect `x-symbol-input-token-ignore' \"hides\"
3889 some tokens from input method token.  `x-symbol-call-function-or-regexp'
3890 uses it with TOKEN and CHARSYM."
3891   (when (get language 'x-symbol-LANG-feature)
3892     (require (get language 'x-symbol-LANG-feature))
3893     (x-symbol-init-language-accesses language x-symbol-language-access-alist)
3894     (put language 'x-symbol-initialized t)
3895     (dolist (feature (x-symbol-language-value 'x-symbol-LANG-required-fonts
3896                                               language))
3897       (require feature))
3898     (x-symbol-init-input)
3899     (let ((grammar (x-symbol-language-value 'x-symbol-LANG-token-grammar
3900                                             language)))
3901       (when (eq (car-safe grammar) 'x-symbol-make-grammar)
3902         (setq grammar (apply 'x-symbol-make-grammar (cdr grammar)))
3903         (set (get language 'x-symbol-LANG-token-grammar) grammar))
3904       (let ((token-list (x-symbol-grammar-token-list grammar))
3905             (after-init (x-symbol-grammar-after-init grammar))
3906             (class-alist (x-symbol-language-value 'x-symbol-LANG-class-alist
3907                                                   language))
3908             decode-alist encode-alist classes-alist
3909             (warn-double t)
3910             used-charsyms used-tokens secondary
3911             (max-token-len 0) tlen)
3912         (dolist (entry (x-symbol-language-value 'x-symbol-LANG-table language))
3913           (if (null entry)
3914               (setq warn-double nil)
3915             (let* ((charsym (car entry))
3916                    (classes (cadr entry))
3917                    (tokens (if token-list
3918                                (funcall token-list (cddr entry))
3919                              (mapcar #'list (cddr entry)))))
3920               ;; Check entries, set charsym properties -----------------------
3921               (cond ((null charsym))
3922                     ((memq charsym used-charsyms)
3923                      (if warn-double
3924                          (warn "X-Symbol charsym %s: used twice in language %s"
3925                                charsym language))
3926                      (setq charsym nil))
3927                     ((memq charsym x-symbol-all-charsyms)
3928                      (push charsym used-charsyms))
3929                     (t
3930                      (warn "X-Symbol: used undefined charsym %s in language %s"
3931                            charsym language)))
3932               (dolist (class classes)
3933                 (unless (assq class class-alist)
3934                   (warn "X-Symbol charsym %s: undefined %s class %s"
3935                         (car entry) language class)))
3936               (and charsym
3937                    (or (null tokens)
3938                        (member (caar tokens) used-tokens)
3939                        (not (gethash charsym x-symbol-cstring-table)))
3940                    (setq charsym nil))
3941               ;;--------------------------------------------------------------
3942               ;; TODO: allow (nil nil TOKEN...) to shadow tokens
3943               (when charsym
3944                 (push (cons charsym classes) classes-alist)
3945                 (push (cons charsym (car tokens)) encode-alist)
3946                 (setq secondary nil)
3947                 (dolist (token tokens)
3948                   (if (member (car token) used-tokens)
3949                       (if warn-double
3950                           (warn "X-Symbol charsym %s: used %s token %S twice"
3951                                 (car entry) language (car token)))
3952                     (push (car token) used-tokens)
3953                     (push (list* (car token) charsym (cdr token) secondary)
3954                           decode-alist)
3955                     (if (> (setq tlen (length (car token))) max-token-len)
3956                         (setq max-token-len tlen))
3957                     (setq secondary t)))))))
3958         ;; set vars ----------------------------------------------------------
3959         (set (get language 'x-symbol-LANG-generated-data)
3960              (x-symbol-make-generated-data
3961               :encode-table (x-symbol-alist-to-hash-table encode-alist)
3962               :decode-obarray (x-symbol-alist-to-obarray decode-alist)
3963               :token-classes (x-symbol-alist-to-hash-table classes-alist)
3964               :max-token-len max-token-len))
3965         (if (functionp after-init) (funcall after-init))))
3966     (x-symbol-init-grid/menu language)
3967     t))
3968
3969
3970 \f
3971 ;;;;##########################################################################
3972 ;;;;  The Tables
3973 ;;;;##########################################################################
3974
3975 ;; EMACS: comment in lisp/international/mule-conf.el: ------------------------
3976 ;; ISO-2022 allows a use of character sets not registered in ISO with
3977 ;; final characters `0' (0x30) through `?' (0x3F).  Among them, Emacs
3978 ;; reserves `0' through `9' to support several private character sets.
3979 ;; The remaining final characters `:' through `?' [:;<=>?] are for users.
3980 ;; XEMACS: new charset in lisp/mule/thai-xtis-chars.el: with final ?? --------
3981
3982 (defvar x-symbol-latin1-cset
3983   '((("iso8859-1" . iso-8859-1) ?\237 -3750)
3984     nil .
3985     (latin-iso8859-1))
3986   "Cset with registry \"iso8859-1\", see `x-symbol-init-cset'.")
3987
3988 (defvar x-symbol-latin2-cset
3989   '((("iso8859-2" . iso-8859-2) ?\236 -3750)
3990     nil .
3991     (latin-iso8859-2))
3992   "Cset with registry \"iso8859-2\", see `x-symbol-init-cset'.")
3993
3994 (defvar x-symbol-latin3-cset
3995   '((("iso8859-3" . iso-8859-3) ?\235 -3750)
3996     nil .
3997     (latin-iso8859-3))
3998   "Cset with registry \"iso8859-3\", see `x-symbol-init-cset'.")
3999
4000 (defvar x-symbol-latin5-cset
4001   '((("iso8859-9". iso-8859-9) ?\234 -3750)
4002     nil .
4003     (latin-iso8859-9))
4004   "Cset with registry \"iso8859-9\", see `x-symbol-init-cset'.")
4005
4006 (defvar x-symbol-latin9-cset
4007   '((("iso8859-15". iso-8859-15) ?\231 -3750)
4008     nil .
4009     (latin-iso8859-15 "ISO8859-15 (Latin-9)" 96 ?b) )
4010   "Cset with registry \"iso8859-15\", see `x-symbol-init-cset'.")
4011
4012 (defvar x-symbol-xsymb0-cset
4013   '((("adobe-fontspecific") ?\233 -3600)
4014     (xsymb0-left  "X-Symbol characters 0, left"  94 ?:) .
4015     (xsymb0-right "X-Symbol characters 0, right" 94 ?\;))
4016   "Cset with registry \"fontspecific\", see `x-symbol-init-cset'.")
4017
4018 (defvar x-symbol-xsymb1-cset
4019   '((("xsymb-xsymb1") ?\232 -3500)
4020     (xsymb1-left  "X-Symbol characters 1, left"  94 ?<) .
4021     (xsymb1-right "X-Symbol characters 1, right" 96 ?=))
4022   "Cset with registry \"xsymb1\", see `x-symbol-init-cset'.")
4023
4024 (defvar x-symbol-latin1-table
4025   '((nobreakspace 160 (white) nil nil (" "))
4026     (exclamdown 161 (punctuation) nil nil ("!"))
4027     (cent 162 (currency "c") nil nil ("C|" "|C"))
4028     (sterling 163 (currency "L") nil nil ("L-" "-L"))
4029     (currency 164 (currency "x") nil nil ("ox" "xo"))
4030     (yen 165 (currency "Y") nil nil ("Y=" "=Y"))
4031     (brokenbar 166 (line) nil nil ("!!"))
4032     (section 167 (symbol) nil nil ("SS"))
4033     (diaeresis 168 (diaeresis accent))
4034     (copyright 169 (symbol "C") nil nil ("CO" "cO"))
4035     (ordfeminine 170 (symbol "a") (shift up) nil ("a_" "_a"))
4036     (guillemotleft 171 (quote open guillemotright)
4037                    (direction west . guillemotright) nil (t "<<"))
4038     (notsign 172 (symbol) nil nil ("-,"))
4039     (hyphen 173 (line) (size sml) nil ("-"))
4040     (registered 174 (symbol "R") nil nil ("RO"))
4041     (macron 175 (line) (shift up) nil ("-"))
4042     (degree 176 (symbol "0") (shift up) nil ("o^" "^o"))
4043     (plusminus 177 (operator) (direction north) nil (t "+-" t "+_"))
4044     (twosuperior 178 (symbol "2") (shift up) nil ("2^" "^2"))
4045     (threesuperior 179 (symbol "3") (shift up) nil ("3^" "^3"))
4046     (acute 180 (acute accent))
4047     (mu1 181 (greek1 "m" nil "mu"))
4048     (paragraph 182 (symbol "P") nil nil ("q|"))
4049     (periodcentered 183 (dots) (shift up) nil ("." ".^" t "^."))
4050     (cedilla 184 (cedilla accent))
4051     (onesuperior 185 (symbol "1") (shift up) nil ("1^" "^1"))
4052     (masculine 186 (symbol "o") (shift up) nil ("o_" "_o"))
4053     (guillemotright 187 (quote close guillemotleft) (direction east) nil
4054                     (t ">>"))
4055     (onequarter 188 (symbol "1") nil nil ("1Q" "1/4"))
4056     (onehalf 189 (symbol "2") nil nil ("1H" "1/2"))
4057     (threequarters 190 (symbol "3") nil nil ("3Q" "3/4"))
4058     (questiondown 191 (punctuation) nil nil ("?"))
4059     (Agrave 192 (grave "A" agrave))
4060     (Aacute 193 (acute "A" aacute))
4061     (Acircumflex 194 (circumflex "A" acircumflex))
4062     (Atilde 195 (tilde "A" atilde))
4063     (Adiaeresis 196 (diaeresis "A" adiaeresis))
4064     (Aring 197 (ring "A" aring))
4065     (AE 198 (letter "AE" ae))
4066     (Ccedilla 199 (cedilla "C" ccedilla))
4067     (Egrave 200 (grave "E" egrave))
4068     (Eacute 201 (acute "E" eacute))
4069     (Ecircumflex 202 (circumflex "E" ecircumflex))
4070     (Ediaeresis 203 (diaeresis "E" ediaeresis))
4071     (Igrave 204 (grave "I" igrave))
4072     (Iacute 205 (acute "I" iacute))
4073     (Icircumflex 206 (circumflex "I" icircumflex))
4074     (Idiaeresis 207 (diaeresis "I" idiaeresis))
4075     (ETH 208 (slash "D" eth) nil 120)
4076     (Ntilde 209 (tilde "N" ntilde))
4077     (Ograve 210 (grave "O" ograve))
4078     (Oacute 211 (acute "O" oacute))
4079     (Ocircumflex 212 (circumflex "O" ocircumflex))
4080     (Otilde 213 (tilde "O" otilde))
4081     (Odiaeresis 214 (diaeresis "O" odiaeresis))
4082     (multiply 215 (operator) (shift up) nil ("x"))
4083     (Ooblique 216 (slash "O" oslash))
4084     (Ugrave 217 (grave "U" ugrave))
4085     (Uacute 218 (acute "U" uacute))
4086     (Ucircumflex 219 (circumflex "U" ucircumflex))
4087     (Udiaeresis 220 (diaeresis "U" udiaeresis))
4088     (Yacute 221 (acute "Y" yacute))
4089     (THORN 222 (letter "TH" thorn))
4090     (ssharp 223 (letter "ss" nil) nil nil ("ss" "s:" t ":s" "s\"" "\"s"))
4091     (agrave 224 (grave "a" Agrave))
4092     (aacute 225 (acute "a" Aacute))
4093     (acircumflex 226 (circumflex "a" Acircumflex))
4094     (atilde 227 (tilde "a" Atilde))
4095     (adiaeresis 228 (diaeresis "a" Adiaeresis))
4096     (aring 229 (ring "a" Aring))
4097     (ae 230 (letter "ae" AE))
4098     (ccedilla 231 (cedilla "c" Ccedilla))
4099     (egrave 232 (grave "e" Egrave))
4100     (eacute 233 (acute "e" Eacute))
4101     (ecircumflex 234 (circumflex "e" Ecircumflex))
4102     (ediaeresis 235 (diaeresis "e" Ediaeresis))
4103     (igrave 236 (grave "i" Igrave))
4104     (iacute 237 (acute "i" Iacute))
4105     (icircumflex 238 (circumflex "i" Icircumflex))
4106     (idiaeresis 239 (diaeresis "i" Idiaeresis))
4107     (eth 240 (slash "d" ETH) nil 120)
4108     (ntilde 241 (tilde "n" Ntilde))
4109     (ograve 242 (grave "o" Ograve))
4110     (oacute 243 (acute "o" Oacute))
4111     (ocircumflex 244 (circumflex "o" Ocircumflex))
4112     (otilde 245 (tilde "o" Otilde))
4113     (odiaeresis 246 (diaeresis "o" Odiaeresis))
4114     (division 247 (operator) nil nil (":-" "-:"))
4115     (oslash 248 (slash "o" Ooblique))
4116     (ugrave 249 (grave "u" Ugrave))
4117     (uacute 250 (acute "u" Uacute))
4118     (ucircumflex 251 (circumflex "u" Ucircumflex))
4119     (udiaeresis 252 (diaeresis "u" Udiaeresis))
4120     (yacute 253 (acute "y" Yacute))
4121     (thorn 254 (letter "th" THORN))
4122     (ydiaeresis 255 (diaeresis "y" Ydiaeresis)))
4123   "Table for registry \"iso8859-1\", see `x-symbol-init-cset'.")
4124
4125 (defvar x-symbol-latin2-table
4126   '((nobreakspace 160 . t)
4127     (Aogonek 161 (ogonek "A" aogonek))
4128     (breve 162 (breve accent))
4129     (Lslash 163 (slash "L" lslash))
4130     (currency 164 . t)
4131     (Lcaron 165 (caron "L" lcaron))
4132     (Sacute 166 (acute "S" sacute))
4133     (section 167 . t)
4134     (diaeresis 168 . t)
4135     (Scaron 169 (caron "S" scaron))
4136     (Scedilla 170 (cedilla "S" scedilla))
4137     (Tcaron 171 (caron "T" tcaron))
4138     (Zacute 172 (acute "Z" zacute))
4139     (hyphen 173 . t)
4140     (Zcaron 174 (caron "Z" zcaron))
4141     (Zdotaccent 175 (dotaccent "Z" zdotaccent))
4142     (degree 176 . t)
4143     (aogonek 177 (ogonek "a" Aogonek))
4144     (ogonek 178 (ogonek accent))
4145     (lslash 179 (slash "l" Lslash))
4146     (acute 180 . t)
4147     (lcaron 181 (caron "l" Lcaron))
4148     (sacute 182 (acute "s" Sacute))
4149     (caron 183 (caron accent) (shift up))
4150     (cedilla 184 . t)
4151     (scaron 185 (caron "s" Scaron))
4152     (scedilla 186 (cedilla "s" Scedilla))
4153     (tcaron 187 (caron "t" Tcaron))
4154     (zacute 188 (acute "z" Zacute))
4155     (hungarumlaut 189 (hungarumlaut accent))
4156     (zcaron 190 (caron "z" Zcaron))
4157     (zdotaccent 191 (dotaccent "z" Zdotaccent))
4158     (Racute 192 (acute "R" racute))
4159     (Aacute 193 . t)
4160     (Acircumflex 194 . t)
4161     (Abreve 195 (breve "A" abreve))
4162     (Adiaeresis 196 . t)
4163     (Lacute 197 (acute "L" lacute))
4164     (Cacute 198 (acute "C" cacute))
4165     (Ccedilla 199 . t)
4166     (Ccaron 200 (caron "C" ccaron))
4167     (Eacute 201 . t)
4168     (Eogonek 202 (ogonek "E" eogonek))
4169     (Ediaeresis 203 . t)
4170     (Ecaron 204 (caron "E" ecaron))
4171     (Iacute 205 . t)
4172     (Icircumflex 206 . t)
4173     (Dcaron 207 (caron "D" dcaron))
4174     (Dbar 208 (slash "D" dbar))
4175     (Nacute 209 (acute "N" nacute))
4176     (Ncaron 210 (caron "N" ncaron))
4177     (Oacute 211 . t)
4178     (Ocircumflex 212 . t)
4179     (Ohungarumlaut 213 (hungarumlaut "O" ohungarumlaut))
4180     (Odiaeresis 214 . t)
4181     (multiply 215 . t)
4182     (Rcaron 216 (caron "R" rcaron))
4183     (Uring 217 (ring "U" uring))
4184     (Uacute 218 . t)
4185     (Uhungarumlaut 219 (hungarumlaut "U" uhungarumlaut))
4186     (Udiaeresis 220 . t)
4187     (Yacute 221 . t)
4188     (Tcedilla 222 (cedilla "T" tcedilla))
4189     (ssharp 223 . t)
4190     (racute 224 (acute "r" Racute))
4191     (aacute 225 . t)
4192     (acircumflex 226 . t)
4193     (abreve 227 (breve "a" Abreve))
4194     (adiaeresis 228 . t)
4195     (lacute 229 (acute "l" Lacute))
4196     (cacute 230 (acute "c" Cacute))
4197     (ccedilla 231 . t)
4198     (ccaron 232 (caron "c" Ccaron))
4199     (eacute 233 . t)
4200     (eogonek 234 (ogonek "e" Eogonek))
4201     (ediaeresis 235 . t)
4202     (ecaron 236 (caron "e" Ecaron))
4203     (iacute 237 . t)
4204     (icircumflex 238 . t)
4205     (dcaron 239 (caron "d" Dcaron))
4206     (dbar 240 (slash "d" Dbar))
4207     (nacute 241 (acute "n" Nacute))
4208     (ncaron 242 (caron "n" Ncaron))
4209     (oacute 243 . t)
4210     (ocircumflex 244 . t)
4211     (ohungarumlaut 245 (hungarumlaut "o" Ohungarumlaut))
4212     (odiaeresis 246 . t)
4213     (division 247 . t)
4214     (rcaron 248 (caron "r" Rcaron))
4215     (uring 249 (ring "u" Uring))
4216     (uacute 250 . t)
4217     (uhungarumlaut 251 (hungarumlaut "u" Uhungarumlaut))
4218     (udiaeresis 252 . t)
4219     (yacute 253 . t)
4220     (tcedilla 254 (cedilla "t" Tcedilla))
4221     (dotaccent 255 (dotaccent accent) (shift up)))
4222   "Table for registry \"iso8859-2\", see `x-symbol-init-cset'.")
4223
4224 (defvar x-symbol-latin3-table
4225   '((nobreakspace 160 . t)
4226     (Hbar 161 (slash "H" hbar))
4227     (breve 162 . t)
4228     (sterling 163 . t)
4229     (currency 164 . t)
4230     (unused-l3/165 165 . unused)
4231     (Hcircumflex 166 (circumflex "H" hcircumflex))
4232     (section 167 . t)
4233     (diaeresis 168 . t)
4234     (Idotaccent 169 (dotaccent "I" dotlessi))
4235     (Scedilla 170 . t)
4236     (Gbreve 171 (breve "G" gbreve))
4237     (Jcircumflex 172 (circumflex "J" jcircumflex))
4238     (hyphen 173 . t)
4239     (unused-l3/174 174 . unused)
4240     (Zdotaccent 175 . t)
4241     (degree 176 . t)
4242     (hbar 177 (slash "h" Hbar))
4243     (twosuperior 178 . t)
4244     (threesuperior 179 . t)
4245     (acute 180 . t)
4246     (mu1 181 . t)
4247     (hcircumflex 182 (circumflex "h" hcircumflex))
4248     (periodcentered 183 . t)
4249     (cedilla 184 . t)
4250     (dotlessi 185 (dotaccent "i" Idotaccent))
4251     (scedilla 186 . t)
4252     (gbreve 187 (breve "g" Gbreve))
4253     (jcircumflex 188 (circumflex "j" Jcircumflex))
4254     (onehalf 189 . t)
4255     (unused-l3/190 190 . unused)
4256     (zdotaccent 191 . t)
4257     (Agrave 192 . t)
4258     (Aacute 193 . t)
4259     (Acircumflex 194 . t)
4260     (unused-l3/195 195 . unused)
4261     (Adiaeresis 196 . t)
4262     (Cdotaccent 197 (dotaccent "C" cdotaccent))
4263     (Ccircumflex 198 (circumflex "C" ccircumflex))
4264     (Ccedilla 199 . t)
4265     (Egrave 200 . t)
4266     (Eacute 201 . t)
4267     (Ecircumflex 202 . t)
4268     (Ediaeresis 203 . t)
4269     (Igrave 204 . t)
4270     (Iacute 205 . t)
4271     (Icircumflex 206 . t)
4272     (Idiaeresis 207 . t)
4273     (unused-l3/208 208 . unused)
4274     (Ntilde 209 . t)
4275     (Ograve 210 . t)
4276     (Oacute 211 . t)
4277     (Ocircumflex 212 . t)
4278     (Gdotaccent 213 (dotaccent "G" gdotaccent))
4279     (Odiaeresis 214 . t)
4280     (multiply 215 . t)
4281     (Gcircumflex 216 (circumflex "G" gcircumflex))
4282     (Ugrave 217 . t)
4283     (Uacute 218 . t)
4284     (Ucircumflex 219 . t)
4285     (Udiaeresis 220 . t)
4286     (Ubreve 221 (breve "U" ubreve))
4287     (Scircumflex 222 (circumflex "S" scircumflex))
4288     (ssharp 223 . t)
4289     (agrave 224 . t)
4290     (aacute 225 . t)
4291     (acircumflex 226 . t)
4292     (unused-l3/227 227 . unused)
4293     (adiaeresis 228 . t)
4294     (cdotaccent 229 (dotaccent "c" Cdotaccent))
4295     (ccircumflex 230 (circumflex "c" Ccircumflex))
4296     (ccedilla 231 . t)
4297     (egrave 232 . t)
4298     (eacute 233 . t)
4299     (ecircumflex 234 . t)
4300     (ediaeresis 235 . t)
4301     (igrave 236 . t)
4302     (iacute 237 . t)
4303     (icircumflex 238 . t)
4304     (idiaeresis 239 . t)
4305     (unused-l3/240 240 . unused)
4306     (ntilde 241 . t)
4307     (ograve 242 . t)
4308     (oacute 243 . t)
4309     (ocircumflex 244 . t)
4310     (gdotaccent 245 (dotaccent "g" Gdotaccent))
4311     (odiaeresis 246 . t)
4312     (division 247 . t)
4313     (gcircumflex 248 (circumflex "g" Gcircumflex))
4314     (ugrave 249 . t)
4315     (uacute 250 . t)
4316     (ucircumflex 251 . t)
4317     (udiaeresis 252 . t)
4318     (ubreve 253 (breve "u" Ubreve))
4319     (scircumflex 254 (circumflex "s" Scircumflex))
4320     (dotaccent 255 . t))
4321   "Table for registry \"iso8859-3\", see `x-symbol-init-cset'.")
4322
4323 (defvar x-symbol-latin5-table
4324   '((nobreakspace 160 . t)
4325     (exclamdown 161 . t)
4326     (cent 162 . t)
4327     (sterling 163 . t)
4328     (currency 164 . t)
4329     (yen 165 . t)
4330     (brokenbar 166 . t)
4331     (section 167 . t)
4332     (diaeresis 168 . t)
4333     (copyright 169 . t)
4334     (ordfeminine 170 . t)
4335     (guillemotleft 171 . t)
4336     (notsign 172 . t)
4337     (hyphen 173 . t)
4338     (registered 174 . t)
4339     (macron 175 . t)
4340     (degree 176 . t)
4341     (plusminus 177 . t)
4342     (twosuperior 178 . t)
4343     (threesuperior 179 . t)
4344     (acute 180 . t)
4345     (mu1 181 . t)
4346     (paragraph 182 . t)
4347     (periodcentered 183 . t)
4348     (cedilla 184 . t)
4349     (onesuperior 185 . t)
4350     (masculine 186 . t)
4351     (guillemotright 187 . t)
4352     (onequarter 188 . t)
4353     (onehalf 189 . t)
4354     (threequarters 190 . t)
4355     (questiondown 191 . t)
4356     (Agrave 192 . t)
4357     (Aacute 193 . t)
4358     (Acircumflex 194 . t)
4359     (Atilde 195 . t)
4360     (Adiaeresis 196 . t)
4361     (Aring 197 . t)
4362     (AE 198 . t)
4363     (Ccedilla 199 . t)
4364     (Egrave 200 . t)
4365     (Eacute 201 . t)
4366     (Ecircumflex 202 . t)
4367     (Ediaeresis 203 . t)
4368     (Igrave 204 . t)
4369     (Iacute 205 . t)
4370     (Icircumflex 206 . t)
4371     (Idiaeresis 207 . t)
4372     (Gbreve 208 . t)
4373     (Ntilde 209 . t)
4374     (Ograve 210 . t)
4375     (Oacute 211 . t)
4376     (Ocircumflex 212 . t)
4377     (Otilde 213 . t)
4378     (Odiaeresis 214 . t)
4379     (multiply 215 . t)
4380     (Ooblique 216 . t)
4381     (Ugrave 217 . t)
4382     (Uacute 218 . t)
4383     (Ucircumflex 219 . t)
4384     (Udiaeresis 220 . t)
4385     (Idotaccent 221 . t)
4386     (Scedilla 222 . t)
4387     (ssharp 223 . t)
4388     (agrave 224 . t)
4389     (aacute 225 . t)
4390     (acircumflex 226 . t)
4391     (atilde 227 . t)
4392     (adiaeresis 228 . t)
4393     (aring 229 . t)
4394     (ae 230 . t)
4395     (ccedilla 231 . t)
4396     (egrave 232 . t)
4397     (eacute 233 . t)
4398     (ecircumflex 234 . t)
4399     (ediaeresis 235 . t)
4400     (igrave 236 . t)
4401     (iacute 237 . t)
4402     (icircumflex 238 . t)
4403     (idiaeresis 239 . t)
4404     (gbreve 240 . t)
4405     (ntilde 241 . t)
4406     (ograve 242 . t)
4407     (oacute 243 . t)
4408     (ocircumflex 244 . t)
4409     (otilde 245 . t)
4410     (odiaeresis 246 . t)
4411     (division 247 . t)
4412     (oslash 248 . t)
4413     (ugrave 249 . t)
4414     (uacute 250 . t)
4415     (ucircumflex 251 . t)
4416     (udiaeresis 252 . t)
4417     (dotlessi 253 . t)
4418     (scedilla 254 . t)
4419     (ydiaeresis 255 . t))
4420   "Table for registry \"iso8859-9\", see `x-symbol-init-cset'.")
4421
4422 (defvar x-symbol-latin9-table
4423   '((nobreakspace 160 . t)
4424     (exclamdown 161 . t)
4425     (cent 162 . t)
4426     (sterling 163 . t)
4427     (euro 164 (currency "C") nil nil ("C="))
4428     (yen 165 . t)
4429     (Scaron 166 . t)                    ; latin-2
4430     (section 167 . t)
4431     (scaron 168 . t)                    ; latin-2
4432     (copyright 169 . t)
4433     (ordfeminine 170 . t)
4434     (guillemotleft 171 . t)
4435     (notsign 172 . t)
4436     (hyphen 173 . t)
4437     (registered 174 . t)
4438     (macron 175 . t)
4439     (degree 176 . t)
4440     (plusminus 177 . t)
4441     (twosuperior 178 . t)
4442     (threesuperior 179 . t)
4443     (Zcaron 180 . t)                    ; latin-2
4444     (mu1 181 . t)
4445     (paragraph 182 . t)
4446     (periodcentered 183 . t)
4447     (zcaron 184 . t)                    ; latin-2
4448     (onesuperior 185 . t)
4449     (masculine 186 . t)
4450     (guillemotright 187 . t)
4451     (OE 188 (letter "OE" oe))
4452     (oe 189 (letter "oe" OE))
4453     (Ydiaeresis 190 (diaeresis "Y" ydiaeresis))
4454     (questiondown 191 . t)
4455     (Agrave 192 . t)
4456     (Aacute 193 . t)
4457     (Acircumflex 194 . t)
4458     (Atilde 195 . t)
4459     (Adiaeresis 196 . t)
4460     (Aring 197 . t)
4461     (AE 198 . t)
4462     (Ccedilla 199 . t)
4463     (Egrave 200 . t)
4464     (Eacute 201 . t)
4465     (Ecircumflex 202 . t)
4466     (Ediaeresis 203 . t)
4467     (Igrave 204 . t)
4468     (Iacute 205 . t)
4469     (Icircumflex 206 . t)
4470     (Idiaeresis 207 . t)
4471     (ETH 208 . t)
4472     (Ntilde 209 . t)
4473     (Ograve 210 . t)
4474     (Oacute 211 . t)
4475     (Ocircumflex 212 . t)
4476     (Otilde 213 . t)
4477     (Odiaeresis 214 . t)
4478     (multiply 215 . t)
4479     (Ooblique 216 . t)
4480     (Ugrave 217 . t)
4481     (Uacute 218 . t)
4482     (Ucircumflex 219 . t)
4483     (Udiaeresis 220 . t)
4484     (Yacute 221 . t)
4485     (THORN 222 . t)
4486     (ssharp 223 . t)
4487     (agrave 224 . t)
4488     (aacute 225 . t)
4489     (acircumflex 226 . t)
4490     (atilde 227 . t)
4491     (adiaeresis 228 . t)
4492     (aring 229 . t)
4493     (ae 230 . t)
4494     (ccedilla 231 . t)
4495     (egrave 232 . t)
4496     (eacute 233 . t)
4497     (ecircumflex 234 . t)
4498     (ediaeresis 235 . t)
4499     (igrave 236 . t)
4500     (iacute 237 . t)
4501     (icircumflex 238 . t)
4502     (idiaeresis 239 . t)
4503     (eth 240 . t)
4504     (ntilde 241 . t)
4505     (ograve 242 . t)
4506     (oacute 243 . t)
4507     (ocircumflex 244 . t)
4508     (otilde 245 . t)
4509     (odiaeresis 246 . t)
4510     (division 247 . t)
4511     (oslash 248 . t)
4512     (ugrave 249 . t)
4513     (uacute 250 . t)
4514     (ucircumflex 251 . t)
4515     (udiaeresis 252 . t)
4516     (yacute 253 . t)
4517     (thorn 254 . t)
4518     (ydiaeresis 255 . t))
4519   "Table for registry \"iso8859-15\", see `x-symbol-init-cset'.")
4520
4521 (defvar x-symbol-xsymb0-table
4522   '(;;(exclam1 33)                      ; Adobe:exclam
4523     ;;(universal 34 (symbol) nil nil ("A"))
4524     (numbersign1 35 (symbol) nil nil ("#")) ; Adobe:numbersign, TeX
4525     ;;(existential 36 (symbol) nil nil ("E"))
4526     ;;(percent1 37 (symbol) nil nil ("%"))      ; Adobe:percent
4527     ;;(ampersand1 38 (symbol) nil nil ("&"))
4528     (suchthat 39 (relation) (direction east . element) nil ("-)"))
4529     ;;(parenleft1 40)                   ; Adobe:parenleft
4530     ;;(parenright1 41)                  ; Adobe:parenright
4531     (asterisk1 42 (operator) nil nil ("*")) ; Adobe:asteriskmath
4532     ;;(plus1 43)                                ; Adobe:plus
4533     ;;(comma1 44 (quote) nil (","))     ; Adobe:comma
4534     (minus1 45 (operator) nil nil ("-"))        ; Adobe:minus
4535     (period1 46 (dots) nil nil ("."))   ; Adobe:period
4536     ;;(slash1 47)                               ; Adobe:slash
4537     ;; 48..57 = ascii 0-9
4538     (colon1 58 (dots) nil nil (":"))    ; Adobe:colon, TeX
4539     ;;(semicolon1 59)                   ; Adobe:semicolon
4540     ;;(less1 60 (relation) (direction west . greater1) nil ("<"))
4541     ;;(equal1 61)                               ; Adobe:equal
4542     ;;(greater1 62 (relation) (direction east) nil (">"))
4543     ;;(question1 63)                    ; Adobe:question
4544     (congruent 64 (relation) nil nil (t "~="))
4545     (Delta 68 (greek "D" delta "Delta"))
4546     (Phi 70 (greek "F" phi "Phi"))
4547     (Gamma 71 (greek "G" gamma "Gamma"))
4548     (theta1 74 (greek1 "q" Theta "theta"))
4549     (Lambda 76 (greek "L" lambda "Lambda"))
4550     (Pi 80 (greek "P" pi "Pi"))
4551     (Theta 81 (greek "Q" theta "Theta"))
4552     (Sigma 83 (greek "S" sigma "Sigma"))
4553     (sigma1 86 (greek1 "s" Sigma "sigma"))
4554     (Omega 87 (greek "W" omega "Omega"))
4555     (Xi 88 (greek "X" xi "Xi"))
4556     (Psi 89 (greek "Y" psi "Psi"))
4557     ;;(bracketleft1 91)                 ; Adobe:bracketleft
4558     ;;(therefore 92 (dots) (direction nil . ellipsis) nil (".:"))
4559     ;;(bracketright1 93)                        ; Adobe:bracketright
4560     (perpendicular 94 (arrow) (direction north) nil (t "_|_")) ; (TeX)
4561     (underscore1 95 (line) nil nil ("_"))       ; Adobe:underscore, TeX
4562     (radicalex 96 (line) (shift up) nil ("-^" "^-"))
4563     (alpha 97 (greek "a" nil "alpha"))
4564     (beta 98 (greek "b" nil "beta"))
4565     (chi 99 (greek "c" nil "chi"))
4566     (delta 100 (greek "d" Delta "delta"))
4567     (epsilon 101 (greek "e" nil "epsilon"))
4568     (phi 102 (greek "f" Phi "phi"))
4569     (gamma 103 (greek "g" Gamma "gamma"))
4570     (eta 104 (greek "h" nil "eta"))
4571     (iota 105 (greek "i" nil "iota"))
4572     (phi1 106 (greek1 "f" Phi "phi"))
4573     (kappa 107 (greek "k" nil "kappa"))
4574     (lambda 108 (greek "l" Lambda "lambda"))
4575     (mu 109 (greek "m" nil "mu"))
4576     (nu 110 (greek "n" nil "nu"))
4577     (pi 112 (greek "p" Pi "pi"))
4578     (theta 113 (greek "q" Theta "theta"))
4579     (rho 114 (greek "r" nil "rho"))
4580     (sigma 115 (greek "s" Sigma "sigma"))
4581     (tau 116 (greek "t" nil "tau"))
4582     (upsilon 117 (greek "u" Upsilon1 "upsilon"))
4583     (omega1 118 (greek1 "w" Omega "omega"))
4584     (omega 119 (greek "w" Omega "omega"))
4585     (xi 120 (greek "x" Xi "xi"))
4586     (psi 121 (greek "y" Psi "psi"))
4587     (zeta 122 (greek "z" nil "zeta"))
4588 ;;;    (braceleft1 123 (parenthesis open braceright1)
4589 ;;;             (direction west . braceright1) nil ("{"))
4590     (bar1 124 (line) brokenbar 120 ("|"))       ; Adobe:bar, TeX
4591 ;;;    (braceright1 125 (parenthesis close braceleft1) (direction east) nil ("}"))
4592     (similar 126 (relation) nil nil ("~"))
4593     (Upsilon1 161 (greek1 "U" upsilon "Upsilon"))
4594     (minute 162 (symbol) nil nil ("'"))
4595     (lessequal 163 (relation) (direction west . greaterequal) nil (t "<_"))
4596     (fraction 164 (operator) nil nil ("/"))
4597     (infinity 165 (symbol) nil nil ("oo"))
4598     (florin 166 (currency "f") nil nil ("f"))
4599     (club 167 (shape) (direction north . diamond) nil ("{#}"))
4600     (diamond 168 (shape) (direction east . lozenge) nil ("<#>"))
4601     (heart 169 (shape) (direction south . diamond) nil ("(#)"))
4602     (spade 170 (shape) (direction west . diamond) nil ("/#\\"))
4603     (arrowboth 171 (arrow) (direction horizontal . arrowright) nil
4604                (t "<->") (arrowleft))
4605     (arrowleft 172 (arrow) (direction west . arrowright) nil (t "<-"))
4606     (arrowup 173 (arrow) (direction north . arrowright) nil ("|^"))
4607     (arrowright 174 (arrow) (direction east) nil (t "->"))
4608     (arrowdown 175 (arrow) (direction south . arrowright) nil ("|v"))
4609     (ring 176 (ring accent))            ; Adobe:degree, TeX
4610     ;;(plusminus1 177)                  ; Adobe:plusminus
4611     (second 178 (symbol) nil nil ("''"))                ; NEW
4612     (greaterequal 179 (relation) (direction east) nil (t ">_"))
4613     ;;(times1 180)                              ; Adobe:times
4614     (proportional 181 (relation) nil nil ("oc"))
4615     (partialdiff 182 (mathletter "d"))
4616     (bullet 183 (operator) nil 240 ("*"))
4617     ;;(divide1 184)                     ; Adobe:divide
4618     (notequal 185 (relation) nil nil (t "=/"))
4619     (equivalence 186 (relation) nil nil (t "=_"))
4620     (approxequal 187 (relation) nil nil (t "~~"))
4621     (ellipsis 188 (dots) (direction east) nil (t "..."))
4622     ;;(arrowhorizex 190 (line) (size big) nil ("-"))
4623     (carriagereturn 191 (arrow) (direction west) nil ("<-|"))   ; NEW
4624     (aleph 192 (mathletter "N"))
4625     (Ifraktur 193 (mathletter "I"))
4626     (Rfraktur 194 (mathletter "R"))
4627     (weierstrass 195 (mathletter "P"))
4628     (circlemultiply 196 (operator) nil nil (t "xO") (multiply))
4629     (circleplus 197 (operator) nil nil (t "+O"))
4630     (emptyset 198 (shape) nil nil ("0/" "O/"))
4631     (intersection 199 (operator) (shape round . logicaland))
4632     (union 200 (operator) (shape round . logicalor))
4633     (propersuperset 201 (relation) (direction east . union) nil (">"))
4634     (reflexsuperset 202 (relation) (shape round . greaterequal) nil
4635                     nil (propersuperset))
4636     (notsubset 203 (relation) (shape round direction west) nil
4637                ("</") (propersubset))
4638     (propersubset 204 (relation) (direction west . propersuperset) nil ("<"))
4639     (reflexsubset 205 (relation) (shape round . lessequal) nil
4640                   nil (propersubset))
4641     (element 206 (relation) (direction west) nil ("(-"))
4642     (notelement 207 (relation) (direction west) nil (t "(-/") (element))
4643     (angle 208 (symbol) nil nil ("/_"))
4644     (gradient 209 (triangle) (direction south . Delta) nil (t "\\-/"))
4645     ;;(register1 210)                   ; Adobe:registerserif
4646     ;;(copyright1 211)                  ; Adobe:copyrightserif
4647     ;;(trademark1 212)                  ; Adobe:trademarkserif
4648     (product 213 (bigop) (size big . Pi) nil ("TT"))
4649     (radical 214 (symbol) nil nil ("v/"))
4650     (periodcentered1 215 (dots) periodcentered 120) ; Adobe:dotmath, (TeX)
4651     ;;(logicalnot1 216)                 ; Adobe:logicalnot
4652     (logicaland 217 (operator) (direction north . logicalor) nil (t "/\\"))
4653     (logicalor 218 (operator) (direction south) nil (t "\\/"))
4654     (arrowdblboth 219 (arrow) (direction horizontal . arrowdblright) nil
4655                   (t "<=>") (arrowdblleft))
4656     (arrowdblleft 220 (arrow) (direction west . arrowdblright) nil (t "<="))
4657     (arrowdblup 221 (arrow) (direction north . arrowdblright) nil ("||^"))
4658     (arrowdblright 222 (arrow) (direction east) nil (t "=>"))
4659     (arrowdbldown 223 (arrow) (direction south . arrowdblright) nil ("||v"))
4660     (lozenge 224 (shape) nil nil ("<>"))
4661     (angleleft 225 (parenthesis open angleright)
4662                (direction west . angleright) 120 ("{"))
4663     ;;(registered2 226)                 ; Adobe:registersans
4664     ;;(copyright2 227)                  ; Adobe:copyrightsans
4665     (trademark 228 (symbol "T") nil nil ("TM")) ; Adobe:trademarksans
4666     (summation 229 (bigop) (size big . Sigma))
4667     (angleright 241 (parenthesis close angleleft) (direction east) 120 ("}"))
4668     (integral 242 (bigop) (size big) nil (t "|'")))
4669   "Table for registry \"fontspecific\", see `x-symbol-init-cset'.")
4670
4671 (defvar x-symbol-xsymb1-table
4672   '((verticaldots 33 (dots) (direction north . ellipsis) nil (":."))
4673     (backslash1 34 (line) nil nil ("\\"))
4674     (dagger 35 (symbol) (direction north) nil ("|+"))
4675     ;;(unused36 36)
4676     ;;(unused36 37)
4677     (percent2 38 (symbol) nil nil ("%"))
4678     (guilsinglright 39 (quote close guilsinglleft) (direction east) 3000 (">"))
4679                                         ; should be after the relations
4680     (NG 40 (letter "NG" ng))
4681     ;;(OE 41 (letter "OE" oe)) ; now latin-9
4682     (dotlessj 42 (dotaccent "j" nil))
4683     (ng 43 (letter "ng" NG))
4684     ;;(oe 44 (letter "oe" OE)) ; now latin-9
4685     (sharp 45 (symbol) nil nil ("#"))
4686     (ceilingleft 46 (parenthesis open ceilingright) (shift up . floorleft)
4687                  nil ("["))
4688     (ceilingright 47 (parenthesis close ceilingleft) (shift up . floorright)
4689                   nil ("]"))
4690     (zero1 48 (digit1 "0"))
4691     (one1 49 (digit1 "1"))
4692     (two1 50 (digit1 "2"))
4693     (three1 51 (digit1 "3"))
4694     (four1 52 (digit1 "4"))
4695     (five1 53 (digit1 "5"))
4696     (six1 54 (digit1 "6"))
4697     (seven1 55 (digit1 "7"))
4698     (eight1 56 (digit1 "8"))
4699     (nine1 57 (digit1 "9"))
4700     (star 58 (operator) nil nil ("*"))
4701     (lozenge1 59 (shape) lozenge -240 ("<>"))
4702     (braceleft2 60 (parenthesis open braceright2)
4703                 (direction west . braceright2) nil ("{"))
4704     (circleslash 61 (operator) nil nil ("/O"))
4705     (braceright2 62 (parenthesis close braceleft2) (direction east) nil ("}"))
4706     (triangle1 63 (triangle) triangle 120)
4707     (smltriangleright 64 (triangle) (size sml . triangleright))
4708     (triangleleft 65 (triangle) (direction west . gradient) nil ("<|"))
4709     (triangle 66 (triangle) (direction north . gradient) nil (t "/_\\"))
4710     (triangleright 67 (triangle) (direction east . gradient) nil ("|>"))
4711     (trianglelefteq 68 (triangle) (direction west . trianglerighteq) nil
4712                     ("<|_") (triangleleft))
4713     (trianglerighteq 69 (triangle) (direction east) nil ("|>_") (triangleright))
4714     (periodcentered2 70 (dots) periodcentered 240)
4715     (dotequal 71 (relation) nil nil ("=."))
4716     (wrong 72 (relation) (direction south . similar) 1500 ("~"))
4717     (natural 73 (symbol) nil 120 ("#"))
4718     (flat 74 (symbol) nil nil ("b"))
4719     (epsilon1 75 (greek1 "e" nil "epsilon"))
4720     (hbarmath 76 (mathletter "h"))
4721     (imath 77 (mathletter "i"))
4722     (kappa1 78 (greek1 "k" nil "kappa"))
4723     (jmath 79 (mathletter "j"))
4724     (ell 80 (mathletter "l"))
4725     (amalg 81 (bigop) (size sml . coproduct))
4726     (rho1 82 (greek1 "r" nil "rho"))
4727     (top 83 (arrow) (direction south . perpendicular) nil ("T"))
4728     (Mho 84 (greek1 "M" nil  "Mho") (direction south . Omega))
4729     (floorleft 85 (parenthesis open floorright) (direction west . floorright)
4730                nil ("["))
4731     (floorright 86 (parenthesis close floorleft) (direction east) nil ("]"))
4732     (perpendicular1 87 (arrow) perpendicular 120)
4733     (box 88 (shape) nil nil ("[]"))
4734     (asciicircum1 89 (symbol) nil nil ("^"))
4735     (asciitilde1 90 (symbol) nil nil ("~"))
4736     (leadsto 91 (arrow) (direction east) nil ("~>"))
4737     (quotedbl1 92 (quote) nil nil ("\""))
4738     (longarrowleft 93 (arrow) (size big . arrowleft) nil
4739                    ("<-" t "<--") (arrowleft))
4740     (arrowupdown 94 (arrow) (direction vertical . arrowright) nil
4741                  ("|v^" "|^v") (arrowup arrowdown))
4742     (longarrowright 95 (arrow) (size big . arrowright) nil
4743                     ("->" t "-->") (emdash))
4744     (longmapsto 96 (arrow) (size big . mapsto) nil ("|->" t "|-->"))
4745     (longarrowdblboth 97 (arrow) (size big . arrowdblboth) nil ("<=>" t "<==>")
4746                       (longarrowdblleft))
4747     (longarrowdblleft 98 (arrow) (size big . arrowdblleft) nil ("<=" t "<==")
4748                       (arrowdblleft))
4749     (arrowdblupdown 99 (arrow) (direction vertical . arrowdblright) nil
4750                     ("||v^" "||^v") (arrowdblup arrowdbldown))
4751     (longarrowdblright 100 (arrow) (size big . arrowdblright) nil
4752                        ("=>" t "==>"))
4753     (mapsto 101 (arrow) (direction east) nil (t "|->"))
4754     (iff 102 (arrow) longarrowdblboth 120)
4755     (hookleftarrow 103 (arrow) (direction west . hookrightarrow) nil
4756                    ("<-`") (leftarrow))
4757     (hookrightarrow 104 (arrow) (direction east) nil ("'->") (leftharpoonup))
4758     (arrownortheast 105 (arrow) (direction north-east . arrowright) nil ("/>"))
4759     (arrowsoutheast 106 (arrow) (direction south-east . arrowright) nil ("\\>"))
4760     (arrownorthwest 107 (arrow) (direction north-west . arrowright) nil ("\\<"))
4761     (arrowsouthwest 108 (arrow) (direction south-west . arrowright) nil ("/<"))
4762     (rightleftharpoons 109 (arrow) (direction horizontal . rightharpoonup) nil
4763                        (",=`"))
4764     (leftharpoondown 110 (arrow) (direction south-west . rightharpoondown) nil
4765                      (",-"))
4766     (rightharpoondown 111 (arrow) (direction south-east . rightharpoonup) nil
4767                       ("-,"))
4768     (leftharpoonup 112 (arrow) (direction north-west . rightharpoonup) nil
4769                    ("'-"))
4770     (rightharpoonup 113 (arrow) (direction north-east) nil ("-`"))
4771     (bardbl 114 (line) (direction east) nil (t "||"))
4772     (bardbl1 115 (line) bardbl 120 nil (bar1))
4773     (backslash2 116 (line) nil 240 ("\\"))
4774     (backslash3 117 (line) nil 120 ("\\"))
4775     (diagonaldots 118 (dots) (direction south-east . ellipsis) 300 (":."))
4776     (simequal 119 (relation) nil nil (t "~_") (similar))
4777     (digamma 120 (mathletter "F"))
4778     (asym 121 (relation) (direction vertical . smile) nil (">=<"))
4779     (minusplus 122 (operator) (direction south . plusminus) nil (t "-+"))
4780     (less2 123 (relation) (direction west . greater2) nil ("<")) ; SGML
4781     (bowtie 124 (triangle) (direction horizontal . triangle) nil ("|X|"))
4782     (greater2 125 (relation) (direction east) nil (">")) ; SGML
4783     (centraldots 126 (dots) (shift up . ellipsis))
4784     (visiblespace 160 (white) nil nil ("_" ",_," " "))
4785     (dagger1 161 (symbol) dagger 120)
4786     (circledot 162 (operator) nil nil (t ".O") (periodcentered))
4787     (propersqsuperset 163 (relation) (shape square . propersuperset))
4788     (reflexsqsuperset 164 (relation) (shape square . reflexsuperset) nil
4789                       nil (propersuperset))
4790     (gradient1 165 (triangle) gradient 120)
4791     (propersqsubset 166 (relation) (shape square . propersubset) nil ("<"))
4792     (reflexsqsubset 167 (relation) (shape square . reflexsubset) nil
4793                     nil (propersqsubset))
4794     (smllozenge 168 (shape) (size sml . lozenge))
4795     (lessless 169 (relation) (direction west . greatergreater) nil ("<<"))
4796     (greatergreater 170 (relation) (direction east) nil (">>"))
4797     (unionplus 171 (operator) (shape round direction south) nil
4798                (t "\\/+") (union))
4799     (sqintersection 172 (operator) (shape square . logicaland))
4800     (squnion 173 (operator) (shape square . logicalor))
4801     (frown 174 (relation) (direction north . smile) nil (",-,"))
4802     (smile 175 (relation) (direction south) nil ("`-'"))
4803     (reflexprec 176 (relation) (shape curly . lessequal) nil nil (properprec))
4804     (reflexsucc 177 (relation) (shape curly . greaterequal) nil nil
4805                 (propersucc))
4806     (properprec 178 (relation) (shape curly . propersubset))
4807     (propersucc 179 (relation) (shape curly . propersuperset))
4808     (bardash 180 (arrow) (direction east . perpendicular) nil (t "|-"))
4809     (dashbar 181 (arrow) (direction west . perpendicular) nil ("-|"))
4810     (bardashdbl 182 (arrow) (direction east) nil (t "|="))
4811     (smlintegral 183 (bigop) (size sml . integral))
4812     (circleintegral 184 (bigop) (size big) nil (t "|'O") (integral))
4813     (coproduct 185 (bigop) (direction south . product) nil (t "|_|"))
4814     (bigcircledot 186 (bigop) (size big . circledot))
4815     (bigcirclemultiply 187 (bigop) (size big . circlemultiply))
4816     (bigcircleplus 188 (bigop) (size big . circleplus))
4817     (biglogicaland 189 (bigop) (size big . logicaland))
4818     (biglogicalor 190 (bigop) (size big . logicalor))
4819     (bigintersection 191 (bigop) (size big . intersection))
4820     (bigunion 192 (bigop) (size big . union))
4821     (bigunionplus 193 (bigop) (size big . unionplus) nil nil (bigunion))
4822     (bigsqunion 194 (bigop) (size big . squnion))
4823     (bigcircle 195 (operator) (size big . circ) nil ("O"))
4824 ;;;    (quotedblbase 196 (quote) (shift down) nil ("\""))
4825 ;;;    (quotedblleft 197 (quote open quotedblright)
4826 ;;;               (direction west . quotedblright) nil ("``"))
4827 ;;;    (quotedblright 198 (quote close quotedblleft) (direction east) nil ("''"))
4828     (guilsinglleft 196 (quote open guilsinglright)
4829                    (direction west . guilsinglright) nil ("<"))
4830     (circleminus 197 (operator) Theta 120 ("-O"))
4831     (smltriangleleft 198 (triangle) (size sml . triangleleft))
4832     (perthousand 199 (symbol) nil nil ("%."))
4833     (existential1 200 (symbol) nil nil ("E"))
4834     (daggerdbl1 201 (symbol) daggerdbl 120 nil (dagger1))
4835     (daggerdbl 202 (symbol) (direction vertical . dagger) nil
4836                (t "|++") (dagger))
4837     (bigbowtie 203 (triangle) (size big . bowtie))
4838     (circ 204 (operator) (shift up) nil ("o"))
4839     (grave 205 (grave accent))
4840     (circumflex 206 (circumflex accent))
4841     (tilde 207 (tilde accent))
4842     (longarrowboth 208 (arrow) (size big . arrowboth) nil ("<->" t "<-->")
4843                    (longarrowleft))
4844     (endash 209 (line) nil nil ("-" "--"))      ; TeX
4845     (emdash 210 (line) (size big) nil ("-" "--" "---")) ; TeX
4846     ;;(Ydiaeresis 211 (diaeresis "Y" ydiaeresis)) ; now latin-9
4847     (ampersand2 212 (symbol) nil nil ("&"))     ; TeX, SGML
4848     (universal1 213 (symbol) nil nil ("A"))
4849     (booleans 214 (setsymbol "B"))
4850     (complexnums 215 (setsymbol "C"))
4851     (natnums 216 (setsymbol "N"))
4852     (rationalnums 217 (setsymbol "Q"))
4853     (realnums 218 (setsymbol "R"))
4854     (integers 219 (setsymbol "Z"))
4855     (lesssim 220 (relation) (direction west . greatersim) nil (t "<~"))
4856     (greatersim 221 (relation) (direction east) nil (t ">~"))
4857     (lessapprox 222 (relation) (direction west . greaterapprox) nil (t "<~~"))
4858     (greaterapprox 223 (relation) (direction east) nil (t ">~~"))
4859     (definedas 224 (relation) nil nil (t "/_\\=" "^=") (triangle))
4860     (circleminus1 225 (operator) circleminus 240)
4861     (circleasterisk 226 (operator) nil nil ("*O") (asterisk1))
4862     (circlecirc 227 (operator) nil nil ("oO") (circ))
4863     (dollar1 228 (currency "$") nil nil ("$"))
4864     ;;(euro 229 (currency "C") nil nil ("C=")) ; now latin-9
4865     (therefore1 230 (dots) (direction nil . ellipsis) nil (".:"))
4866     (coloncolon 231 (dots) nil nil ("::"))
4867     (bigsqintersection 232 (bigop) (size big . sqintersection))
4868     (semanticsleft 233 (parenthesis open semanticsright)
4869                    (direction west . semanticsright) nil ("[[" t "[|"))
4870     (semanticsright 234 (parenthesis close semanticsleft)
4871                     (direction east) nil ("]]" t "|]"))
4872     (cataleft 235 (parenthesis open cataright)
4873               (direction west . cataright) nil (t "(|"))
4874     (cataright 236 (parenthesis close cataleft)
4875                (direction east) nil (t "|)"))
4876     )
4877   "Table for registry \"xsymb1\", see `x-symbol-init-cset'.")
4878
4879 (defvar x-symbol-no-of-charsyms (+ 179 274)) ; latin{1,2,3,5,9}, xsymb{0,1}
4880
4881
4882 ;;;===========================================================================
4883 ;;;  Calling the init code
4884 ;;;===========================================================================
4885
4886 (unless noninteractive
4887   ;; necessary for batch compilation of x-symbol-image.el etc.  CW: maybe
4888   ;; calling the init code here isn't that good after all (see info node
4889   ;; "Miscellaneous Questions"), we'll see later...
4890   (x-symbol-initialize)
4891   (setq x-symbol-all-charsyms nil)
4892
4893   ;; temp hack for console.  TODO: find better ways to prevent warnings etc
4894   (unless (console-type)
4895     (unless x-symbol-default-coding
4896       (warn "X-Symbol: only limited support on a console"))
4897     (unless (eq x-symbol-latin-force-use 'console-user)
4898       (setq x-symbol-latin1-fonts nil)
4899       (setq x-symbol-latin2-fonts nil)
4900       (setq x-symbol-latin3-fonts nil)
4901       (setq x-symbol-latin5-fonts nil)
4902       (setq x-symbol-latin9-fonts nil)
4903       (setq x-symbol-xsymb0-fonts nil)
4904       (setq x-symbol-xsymb1-fonts nil)))
4905
4906   (x-symbol-init-cset x-symbol-latin1-cset x-symbol-latin1-fonts
4907                       x-symbol-latin1-table)
4908   (x-symbol-init-cset x-symbol-latin2-cset x-symbol-latin2-fonts
4909                       x-symbol-latin2-table)
4910   (x-symbol-init-cset x-symbol-latin3-cset x-symbol-latin3-fonts
4911                       x-symbol-latin3-table)
4912   (x-symbol-init-cset x-symbol-latin5-cset x-symbol-latin5-fonts
4913                       x-symbol-latin5-table)
4914   (x-symbol-init-cset x-symbol-latin9-cset x-symbol-latin9-fonts
4915                       x-symbol-latin9-table)
4916   (x-symbol-init-latin-decoding)
4917
4918   (x-symbol-init-cset x-symbol-xsymb0-cset x-symbol-xsymb0-fonts
4919                       x-symbol-xsymb0-table)
4920   (x-symbol-init-cset x-symbol-xsymb1-cset x-symbol-xsymb1-fonts
4921                       x-symbol-xsymb1-table))
4922
4923 ;; (when x-symbol-mule-change-default-face
4924 ;;   (set-face-font 'default (face-attribute 'x-symbol-face :font)))
4925
4926 (easy-menu-define x-symbol-menu-map x-symbol-mode-map
4927                   "X-Symbol menu." x-symbol-menu)
4928
4929
4930 ;;; Local IspellPersDict: .ispell_xsymb
4931 ;;; x-symbol.el ends here