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

   1 ;;; x-symbol-hooks.el --- pre-loaded stuff for package x-symbol
   2
   3 ;; Copyright (C) 1996-1999, 2001-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 file provides `autoload's for package x-symbol, adds functions to hooks
  31 ;; for the automatic conversion and defines variables which control the
  32 ;; conversion.
  33
  34 ;;; Code:
  35
  36 (provide 'x-symbol-hooks)
  37 (require 'font-lock)
  38 (eval-when-compile (require 'cl))
  39 (eval-when-compile
  40   (defvar x-symbol-coding-name-alist)   ; in "x-symbol-vars"
  41   (defvar x-symbol-image-colormap-allocation) ; here
  42   (defvar x-symbol-image-convert-colormap) ; here
  43   (defvar x-symbol-cstring-table)       ; in x-symbol.el, only needed if loaded
  44   )
  45 (eval-when-compile
  46   (defvar lazy-shot-minimum-size)
  47   (defvar comint-input-sender)
  48   (defvar comint-last-input-end)
  49   (defvar comint-last-output-start)
  50   (defvar fast-lock-save-faces)
  51   (defvar latex-mode-hook)
  52   (defvar LaTeX-mode-hook)
  53   (defvar LaTeX-math-insert-function)
  54   (defvar orig-buffer)
  55   (defvar reftex-translate-to-ascii-function)
  56 )
  57
  58 (put 'x-symbol-define-user-options 'lisp-indent-function 2)
  59 (put 'x-symbol-dolist-delaying 'lisp-indent-function 2)
  60 (put 'x-symbol-do-plist 'lisp-indent-function 1)
  61 (put 'x-symbol-while-charsym 'lisp-indent-function 1)
  62 (put 'x-symbol-encode-for-charsym 'lisp-indent-function 1)
  63 (put 'x-symbol-decode-for-charsym 'lisp-indent-function 2)
  64 (put 'x-symbol-ignore-property-changes 'lisp-indent-function 0)
  65
  66 (defvar x-symbol-warn-of-old-emacs t
  67   "If non-nil, issue warning when using a old/buggy XEmacs.
  68 XEmacs-21.0 to XEmacs-21.1.8 has been reported to core when using input
  69 method token.")
  70
  71 ;; CW: if possible, back to x-symbol.el, do not load too many files at init
  72 (require (if (featurep 'xemacs) 'x-symbol-xmacs 'x-symbol-emacs))
  73
  74
  75 \f
  76 ;;;;##########################################################################
  77 ;;;;  Variables
  78 ;;;;##########################################################################
  79
  80
  81 (defvar x-symbol-data-directory
  82   (or (locate-data-directory "x-symbol")
  83       (progn (warn "X-Symbol is not installed at the proper place")
  84              nil))
  85   "Directory of data files that come with package X-Symbol.")
  86
  87 (defvar x-symbol-font-directory
  88   (and x-symbol-data-directory
  89        (expand-file-name "pcf/" x-symbol-data-directory))
  90   "Directory for additional X-Symbol fonts.
  91 If non-nil, used in function `x-symbol-initialize'.")
  92
  93
  94 ;;;===========================================================================
  95 ;;;  Functions to set user options
  96 ;;;===========================================================================
  97
  98 (defun x-symbol-define-user-options (var options &optional after-set set-fn)
  99   "Define options and setting behavior for user option VAR.
 100 OPTIONS has the form (FALLBACK . ALIST) where ALIST has elements of the
 101 form (OPTION . MENU-TEXT).  If ALIST is non-nil, one OPTION should be
 102 equal to FALLBACK, its MENU-TEXT is used for any values not being keys
 103 in ALIST.  OPTIONS can also be a function which should return the form
 104 mention above.
 105
 106 If ALIST is nil, `x-symbol-submenu-filter', which is used by
 107 `x-symbol-menu', uses a toggle button with FALLBACK as the non-nil value
 108 and \\[set-variable] offers completion with matches nil and FALLBACK.
 109 Otherwise, the menu uses radio buttons for all OPTIONs, where MENU-TEXT
 110 is the name of the menu item, and \\[set-variable] offers completion
 111 over all OPTIONs.
 112
 113 `x-symbol-set-variable', which is invoked by the menu callbacks, uses
 114 SET-FN instead `set' to set the value of VAR if SET-FN is non-nil.
 115 Otherwise, all functions in AFTER-SET are invoked after `set'ting VAR."
 116   (put var 'x-symbol-options options)
 117   (put var 'variable-interactive
 118        (list 'x-symbol-variable-interactive (list 'quote var)))
 119   (while after-set
 120     (pushnew (pop after-set) (get var 'x-symbol-after-set-hook) :test 'equal))
 121   (if set-fn (put var 'x-symbol-set-function set-fn)))
 122
 123 ;; CW: autoload important if var `x-symbol-auto-mode-suffixes' is saved by
 124 ;; custom
 125 ;;;###autoload
 126 (defun x-symbol-auto-mode-suffixes (&optional suffixes)
 127   "Return REGEXPs of three-value elements in `auto-mode-alist'.
 128 These REGEXPs are added to SUFFIXES."
 129   (setq suffixes (reverse suffixes))
 130   (let ((alist auto-mode-alist))
 131     (while alist
 132       (and (consp (cdar alist))
 133            (null (member (caar alist) suffixes))
 134            (push (caar alist) suffixes))
 135       (setq alist (cdr alist)))
 136     (nreverse suffixes)))
 137
 138
 139 ;;;===========================================================================
 140 ;;;  Initialization
 141 ;;;===========================================================================
 142
 143 (defcustom x-symbol-initialize t
 144   "Whether to do an extended initialization of package X-Symbol.
 145 If t, do full initialization.  Otherwise, the value should be a list
 146 with element.  To enable, include
 147
 148  * `languages' to register all supported token languages,
 149  * `global' to turn on X-Symbol's global mode, i.e., as files are
 150    loaded, execute `turn-on-x-symbol-conditionally',
 151  * `keys' to set up the usual X-Symbol key bindings in `global-map',
 152  * `font-path' to add `x-symbol-font-directory' to the font-path,
 153  * `comint' to make X-Symbol work with comint,
 154  * `fast-lock' to make X-Symbol work with fast-lock,
 155  * `auctex' to make X-Symbol optimally work with AucTeX 9.8a+, it
 156    changes AucTeX's `TeX-region-hook', `TeX-translate-location-hook',
 157    and `LaTeX-math-insert-function',
 158  * `reftex' to make X-Symbol optimally work with RefTeX 3.26+,
 159  * `bib-cite' to make X-Symbol not overwriting bib-cite's highlighting.
 160
 161 You do not have to install the packages whose initialization is
 162 enabled."
 163   :group 'x-symbol-mode
 164   :type '(choice (const :tag "All" t)
 165                  (set :value (languages global keys font-path comint
 166                                         fast-lock auctex reftex bib-cite)
 167                       (const :tag "Token languages" languages)
 168                       (const :tag "Global mode" global)
 169                       (const :tag "Key bindings" keys)
 170                       (const :tag "Font path" font-path)
 171                       (const :tag "Package comint" comint)
 172                       (const :tag "Package fast-lock" fast-lock)
 173                       (const :tag "Package AucTeX" auctex)
 174                       (const :tag "Package RefTeX" reftex)
 175                       (const :tag "Package bib-cite" bib-cite))))
 176
 177 (defvar x-symbol-orig-comint-input-sender 'comint-simple-send
 178   "Original function which sends a string to the comint process.")
 179
 180
 181 ;;;===========================================================================
 182 ;;;  Determine Locale
 183 ;;;===========================================================================
 184
 185 (defun x-symbol-coding-system-from-locale ()
 186   ;; See also EMACS/lisp/international/mule-cmds.el, `set-locale-environment'.
 187   "Get value for `x-symbol-default-coding' from locale.
 188 Use \"locale -ck code_set_name charmap\" and search for the value of
 189 \"code_set_name\" or \"charmap\"."
 190   (save-excursion
 191     (set-buffer (get-buffer-create " *x-symbol-coding-system-from-locale*"))
 192     (erase-buffer)
 193     (call-process shell-file-name nil t nil shell-command-switch
 194                   "locale -ck code_set_name charmap")
 195     (goto-char (point-min))
 196
 197     (let* ((case-fold-search t)
 198            ;; The GNU recode manual (www-find "recode charset iso646"), lists a
 199            ;; lot of aliases, there are a bit less on
 200            ;; http://mail.nl.linux.org/linux-utf8/2001-10/msg00072.html, I
 201            ;; added some.  But this function shouldn't exceed 40 lines...
 202            (map '((iso-8859-1
 203                    "iso-8859-1" "iso8859-1" "iso88591" ; HP: iso88591
 204                    ;; vendor-specific, supersets of ascii
 205                    ;; "roman8"          ; HP: roman8 is not latin1
 206                    ;; ascii
 207                    "ascii" "us-ascii" "ansi_x3.4-1968" "646" "iso646"
 208                    "iso_646.irv")
 209                   (iso-8859-2
 210                    "iso-8859-2" "iso8859-2" "iso88592") ; HP: iso88592
 211                   (iso-8859-3
 212                    "iso-8859-3" "iso8859-3" "iso88593") ; HP: iso88593
 213                   (iso-8859-9
 214                    "iso-8859-9" "iso8859-9" "iso88599")
 215                   (iso-8859-15
 216                    "iso-8859-15" "iso8859-15" "iso885915"))) ; HP: iso885915
 217            (charmap (and (re-search-forward "^[ \t]*\\(code_set_name\\|charmap\\)[ \t]*=[ \t]*\"\\([^\n\"]+\\)\"" nil t)
 218                          (find (downcase (match-string 2)) map
 219                                :test 'member))))
 220       (kill-buffer (current-buffer))
 221       (car charmap))))
 222
 223 (defun x-symbol-buffer-coding (&optional system)
 224   ;; nil = unknown, iso-8859-N otherwise
 225   (let (name)
 226     (if (featurep 'xemacs)
 227         (if (featurep 'mule)
 228             (let* ((sy (or system buffer-file-coding-system))
 229                    (cs (if (symbolp sy) (find-coding-system sy) sy)))
 230               (when (coding-system-p cs)
 231                 (setq name (cdr (assq (coding-system-name
 232                                        (coding-system-base cs))
 233                                       '((raw-text . iso-8859-1)
 234                                         (binary . iso-8859-1)
 235                                         (escape-quoted . iso-8859-1)
 236                                         (iso-2022-8 . iso-8859-1)
 237                                         (iso-2022-8bit-ss2 . iso-8859-1)
 238                                         (iso-2022-lock . iso-8859-1)
 239                                         (iso-8859-2 . iso-8859-2)
 240                                         (iso-8859-3 . iso-8859-3)
 241                                         (iso-8859-9 . iso-8859-9)
 242                                         (iso-8859-15 . iso-8859-15)
 243                                         (ctext . iso-8859-1)))))))
 244           (setq name x-symbol-default-coding))
 245       (let ((cs (or system buffer-file-coding-system 'no-conversion)))
 246         (when (coding-system-p cs)
 247           (setq name (cdr (assq (coding-system-base cs)
 248                                 '((raw-text . iso-8859-1) ; console
 249                                   ;; (undecided . iso-8859-1) "-i" is correct
 250                                   ;; here, see
 251                                   ;; `x-symbol-set-coding-system-if-undecided'
 252                                   (iso-latin-1 . iso-8859-1)
 253                                   (iso-latin-1-with-esc . iso-8859-1)
 254                                   (iso-latin-2 . iso-8859-2)
 255                                   (iso-latin-2-with-esc . iso-8859-2)
 256                                   (iso-latin-3 . iso-8859-3)
 257                                   (iso-latin-3-with-esc . iso-8859-3)
 258                                   (iso-latin-9 . iso-8859-9)
 259                                   (iso-latin-9-with-esc . iso-8859-9)
 260                                   (iso-latin-15 . iso-8859-15)
 261                                   (iso-latin-15-with-esc . iso-8859-15)
 262                                   (compound-text . iso-8859-1))))))))
 263     (if (or (null (boundp 'x-symbol-fchar-tables))
 264             (assq name x-symbol-fchar-tables))
 265         name)))
 266
 267 (unless window-system
 268   (warn "X-Symbol: only limited support on a character terminal")
 269   (unless (and (boundp 'x-symbol-latin-force-use)
 270                (eq x-symbol-latin-force-use 'console-user))
 271     (setq x-symbol-latin1-fonts nil)
 272     (setq x-symbol-latin2-fonts nil)
 273     (setq x-symbol-latin3-fonts nil)
 274     (setq x-symbol-latin5-fonts nil)
 275     (setq x-symbol-latin9-fonts nil)
 276     (setq x-symbol-xsymb0-fonts nil)
 277     (setq x-symbol-xsymb1-fonts nil)))
 278
 279 (defvar x-symbol-default-coding
 280   ;; TODO: make much nicer (do not use `x-symbol-buffer-coding' directly)
 281   (cond (noninteractive 'iso-8859-1)
 282         ((featurep 'mule)
 283          (let* ((cs (default-value 'buffer-file-coding-system))
 284                 (val (cond (cs
 285                             (x-symbol-buffer-coding cs))
 286                            ((member (downcase current-language-environment)
 287                                     '("english" "ascii"))
 288                             'iso-8859-1)))
 289                 (loc (x-symbol-coding-system-from-locale)))
 290            (and loc
 291                 (not (eq loc val))
 292                 (warn "X-Symbol: Emacs language environment and system locale specify different encoding, I'll assume `%s'" val))
 293            val))
 294         ((x-symbol-coding-system-from-locale))
 295         (t
 296          (warn "X-Symbol: cannot deduce default encoding, I'll assume `iso-8859-1'")
 297          'iso-8859-1))
 298   "Default coding used for 8bit characters in buffers.
 299 Supported values are `iso-8859-1', `iso-8859-2', `iso-8859-3',
 300 `iso-8859-9', `iso-8859-15', and nil.  Value nil is the same as
 301 `iso-8859-1', while disabling some uses of `x-symbol-coding'.
 302
 303 Without Mule support, the value determines the coding in all buffers
 304 with value nil for `x-symbol-coding'.  With Mule support, Emacs
 305 recognizes the coding itself.
 306
 307 This value is also used to determine the canoncial character if a
 308 character is supported by various latin charsets, see
 309 \\[x-symbol-unalias].")
 310
 311 (unless (or (memq x-symbol-default-coding
 312                   '(nil iso-8859-1 iso-8859-2 iso-8859-3 iso-8859-9))
 313             (and (eq x-symbol-default-coding 'iso-8859-15)
 314                  (or (not (featurep 'xemacs))
 315                      (not (featurep 'mule))
 316                      (fboundp 'emacs-version>=) (emacs-version>= 21 5))))
 317   (warn "X-Symbol: illegal `x-symbol-default-coding', I'll use nil")
 318   (setq x-symbol-default-coding nil))
 319
 320
 321 ;;;===========================================================================
 322 ;;;  General Configuration
 323 ;;;===========================================================================
 324
 325 (defcustom x-symbol-compose-key '(control ?\=)
 326   "Key used to access command `x-symbol-map'.
 327 By default, pressing this key twice invokes the GRID: \\[x-symbol-grid].
 328 This is a list, no vector!"
 329   :group 'x-symbol-input-init
 330   :type '(x-symbol-key :tag "Prefix key"))
 331
 332 (defcustom x-symbol-auto-key-autoload t
 333   "*If non-nil, pressing `x-symbol-compose-key' initialize x-symbol.
 334 The binding of `x-symbol-compose-key' is redefined after initialization.
 335 With value nil, you must provide a prefix argument to initialize package
 336 X-Symbol."
 337   :group 'x-symbol-input-init
 338   :type 'boolean)
 339
 340 (defvar x-symbol-auto-conversion-method 'auto-slow
 341   ;;(if (featurep 'crypt) 'slow 'fast)
 342   "Non-nil means, set up hooks for auto conversion.
 343 Fast methods are used if this variable has value `fast'.  Otherwise,
 344 slower methods are used and \\[vc-register] or \\[vc-next-action] will
 345 fail to decode the buffer contents.
 346
 347 You should set this variable to value `slowest' if, for example, the
 348 symbol for \\alpha looks like \\233a after \\[save-buffer] (this happens
 349 on some systems).  Value `fast' should not be used, if some other
 350 package, e.g., crypt, adds a function to `write-file-hooks' which does
 351 not inspect the remaining functions in this hook.
 352
 353 Default value `auto-slow' is set to `fast' after the initialization of
 354 XEmacs if package crypt has not been loaded by then.")
 355
 356
 357 ;;;===========================================================================
 358 ;;;  Known Token Languages
 359 ;;;===========================================================================
 360
 361 (defvar x-symbol-language-alist nil
 362   "Alist of currently registered token languages.
 363 Elements look like (LANGUAGE . NAME) where LANGUAGE is the symbol
 364 representing and NAME is the name normally presented to the user,
 365 see `x-symbol-language-text'.
 366
 367 You should not set this variable directly, use
 368 `x-symbol-register-language' instead!")
 369
 370 (defcustom x-symbol-charsym-name "x-symbol charsym"
 371   "Standard name of the pseudo token language x-symbol charsym.
 372 See language access `x-symbol-LANG-name'.  The pseudo language
 373 corresponds to `x-symbol-language' having value nil and is only used for
 374 input methods.  See `x-symbol-language-text'."
 375   :group 'x-symbol-miscellaneous
 376   :type 'string)
 377
 378 (defcustom x-symbol-tex-name "TeX macro"
 379   "Standard name of token language `tex'.
 380 See language access `x-symbol-LANG-name'."
 381   :group 'x-symbol-tex
 382   :type 'string)
 383
 384 (defcustom x-symbol-tex-modes
 385   '(tex-mode latex-mode plain-tex-mode noweb-mode)
 386   "Major modes typically using X-Symbol with token language `tex'.
 387 See language access `x-symbol-LANG-modes'."
 388   :group 'x-symbol-tex
 389   :group 'x-symbol-mode
 390   :type '(repeat function))
 391
 392 (defcustom x-symbol-sgml-name "SGML entity"
 393   "Standard name of token language `sgml'.
 394 See language access `x-symbol-LANG-name'."
 395   :group 'x-symbol-sgml
 396   :type 'string)
 397
 398 (defcustom x-symbol-sgml-modes
 399   ;;'(sgml-mode xml-mode html-mode hm--html-mode html-helper-mode)
 400   '(html-mode hm--html-mode html-helper-mode)
 401   "Major modes typically using X-Symbol with language `sgml'.
 402 See language access `x-symbol-LANG-modes'."
 403   :group 'x-symbol-sgml
 404   :group 'x-symbol-mode
 405   :type '(repeat function))
 406
 407 (defcustom x-symbol-bib-name "BibTeX macro"
 408   "Standard name of token language `bib'.
 409 See language access `x-symbol-LANG-name'."
 410   :group 'x-symbol-bib
 411   :type 'string)
 412
 413 (defcustom x-symbol-bib-modes '(bibtex-mode)
 414   "Major modes typically using X-Symbol with language `bib'.
 415 See language access `x-symbol-LANG-modes'."
 416   :group 'x-symbol-bib
 417   :group 'x-symbol-mode
 418   :type '(repeat function))
 419
 420 (defcustom x-symbol-texi-name "TeXinfo command"
 421   "Standard name of token language `texi'.
 422 See language access `x-symbol-LANG-name'."
 423   :group 'x-symbol-texi
 424   :type 'string)
 425
 426 (defcustom x-symbol-texi-modes '(texinfo-mode)
 427   "Major modes typically using X-Symbol with language `texi'.
 428 See language access `x-symbol-LANG-modes'."
 429   :group 'x-symbol-texi
 430   :group 'x-symbol-mode
 431   :type '(repeat function))
 432
 433
 434 ;;;===========================================================================
 435 ;;;  Buffer-locals
 436 ;;;===========================================================================
 437
 438 (defvar x-symbol-mode nil
 439   "Non-nil if X-Symbol minor mode is enabled.")
 440
 441 (make-variable-buffer-local 'x-symbol-mode)
 442 (x-symbol-define-user-options 'x-symbol-mode '(t)
 443   nil (lambda (dummy arg) (x-symbol-mode (if arg 1 0))))
 444
 445 (defvar x-symbol-language nil
 446   "*Token language used in current buffer.
 447 A valid value is required to turn on `x-symbol-mode' which also sets
 448 this variable to a reasonable value if the variable is not yet
 449 buffer-local.  The value influences the conversion, i.e., decoding and
 450 encoding of X-Symbol characters, input methods TOKEN and READ-TOKEN,
 451 fontification of super- and subscripts, image command recognition, the
 452 info in the echo area, etc.")
 453
 454 (make-variable-buffer-local 'x-symbol-language)
 455 (put 'x-symbol-language 'permanent-local t)
 456 (x-symbol-define-user-options 'x-symbol-language
 457     (lambda () (list* nil '(nil . "None") x-symbol-language-alist))
 458   '(x-symbol-update-modeline))
 459
 460 (defvar x-symbol-coding nil
 461   "*Coding of 8bit characters in a file.
 462 Determines which characters are considered to be 8bit characters for
 463 file operations.  Supported values are `iso-8859-1', `iso-8859-2',
 464 `iso-8859-3', `iso-8859-9', and `iso-8859-15'.  Value nil means a value
 465 according to `buffer-file-coding-system' with Mule support, or the value
 466 of `x-symbol-default-coding' without Mule support.
 467
 468 With Mule support, any value other than `nil' is considered invalid if
 469 encoding according to `buffer-file-coding-system' is neither the same as
 470 this value nor the same as `x-symbol-default-coding'.
 471
 472 Function `x-symbol-mode' sets this variable to a reasonable value if the
 473 variable is not yet buffer-local.
 474
 475 During decoding, e.g., when visiting a file, the value is always
 476 important for the interpretation of 8bit characters, an invalid value is
 477 considered to be equivalent to value nil.  During encoding, e.g., when
 478 saving a buffer, 8bit characters are not encoded to tokens if the value
 479 is valid and `x-symbol-8bits' is non-nil.")
 480
 481 (make-variable-buffer-local 'x-symbol-coding)
 482 (put 'x-symbol-coding 'permanent-local t)
 483 (x-symbol-define-user-options 'x-symbol-coding
 484     (lambda () (cons x-symbol-default-coding x-symbol-coding-name-alist))
 485   '(x-symbol-update-modeline))
 486
 487 (defvar x-symbol-8bits nil
 488   "*If non-nil, do not encode 8bit characters.
 489 Variable `x-symbol-coding' determines which characters are assumed to be
 490 8bit characters.  Note that tokens representing 8bit characters are
 491 always decoded, except if `x-symbol-unique' is non-nil.
 492
 493 Function `x-symbol-mode' sets this variable to a reasonable value if the
 494 variable is not yet buffer-local.")
 495 ;; TODO: link to `x-symbol-unique'
 496
 497 (make-variable-buffer-local 'x-symbol-8bits)
 498 (put 'x-symbol-8bits 'permanent-local t)
 499 (x-symbol-define-user-options 'x-symbol-8bits '(t)
 500   '(x-symbol-update-modeline))
 501
 502 (defvar x-symbol-unique nil
 503   "*If non-nil, only decode canonical tokens.
 504 Canonical tokens are those which are produced when X-Symbol encodes the
 505 corresponding character.  If `x-symbol-8bits' is non-nil, do not decode
 506 tokens which would be decoded to 8bit characters according to
 507 `x-symbol-coding'.
 508
 509 Function `x-symbol-mode' sets this variable to a reasonable value if the
 510 variable is not yet buffer-local.")
 511
 512 (make-variable-buffer-local 'x-symbol-unique)
 513 (put 'x-symbol-unique 'permanent-local t)
 514 (x-symbol-define-user-options 'x-symbol-unique '(t)
 515   '(x-symbol-update-modeline))
 516
 517 (defvar x-symbol-subscripts nil
 518   "*If non-nil, use special fonts to display super- and subscripts.
 519 This feature must be supported by the token language via language access
 520 `x-symbol-LANG-subscript-matcher'.  Some parts of the text might be
 521 invisible, see also variable `x-symbol-reveal-invisible'.
 522
 523 Function `x-symbol-mode' sets this variable to a reasonable value if the
 524 variable is not yet buffer-local.")
 525
 526 (make-variable-buffer-local 'x-symbol-subscripts)
 527 (x-symbol-define-user-options 'x-symbol-subscripts '(t)
 528   '(x-symbol-update-modeline x-symbol-fontify))
 529
 530 (defvar x-symbol-image nil
 531   "*If non-nil, show little glyphs after image insertion commands.
 532 This feature must be supported by the token language via language access
 533 `x-symbol-LANG-image-keywords'.
 534
 535 Function `x-symbol-mode' sets this variable to a reasonable value if the
 536 variable is not yet buffer-local.")
 537
 538 (make-variable-buffer-local 'x-symbol-image)
 539 (x-symbol-define-user-options 'x-symbol-image '(t)
 540   '(x-symbol-update-modeline) 'x-symbol-set-image)
 541
 542
 543 ;;;===========================================================================
 544 ;;;  Minor mode control
 545 ;;;===========================================================================
 546
 547 (defcustom x-symbol-auto-mode-suffixes (x-symbol-auto-mode-suffixes)
 548   "*Regexps matching file suffixes not to be considered.
 549 All suffixes from a file name matching these regexps are deleted before
 550 the file name is used for `x-symbol-auto-mode-alist'.  The default value
 551 includes the REGEXP in all three-valued elements of `auto-mode-alist',
 552 at definition time, of course."
 553   :group 'x-symbol-mode
 554   :type '(repeat regexp))
 555
 556 (defcustom x-symbol-auto-8bit-search-limit nil
 557   "*Limits search for 8bit characters in the file.
 558 Used when finding an appropriate value for `x-symbol-8bits'.  See also
 559 `x-symbol-mode'."
 560   :group 'x-symbol-mode
 561   :type '(choice (const :tag "No limit" nil) (integer :tag "Limit")))
 562
 563 (defcustom x-symbol-auto-style-alist nil
 564   ;; TODO: docstring outdated
 565   "*Alist to setup X-Symbol values for buffers visiting files.
 566 Elements look like
 567   (MATCH LANGUAGE MODE-ON CODING 8BITS UNIQUE SUBSCRIPTS IMAGE)
 568 or
 569   (MATCH LANGUAGE . VARIABLE)
 570
 571 If MATCH matches a buffer in which command `x-symbol-mode' is invoked,
 572 the rest of the element is used to setup some buffer-local x-symbol
 573 specific variables.  If no element matches, set `x-symbol-language' to
 574 the symbol property `x-symbol-language' of the major mode symbol if the
 575 variable is not already buffer-local.
 576
 577 If `x-symbol-mode' is not already buffer-local, MODE-ON determines
 578 whether to turn the mode on with `turn-on-x-symbol-conditionally'.
 579 LANGUAGE, CODING, 8BITS, UNIQUE, SUBSCRIPTS and IMAGE are used to set
 580 `x-symbol-language', `x-symbol-coding', `x-symbol-8bits',
 581 `x-symbol-unique', `x-symbol-subscripts' and `x-symbol-image' if these
 582 values are not already buffer-local.
 583
 584 MATCH is either a list of major modes which must include the mode of the
 585 current buffer or a regexp matching the file name ignoring some
 586 suffixes, see `x-symbol-auto-mode-suffixes', or a value used directly.
 587
 588 MODE-ON, LANGUAGE, CODING, 8BITS, UNIQUE, SUBSCRIPTS and IMAGE are
 589 `eval'ed in that order.  During the evaluation, `x-symbol-mode' is
 590 non-nil according to MODE-ON.
 591
 592 VARIABLE is a symbol whose value contains the above mentioned values,
 593 see the language access `x-symbol-LANG-auto-style'."
 594   :group 'x-symbol-mode
 595   :type '(repeat (cons :format "%v"
 596                        (choice (repeat :tag "In major modes"
 597                                        :menu-tag "In major modes"
 598                                        (function :value text-mode))
 599                                (regexp :tag "When matched by")
 600                                (function :tag "Predicate"))
 601                        (cons :format "%v"
 602                              (symbol :tag "Token language")
 603                              ;;(x-symbol-auto-style :inline t))))
 604                              (choice (x-symbol-auto-style
 605                                       :menu-tag "Values"
 606                                       :format "\n%v")
 607                                      (variable :tag "Like variable"))))))
 608
 609 (defvar x-symbol-mode-disable-alist nil)
 610 ;; just a `defvar' people should know what they are doing...
 611
 612
 613 ;;;===========================================================================
 614 ;;;  Images
 615 ;;;===========================================================================
 616
 617 (defun x-symbol-image-set-colormap (var value)
 618   "Set VAR's value to VALUE.
 619 Custom set function of `x-symbol-image-colormap-allocation' and
 620 `x-symbol-image-convert-colormap'."
 621   (if var (set var value))
 622   (if (boundp 'x-symbol-image-convert-colormap)
 623       (put 'x-symbol-image-convert-colormap 'x-symbol-image-instance
 624            (and (boundp 'x-symbol-image-colormap-allocation)
 625                 x-symbol-image-colormap-allocation
 626                 x-symbol-image-convert-colormap
 627                 (if (featurep 'xemacs)
 628                     (make-image-instance
 629                      (vector x-symbol-image-colormap-allocation
 630                              :file x-symbol-image-convert-colormap)
 631                      nil nil t)
 632                   (create-image x-symbol-image-convert-colormap
 633                                 x-symbol-image-colormap-allocation))))))
 634
 635 (defcustom x-symbol-image-colormap-allocation 'xpm
 636   "If non-nil, prevent colors in colormap to be de-allocated.
 637 The non-nil value should be an image format.  See
 638 `x-symbol-image-convert-colormap'."
 639   :group 'x-symbol-image-general
 640   :initialize 'custom-initialize-default
 641   :set 'x-symbol-image-set-colormap
 642   :type '(choice (const :tag "Colors can be de-allocated" nil)
 643                  (const :tag "Colormap is xpm file" xpm)
 644                  (symbol :tag "Other image format")))
 645
 646 (defcustom x-symbol-image-convert-colormap
 647   (and x-symbol-data-directory
 648        (expand-file-name "colormap138.xpm" x-symbol-data-directory))
 649   "File name of colormap files.
 650 Used by `x-symbol-image-start-convert-colormap' for image cache file
 651 names not matched by `x-symbol-image-convert-mono-regexp'.  See also
 652 `x-symbol-image-colormap-allocation'."
 653   :group 'x-symbol-image-general
 654   :initialize 'custom-initialize-default
 655   :set 'x-symbol-image-set-colormap
 656   :type '(choice (const :tag "No map" nil) file))
 657
 658
 659 \f
 660 ;;;;##########################################################################
 661 ;;;;  Code
 662 ;;;;##########################################################################
 663
 664
 665 (defalias 'x-symbol-cset-registry 'caaar)
 666 (defalias 'x-symbol-cset-coding 'cdaar)
 667 (defalias 'x-symbol-cset-leading 'cadar)
 668 (defalias 'x-symbol-cset-score 'caddar)
 669 (defalias 'x-symbol-cset-left 'cadr)
 670 (defalias 'x-symbol-cset-right 'cddr)
 671
 672 (defvar x-symbol-input-initialized nil
 673   "Internal.  If non-nil, the input methods are initialized.")
 674
 675
 676 ;;;===========================================================================
 677 ;;;  Key autoload
 678 ;;;===========================================================================
 679
 680 ;;;###autoload
 681 (defun x-symbol-key-autoload (&optional arg)
 682   "Initialize package x-symbol and use the keys for this command again.
 683 Package x-symbol and the functions in `x-symbol-load-hook' should
 684 re-bind all key-sequence which invoke this command.  You should provide
 685 a prefix argument ARG to this command if `x-symbol-auto-key-autoload' is
 686 nil."
 687   (interactive "P")
 688   (when x-symbol-input-initialized
 689     (error "%s should be rebound in `x-symbol-init-input-hook'"
 690            (key-description (this-command-keys))))
 691   (unless (or arg x-symbol-auto-key-autoload)
 692     (error "Use %s with prefix argument to initialize the input methods"
 693            (key-description (this-command-keys))))
 694   (let ((this (append (this-command-keys) nil)))
 695     ;; for some reason this loop is necessary...
 696     (while (and this (null (eq (key-binding (vector (car this))) this-command)))
 697       (setq this (cdr this)))
 698     (setq prefix-arg arg)
 699     (setq unread-command-events this))
 700   (x-symbol-init-input))
 701
 702 ;;;###autoload
 703 (defalias 'x-symbol-map-autoload 'x-symbol-key-autoload)
 704
 705
 706 ;;;===========================================================================
 707 ;;;  Minor mode, fontification
 708 ;;;===========================================================================
 709
 710 (defun x-symbol-buffer-file-name ()
 711   (when buffer-file-name
 712     (let ((name (file-name-sans-versions buffer-file-name))
 713           (case-fold-search (eq system-type 'vax-vms))
 714           (suffixes x-symbol-auto-mode-suffixes))
 715       (while suffixes
 716         (and (string-match (pop suffixes) name)
 717              (< (match-beginning 0) (length name))
 718                                         ; protect against stupid regexp
 719              (setq name (substring name 0 (match-beginning 0))
 720                    suffixes x-symbol-auto-mode-suffixes)))
 721       name)))
 722
 723 (defun x-symbol-auto-set-variable (symbol form)
 724   "Set SYMBOL's value to evaluated FORM if SYMBOL is not buffer-local."
 725   (or (local-variable-p symbol (current-buffer))
 726       (set symbol (eval form))))
 727
 728 ;;;###autoload
 729 (defun x-symbol-mode (&optional arg special)
 730   "Toggle X-Symbol mode.
 731 Toggle X-Symbol mode.  If provided with a prefix argument, turn X-Symbol
 732 mode on if the numeric value of the argument is positive, else turn it
 733 off.  If no token language can be deduced, ask for a token language; if
 734 provided with a non-numeric prefix argument, always ask.
 735
 736 By default, X-Symbol mode is disabled in special major-modes visiting a
 737 file, e.g., `vm-mode'.  Use a prefix argument to be asked whether to
 738 turn in on anyway.
 739
 740 When not already defined, various buffer-local variables are set when
 741 turning on X-Symbol.  See `x-symbol-auto-style-alist' and the language
 742 access `x-symbol-LANG-modes'.
 743
 744 Turning X-Symbol mode on requires a valid `x-symbol-language' and also
 745 decodes tokens if the mode was turned off before, see
 746 \\[x-symbol-decode-recode].  Turning X-Symbol mode off also encodes
 747 x-symbol characters if the mode was turned on before, see
 748 \\[x-symbol-encode-recode].  If optional argument SPECIAL has value
 749 `init', the old mode status is assumed to be off."
 750   (interactive (list current-prefix-arg 'interactive))
 751   (if (eq special 'init) (setq x-symbol-mode nil))
 752   (let* ((old-mode (if (eq special 'init) nil x-symbol-mode))
 753          (new-mode (if arg (> (prefix-numeric-value arg) 0) (not old-mode)))
 754          (disabled0 (assq major-mode x-symbol-mode-disable-alist))
 755          (disabled1 (if disabled0
 756                         (cdr disabled0)
 757                       (get major-mode 'x-symbol-mode-disable)))
 758          (disabled (cond (old-mode nil)
 759                          ((null new-mode) nil)
 760                          ((null disabled1)
 761                           (and buffer-file-name (get major-mode 'mode-class) t))
 762                          ((eq disabled1 'error))
 763                          ((stringp disabled1) disabled1)
 764                          ((functionp disabled1) (funcall disabled1)))))
 765     (setq x-symbol-mode nil)
 766     (when disabled
 767       (if (and (eq special 'interactive)
 768                arg
 769                (yes-or-no-p
 770                 (format "Cannot use X-Symbol with %s Mode.  Turn on anyway? "
 771                         mode-name)))
 772           (setq disabled nil)
 773         (or (stringp disabled)
 774             (setq disabled (format "%s Mode does not allow to turn on X-Symbol"
 775                                    mode-name)))
 776         (setq new-mode nil)))
 777     (when new-mode
 778       (let* ((buffer-file-name (x-symbol-buffer-file-name))
 779              (buffer-name (or buffer-file-name (buffer-name)))
 780              (alist x-symbol-auto-style-alist)
 781              (style (get major-mode 'x-symbol-style))
 782              ;; WARNING: `values' is a global variable which is set during GC
 783              ;; (and we have dynamic scoping)!  major-modes can set a specific
 784              ;; language
 785              matcher)
 786         (while alist
 787           (setq matcher (caar alist))
 788           (if (cond ((stringp matcher) (string-match matcher buffer-name))
 789                     ((consp matcher) (memq major-mode matcher))
 790                     ((functionp matcher) (funcall matcher)))
 791               (setq style (cdar alist)
 792                     alist nil)
 793             (setq alist (cdr alist))))
 794         (unless style
 795           (let ((langs x-symbol-language-alist))
 796             (while langs
 797               (if (memq major-mode
 798                         (symbol-value (get (caar langs) 'x-symbol-LANG-modes)))
 799                   (setq style (cons (caar langs) t)
 800                         langs nil)
 801                 (setq langs (cdr langs))))))
 802         (if (car style)
 803             (or (local-variable-p 'x-symbol-language (current-buffer))
 804                 (setq x-symbol-language (car style))))
 805         ;; check language ----------------------------------------------------
 806         (if (and x-symbol-language
 807                  (symbolp x-symbol-language)
 808                  (get x-symbol-language 'x-symbol-LANG-feature))
 809             (when (and (eq special 'interactive) (consp arg))
 810               (setq x-symbol-language
 811                     (x-symbol-read-language
 812                      (format "Token Language for X-Symbol mode (default %s): "
 813                              (x-symbol-language-text))
 814                      x-symbol-language 'cdr)))
 815           (if (eq special 'interactive)
 816               (or (setq x-symbol-language
 817                         (x-symbol-read-language
 818                          "Token Language for X-Symbol mode: " nil 'cdr))
 819                   (setq disabled
 820                         "A valid token language is required to turn on X-Symbol"))
 821             ;; no simple `setq': prevent making `x-symbol-language' buffer-local
 822             (if x-symbol-language (setq x-symbol-language nil)))
 823           (setq style nil))
 824         (when x-symbol-language
 825           (require (get x-symbol-language 'x-symbol-LANG-feature))
 826           (setq style
 827                 (cond ((or (null style) (eq (cdr style) t)
 828                            (not (eq (car style) x-symbol-language)))
 829                        (symbol-value (get x-symbol-language
 830                                           'x-symbol-LANG-auto-style)))
 831                       ((and (symbolp (cdr style)) (boundp (cdr style)))
 832                        (symbol-value (cdr style)))
 833                       (t
 834                        (cdr style))))
 835           (setq x-symbol-mode (eval (car style)))
 836           (x-symbol-auto-set-variable 'x-symbol-coding (cadr style))
 837           (or (local-variable-p 'x-symbol-8bits (current-buffer))
 838               (setq x-symbol-8bits (or (eval (caddr style))
 839                                        (x-symbol-auto-8bit-search
 840                                         x-symbol-auto-8bit-search-limit))
 841                     ;; use value `null' to disable 8bit char search
 842                     x-symbol-8bits (and (not (eq x-symbol-8bits 'null))
 843                                         x-symbol-8bits)))
 844           (x-symbol-auto-set-variable 'x-symbol-unique (cadddr style))
 845           (x-symbol-auto-set-variable 'x-symbol-subscripts (nth 4 style))
 846           (x-symbol-auto-set-variable 'x-symbol-image (nth 5 style))
 847           (or (and (eq special 'init) (null arg))
 848               (setq x-symbol-mode new-mode)))))
 849     (if (eq special 'init)
 850         (if x-symbol-mode (x-symbol-mode-internal t))
 851       (x-symbol-mode-internal (and x-symbol-language
 852                                    (eq (null old-mode) (and x-symbol-mode t))))
 853       (and disabled
 854            (eq special 'interactive)
 855            (error (if (stringp disabled)
 856                       disabled
 857                     "Cannot turn on X-Symbol mode"))))))
 858
 859 ;;;###autoload
 860 (defun turn-on-x-symbol-conditionally ()
 861   "Turn on x-symbol mode conditionally, see `x-symbol-mode'.
 862 Call `x-symbol-mode' with SPECIAL having value `init'."
 863   (x-symbol-mode (and (local-variable-p 'x-symbol-mode (current-buffer))
 864                       (if x-symbol-mode 1 0))
 865                  'init))
 866
 867 ;;;###autoload
 868 (defun x-symbol-fontify (&optional beg end)
 869   "Re-fontify region between BEG and END."
 870   (interactive (and (region-active-p) (list (region-beginning) (region-end))))
 871   (cond ((not font-lock-mode) (turn-on-font-lock))
 872         ((and (featurep 'xemacs) (boundp 'lazy-shot-mode) lazy-shot-mode)
 873          ;; copied from lazy-shot:
 874          (setq font-lock-fontified
 875                (and lazy-shot-minimum-size
 876                     (>= (buffer-size) lazy-shot-minimum-size)))
 877          (lazy-shot-install-extents (point-min) (point-max)
 878                                     font-lock-fontified))
 879         ((and (featurep 'xemacs) (boundp 'lazy-lock-mode) lazy-lock-mode)
 880          ;; copied from lazy-lock:
 881          (let ((modified (buffer-modified-p)) (inhibit-read-only t)
 882                (buffer-undo-list t)
 883                ;;deactivate-mark
 884                buffer-file-name buffer-file-truename)
 885            (remove-text-properties (or beg 1) (or end (1+ (buffer-size)))
 886                                    '(fontified nil))
 887            (or modified (set-buffer-modified-p nil))))
 888         (t
 889          (font-lock-fontify-buffer))))
 890
 891
 892 ;;;===========================================================================
 893 ;;;  comint support
 894 ;;;===========================================================================
 895
 896 (defun x-symbol-comint-output-filter (dummy)
 897   ;; checkdoc-params: (dummy)
 898   "Decode output of comint's process.
 899 Used as value in `comint-output-filter-functions'."
 900   (and x-symbol-mode x-symbol-language
 901        (x-symbol-decode-region
 902         (if (interactive-p) comint-last-input-end comint-last-output-start)
 903         (process-mark (get-buffer-process (current-buffer))))))
 904
 905 (defun x-symbol-comint-send (proc string)
 906   "Encode STRING and send it to process PROC.
 907 Used as value of `comint-input-sender', uses
 908 `x-symbol-orig-comint-input-sender'."
 909   (and x-symbol-mode x-symbol-language
 910        (setq string (x-symbol-encode-string string (current-buffer))))
 911   (funcall x-symbol-orig-comint-input-sender proc string))
 912
 913
 914 ;;;===========================================================================
 915 ;;;  Hooks for automatic conversion
 916 ;;;===========================================================================
 917
 918 ;; TODO: for format fns: check whether read-only stuff is still necessary...
 919 ;; TODO: check the narrow-to-region stuff
 920
 921 (defun x-symbol-format-decode (start end)
 922   (if (and x-symbol-mode x-symbol-language)
 923       (save-restriction
 924         (narrow-to-region start end)
 925         (let ((modified (buffer-modified-p)) ; t if `recover-file'!
 926               ;;(buffer-undo-list t) ; do not record changes
 927               ;; we cannot set buffer-undo-list to t even if the previous
 928               ;; value is nil because M-x insert-file as the first command
 929               ;; after reading a file would set the old insert-region
 930               ;; boundaries into the undo-list
 931               (buffer-read-only nil) ; always allow conversion
 932               (inhibit-read-only t)
 933               (first-change-hook nil) ; no `flyspell-mode' here
 934               (after-change-functions nil)) ; no fontification
 935 ;;;       (and orig-buffer
 936 ;;;            (not (eq (current-buffer) orig-buffer))
 937 ;;;            (x-symbol-inherit-from-buffer orig-buffer))
 938           (x-symbol-decode-all)
 939           (or modified (set-buffer-modified-p nil))
 940           (point-max)))
 941     end))
 942
 943 (defun x-symbol-format-encode (start end orig-buffer)
 944   (let ((new-buffer (current-buffer)))
 945     (if (eq new-buffer orig-buffer)
 946         (and x-symbol-mode x-symbol-language
 947              (save-restriction
 948                (narrow-to-region start end)
 949                (x-symbol-encode-all)))
 950       (set-buffer orig-buffer)
 951       (and x-symbol-mode x-symbol-language
 952            (if (featurep 'mule)
 953                (let ((cs buffer-file-coding-system))
 954                  (x-symbol-encode-all new-buffer)
 955                  (setq buffer-file-coding-system cs))
 956              (x-symbol-encode-all new-buffer))))))
 957
 958 (defun x-symbol-after-insert-file (len)
 959   ;; checkdoc-params: (len)
 960   "Decode tokens, e.g., after \\[vc-register] or \\[vc-next-action].
 961 Added to `after-insert-file-functions' if
 962 `x-symbol-auto-conversion-method' has value `fast'."
 963   ;; TODO (outdated?, dropped coding): in old XEmacsen, there is no way to know
 964   ;; the start position of the region.  If `insert-file-contents' is called
 965   ;; with argument REPLACE being non-nil, it is not always point.  Thus, we use
 966   ;; `point-min', except when called from `M-x insert-file'.
 967
 968   ;; The docstring of `after-insert-file-functions' talks about bytes, but that
 969   ;; seems to be nonsense and doesn't match the coding in lisp/format.el,
 970   ;; must be checked with src/fileio.c.
 971   (and x-symbol-mode x-symbol-language
 972        (if (<= (+ (point) len) (point-max))
 973            (save-restriction
 974              (narrow-to-region (point) (+ (point) len))
 975              (let ((origpos (point))
 976                    (modified (buffer-modified-p)) ; t if `recover-file'!
 977                    ;;(buffer-undo-list t) ; do not record changes
 978                    ;; we cannot set buffer-undo-list to t even if the previous
 979                    ;; value is nil because M-x insert-file as the first command
 980                    ;; after reading a file would set the old insert-region
 981                    ;; boundaries into the undo-list
 982                    (buffer-read-only nil) ; always allow conversion
 983                    (inhibit-read-only t)
 984                    (first-change-hook nil) ; no `flyspell-mode' here
 985                    (after-change-functions nil)) ; no fontification
 986                (x-symbol-decode-all)
 987                (goto-char origpos)
 988                (or modified (set-buffer-modified-p nil))
 989                (setq len (- (point-max) (point-min)))))
 990          (lwarn 'x-symbol 'warning
 991            ;; might leed to quite a few warnings with old XEmacs, get those
 992            "Wrong point position %d (len: %d, max: %d) provided by Emacs for functions in `after-insert-file-functions'" (point) len (point-max))))
 993   len)
 994
 995 (defun x-symbol-write-region-annotate-function (start end)
 996   ;; checkdoc-params: (start end)
 997   "Encode x-symbol characters using another buffer.
 998 Added to `write-region-annotate-functions' if
 999 `x-symbol-auto-conversion-method' has value `fast'."
1000   (and x-symbol-mode x-symbol-language
1001        (not (equal start ""))           ; kludgy feature of `write-region'
1002        ;; Without the test, "x-symbol.el" is loaded twice, the initialization
1003        ;; done twice (resulting in warnings about charsym redefinitions).
1004        ;; Reason: in Emacs, `make-temp-name', used for the value of some var in
1005        ;; "x-symbol-vars.el", required by "x-symbol.el", calls `write-region'.
1006        (let ((selective selective-display))
1007          ;; at least in XEmacs, this function might be called with both args
1008          ;; nil
1009          (x-symbol-encode-all (get-buffer-create " x-symbol conversion")
1010                               (or start (point-min)) (or end (point-max)))
1011          ;; set `selective-display' according to orig buffer
1012          (setq selective-display selective)))
1013   nil)
1014
1015 (defun x-symbol-write-file-hook ()
1016   "Encode x-symbol characters in current buffer.
1017 Added to `write-file-hooks' if `x-symbol-auto-conversion-method' has a
1018 value other than nil or `fast'.  Refontifies buffer if
1019 `x-symbol-auto-conversion-method' has value `slowest'."
1020   (and x-symbol-mode x-symbol-language
1021       (let ((buffer-read-only nil)
1022             ;; `buffer-read-only' is only dec/ if `inhibit-read-only' doesn't
1023             ;; exist.  TODO: check whether still nec/ in XEmacs-21.1
1024             (inhibit-read-only t)
1025             (inhibit-modification-hooks t) ; Emacs only: then
1026                                            ; `after-change-functions' not nec/
1027             (first-change-hook nil)     ; no `flyspell-mode' here
1028             (after-change-functions nil)) ; no fontification!
1029         (widen) ;; Called inside `save-recursion' and `save-restriction'.
1030         ;; TODO: define a common macro in x-symbol-macs.el instead, which can
1031         ;; also be used in `x-symbol-tex-translate-locations', it has an
1032         ;; addition argument for the var `changed' there, with that arg: no
1033         ;; `unwind-protect'
1034         (if (featurep 'xemacs)
1035             (call-with-transparent-undo
1036              (lambda ()
1037                (x-symbol-encode-all)
1038                (continue-save-buffer)))
1039           ;; not called inside `save-excursion' in Emacs >= 20.3
1040           (save-excursion
1041             (let ((buffer-undo-list nil)
1042                   ;; Kludge to prevent undo list truncation:
1043                   (undo-limit most-positive-fixnum) ; Emacs
1044                   (undo-strong-limit most-positive-fixnum) ; Emacs
1045                   (undo-high-threshold -1)      ; XEmacs
1046                   (undo-threshold -1))          ; XEmacs
1047               (unwind-protect
1048                   (let ((file-hooks (cdr (memq 'x-symbol-write-file-hook
1049                                                (default-value
1050                                                  'write-file-hooks))))
1051                         setmodes)
1052                     (x-symbol-encode-all)
1053                     (or (run-hook-with-args-until-success 'file-hooks)
1054                         (setq setmodes (basic-save-buffer-1)))
1055                     ;; See `basic-save-buffer'.  TODO: do I also have to set the
1056                     ;; coding system and `buffer-file-number'?
1057                     (if setmodes
1058                         (condition-case ()
1059                             (set-file-modes buffer-file-name setmodes)
1060                           (error nil))))
1061                 (let ((tail buffer-undo-list))
1062                   (setq buffer-undo-list t)
1063                   (while tail
1064                     (setq tail (primitive-undo (length tail) tail))))))))
1065         (and (eq x-symbol-auto-conversion-method 'slowest)
1066              font-lock-mode
1067              (x-symbol-fontify))
1068         (set-buffer-modified-p nil)
1069         'x-symbol-write-file-hook)))    ; do not write again
1070
1071
1072 ;;;===========================================================================
1073 ;;;  Init
1074 ;;;===========================================================================
1075
1076 (defvar x-symbol-modeline-string ""
1077   "String that should appear in the modeline when `x-symbol-mode' is on.
1078 Its value is set by `x-symbol-update-modeline'.")
1079 (make-variable-buffer-local 'x-symbol-modeline-string)
1080
1081 (defvar x-symbol-mode-map
1082   (let ((m (make-sparse-keymap)))
1083     ;; (substitute-key-definition 'x-symbol-map-autoload 'x-symbol-map
1084     ;;                         m global-map)
1085     m))
1086
1087 (add-minor-mode 'x-symbol-mode 'x-symbol-modeline-string x-symbol-mode-map)
1088 (put 'x-symbol-mode :menu-tag "X-Symbol")
1089
1090 (defconst x-symbol-early-language-access-alist
1091   '((x-symbol-LANG-name "name" nil stringp)
1092     (x-symbol-LANG-modes "modes" t listp)       ; TODO: non-optional
1093     (x-symbol-LANG-auto-style "auto-style" require)))
1094
1095 (defun x-symbol-init-language-accesses (language alist)
1096   "Initialize accesses for token language LANGUAGE according to ALIST.
1097 The symbol property `x-symbol-feature' of LANGUAGE must be set before.
1098 See also `x-symbol-language-access-alist'."
1099   ;;If optional NO-TEST is nil, accesses which do not point to a bound
1100   ;;variable are not set.
1101   (let ((feature (get language 'x-symbol-LANG-feature))
1102         (ok t)
1103         symbol)
1104     (dolist (item alist)
1105       (setq symbol (intern (format "%s-%s" feature (cadr item))))
1106       (if (not (or (boundp symbol) (eq (caddr item) 'require)))
1107           (or (eq (caddr item) t)       ; optional access
1108               (and (caddr item) (not (get language (caddr item))))
1109               (progn
1110                 (lwarn feature 'error
1111                   "Token language `%s' does not define `%s'" language symbol)
1112                 (setq ok nil))
1113               (put language (car item) symbol))
1114         (or (null (cadddr item))
1115             (caddr item)                ; optional access: value nil always ok
1116             (funcall (cadddr item) (symbol-value symbol))
1117             (progn
1118               (lwarn feature 'error
1119                 "Token language `%s' uses illegal type for value of `%s'"
1120                 language symbol)
1121               (setq ok nil)))
1122         (put language (car item) symbol)))
1123     ok))
1124
1125 ;;;###autoload
1126 (defun x-symbol-register-language (language feature &optional modes)
1127   "Register token language LANGUAGE.
1128 FEATURE is a feature which `provide's LANGUAGE.  MODES are major modes
1129 which typically use LANGUAGE.  Using LANGUAGE's accesses will initialize
1130 LANGUAGE, see `x-symbol-language-value'."
1131   (unless (get language 'x-symbol-LANG-feature)
1132     (put language 'x-symbol-LANG-feature feature))
1133   (unless
1134       (x-symbol-init-language-accesses language
1135                                        x-symbol-early-language-access-alist)
1136     (error "Registration of X-Symbol language `%s' has failed" language))
1137   (dolist (mode modes) (put mode 'x-symbol-style (cons language t)))
1138   (unless (assq language x-symbol-language-alist)
1139     (setq x-symbol-language-alist
1140           (nconc x-symbol-language-alist
1141                  (list (cons language
1142                              (symbol-value
1143                               (get language 'x-symbol-LANG-name))))))))
1144
1145 ;;;###autoload
1146 (defun x-symbol-initialize (&optional arg)
1147   "Initialize package X-Symbol.
1148 See variable `x-symbol-initialize' and function `x-symbol-after-init'.
1149 Also allocate colormap, see `x-symbol-image-colormap-allocation'.
1150 Unless optional argument ARG is non-nil, do not initialize package
1151 X-Symbol twice."
1152   (interactive "P")
1153   (unless (and (get 'x-symbol 'x-symbol-initialized) (null arg))
1154     (put 'x-symbol 'x-symbol-initialized t)
1155     ;; X-Symbol doesn't make sense without the following.  `ctl-arrow' is a
1156     ;; boolean in Emacs, but not in XEmacs: despite its docstring, value t
1157     ;; means the same as 256 (and 255 sometimes, which is probably wrong).
1158     (or (default-value 'ctl-arrow) (setq-default ctl-arrow 'iso-8859/1))
1159     ;; Token languages -------------------------------------------------------
1160     (when (or (eq x-symbol-initialize t)
1161               (memq 'languages x-symbol-initialize))
1162       (x-symbol-register-language 'tex 'x-symbol-tex)
1163       (x-symbol-register-language 'sgml 'x-symbol-sgml)
1164       (x-symbol-register-language 'bib 'x-symbol-bib)
1165       (x-symbol-register-language 'texi 'x-symbol-texi))
1166     ;; Global mode -----------------------------------------------------------
1167     (when (or (eq x-symbol-initialize t)
1168               (memq 'global x-symbol-initialize))
1169       (add-hook 'hack-local-variables-hook 'turn-on-x-symbol-conditionally))
1170     ;; Key bindings ----------------------------------------------------------
1171     (when (or (eq x-symbol-initialize t)
1172               (memq 'keys x-symbol-initialize))
1173       (global-set-key (vector x-symbol-compose-key) 'x-symbol-map-autoload)
1174       (unless (featurep 'xemacs)
1175         (define-key isearch-mode-map (vector x-symbol-compose-key) nil)
1176         ;;(define-key isearch-mode-map [mouse-2] 'isearch-mouse-2)
1177         (define-key isearch-mode-map [menu-bar X-Symbol] nil))
1178       (global-set-key [(control ?\,)] 'x-symbol-modify-key)
1179       (global-set-key [(control ?\.)] 'x-symbol-rotate-key))
1180     ;; Font path -------------------------------------------------------------
1181     (and (or (eq x-symbol-initialize t)
1182              (memq 'font-path x-symbol-initialize))
1183          x-symbol-font-directory
1184          (file-accessible-directory-p x-symbol-font-directory)
1185          ;; by Jim Radford <radford@robby.caltech.edu>:
1186          (memq (console-type) '(x gtk))
1187          (if (fboundp 'x-set-font-path) ; XEmacs >= 21.4
1188              (let ((font-path (x-get-font-path)))
1189                (condition-case nil
1190                    (unless (or (member (file-name-as-directory
1191                                         x-symbol-font-directory) font-path)
1192                                (member (directory-file-name
1193                                         x-symbol-font-directory) font-path))
1194                      (x-set-font-path (nconc font-path
1195                                              (list x-symbol-font-directory)))
1196                      nil)
1197                  (t
1198                   (lwarn 'x-symbol 'error
1199                     "Couldn't add %s to X font path" x-symbol-font-directory)
1200                   t)))          ; (error t) doesn't work (XEmacs bug?)
1201            ;; This should be commented out until I can figure out how to
1202            ;; get the display name into the -display arg for xset.
1203            (with-temp-buffer
1204              (call-process "xset" nil t nil "q")
1205              (goto-char (point-min))
1206              (unless (search-forward (directory-file-name
1207                                       x-symbol-font-directory) nil t)
1208                (not (eq 0 (call-process "xset" nil nil nil "fp+"
1209                                         x-symbol-font-directory))))))
1210          ;; one cause: other dir with X-Symbol fonts already exists (old
1211          ;; installation)
1212          (lwarn 'x-symbol 'error
1213            "Couldn't add %s to X font path" x-symbol-font-directory))
1214     ;; Package fast-lock -----------------------------------------------------
1215     (when (or (eq x-symbol-initialize t)
1216               (memq 'fast-lock x-symbol-initialize))
1217       (setq fast-lock-save-faces nil))
1218     ;; Package AucTeX ----------------------------------------------------------
1219     (when (or (eq x-symbol-initialize t)
1220               (memq 'auctex x-symbol-initialize))
1221       (or (fboundp 'x-symbol-tex-error-location) ; esp for preview-latex
1222           (fset 'x-symbol-tex-error-location 'ignore))
1223       (add-hook 'TeX-translate-location-hook 'x-symbol-tex-error-location)
1224       (add-hook 'TeX-region-hook 'x-symbol-inherit-from-buffer) ; v9.8a+
1225       (setq LaTeX-math-insert-function 'x-symbol-auctex-math-insert)) ; v9.8a+
1226     ;; Package RefTeX --------------------------------------------------------
1227     (when (or (eq x-symbol-initialize t)
1228               (memq 'reftex x-symbol-initialize))
1229       (unless (and (boundp 'reftex-translate-to-ascii-function)
1230                    (fboundp reftex-translate-to-ascii-function)
1231                    (not (eq reftex-translate-to-ascii-function
1232                             'reftex-latin1-to-ascii)))
1233         (setq reftex-translate-to-ascii-function 'x-symbol-translate-to-ascii))
1234       (add-hook 'reftex-pre-refontification-functions
1235                 'x-symbol-inherit-from-buffer)
1236       (unless (featurep 'mule)
1237         ;; RefTeX might be invoked from a TeX buffer without X-Symbol
1238         (or (fboundp 'x-symbol-nomule-fontify-cstrings)
1239             (fset 'x-symbol-nomule-fontify-cstrings 'ignore))
1240         (add-hook 'reftex-display-copied-context-hook
1241                   'x-symbol-nomule-fontify-cstrings)))
1242     ;; Miscellaneous ---------------------------------------------------------
1243     (x-symbol-image-set-colormap nil nil)
1244     (if init-file-loaded
1245         (x-symbol-after-init)
1246       (add-hook 'after-init-hook 'x-symbol-after-init))))
1247
1248 (defun x-symbol-after-init ()
1249   "Late initialization for package X-Symbol.
1250 See function `x-symbol-initialize' and variables `x-symbol-initialize'
1251 and `x-symbol-auto-conversion-method'.  Also add elements to
1252 `x-symbol-auto-mode-suffixes' if necessary."
1253   (when x-symbol-auto-conversion-method
1254     (and (eq x-symbol-auto-conversion-method 'auto-slow)
1255          (null (featurep 'crypt))
1256          (setq x-symbol-auto-conversion-method 'fast))
1257     (cond ((eq x-symbol-auto-conversion-method 'format)
1258            (or (assq 'x-symbol format-alist)
1259                (push '(x-symbol "X-Symbol" nil
1260                                 x-symbol-format-decode x-symbol-format-encode
1261                                 t x-symbol-mode t)
1262                      format-alist)))
1263           ((eq x-symbol-auto-conversion-method 'fast)
1264            (add-hook 'after-insert-file-functions
1265                      'x-symbol-after-insert-file t)
1266            ;; If we don't use APPEND for the hook below, we must use APPEND for
1267            ;; the hook above (and v/v).  For Emacs-21.2, using APPEND when
1268            ;; inserting is the only correct one, because function
1269            ;; `after-insert-file-set-buffer-file-coding-system', which has been
1270            ;; added to the hook, must run first (BTW, also for format.el...).
1271            (add-hook 'write-region-annotate-functions
1272                      'x-symbol-write-region-annotate-function))
1273           ((and (not (featurep 'xemacs))
1274                 (local-variable-p 'write-file-hooks))
1275            (error "Cannot use X-Symbol with crypt.el/crypt++.el and local `write-file-hooks'"))
1276           (t
1277            (add-hook 'write-file-hooks 'x-symbol-write-file-hook))))
1278   ;; misc user additions to `auto-mode-alist':
1279   (setq x-symbol-auto-mode-suffixes (x-symbol-auto-mode-suffixes
1280                                      x-symbol-auto-mode-suffixes))
1281   ;; Package comint ----------------------------------------------------------
1282   (when (or (eq x-symbol-initialize t)
1283             (memq 'comint x-symbol-initialize))
1284     (add-hook 'comint-output-filter-functions 'x-symbol-comint-output-filter)
1285     (and (boundp 'comint-input-sender)
1286          (not (eq comint-input-sender 'x-symbol-comint-send))
1287          (setq x-symbol-orig-comint-input-sender comint-input-sender))
1288     (setq comint-input-sender 'x-symbol-comint-send))
1289   ;; Package bib-cite: X-Symbol decoding would overwrite cite highlighting with
1290   ;; normal installation of bib-cite -----------------------------------------
1291   (when (and (or (eq x-symbol-initialize t)
1292                  (memq 'bib-cite x-symbol-initialize))
1293              (or (and (boundp 'LaTeX-mode-hook)
1294                       (memq 'turn-on-bib-cite LaTeX-mode-hook))
1295                  (and (boundp 'latex-mode-hook)
1296                       (memq 'turn-on-bib-cite latex-mode-hook))))
1297     (remove-hook 'LaTeX-mode-hook 'turn-on-bib-cite)
1298     (remove-hook 'latex-mode-hook 'turn-on-bib-cite)
1299     (add-hook 'find-file-hooks 'x-symbol-turn-on-bib-cite)))
1300
1301
1302 ;;;===========================================================================
1303 ;;;  Support for other packages
1304 ;;;===========================================================================
1305
1306 (defun x-symbol-inherit-from-buffer (&optional parent action)
1307   "Inherit X-Symbol's buffer-local variables from buffer PARENT.
1308 Inherit `x-symbol-mode', `x-symbol-coding', `x-symbol-8bits',
1309 `x-symbol-language', and `x-symbol-subscripts' from PARENT and set
1310 `x-symbol-image' to nil.  If PARENT is nil, `orig-buffer' is used if
1311 it is bound.  ACTION is ignored."
1312   (and (null parent) (boundp 'orig-buffer) (setq parent orig-buffer))
1313   ;; I don't care too much that people who use X-Symbol in the master buffer,
1314   ;; but not in the buffer where they invoke M-x TeX-command-region from, won't
1315   ;; have the X-Symbol characters in the "master envelope" decoded...
1316   (if (buffer-live-p (get-buffer parent))
1317       (let (mode-on coding 8bits unique language subscripts)
1318         (save-excursion
1319           (set-buffer parent)
1320           (setq mode-on    x-symbol-mode
1321                 coding     x-symbol-coding
1322                 8bits      x-symbol-8bits
1323                 unique     x-symbol-unique
1324                 language   x-symbol-language
1325                 subscripts x-symbol-subscripts))
1326         (setq x-symbol-mode mode-on)
1327         (if (local-variable-p 'x-symbol-coding parent)
1328             (setq x-symbol-coding coding))
1329         (if (local-variable-p 'x-symbol-8bits parent)
1330             (setq x-symbol-8bits 8bits))
1331         (if (local-variable-p 'x-symbol-unique parent)
1332             (setq x-symbol-unique unique))
1333         (if (local-variable-p 'x-symbol-language parent)
1334             (setq x-symbol-language language))
1335         (if (local-variable-p 'x-symbol-subscripts parent)
1336             (setq x-symbol-subscripts subscripts))
1337         (setq x-symbol-image nil))))
1338
1339 (defun x-symbol-auctex-math-insert (string)
1340   "Insert the character for \\STRING.
1341 Used as value for `LaTeX-math-insert-function'."
1342   (let ((cstring (and x-symbol-mode x-symbol-language
1343                       (x-symbol-decode-single-token (concat "\\" string)))))
1344     (if cstring
1345         (insert cstring)
1346       (TeX-insert-macro string))))
1347
1348 (defun x-symbol-turn-on-bib-cite ()
1349   "Run `turn-on-bib-cite' if we are in `latex-mode'.
1350 Added to `find-file-hooks' if the initialization for X-Symbol has
1351 removed `turn-on-bib-cite' from `LaTeX-mode-hook' or `latex-mode-hook'.
1352 See variable `x-symbol-initialize'."
1353   (if (eq major-mode 'latex-mode) (turn-on-bib-cite)))
1354
1355 ;;; Local IspellPersDict: .ispell_xsymb
1356 ;;; x-symbol-hooks.el ends here