cgit.sxemacs.org Git - packages/blob - mule-packages/mule-ucs/lisp/un-define.el

   1 ;;; -*- byte-compile-dynamic: t -*-
   2 ;;; un-define.el --- fundamental template to comprise UTF
   3 ;;;                  and Unicode conversions on Mule-UCS.
   4
   5 ;; Copyright (C) 1999-2001 MIYASHITA Hisashi
   6
   7 ;; Keywords: mule, multilingual,
   8 ;;           character set, coding-system, ISO/IEC 10646,
   9 ;;           Unicode, UTF-8, UTF-16
  10
  11 ;; This file is part of Mule-UCS
  12
  13 ;; Mule-UCS is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; Mule-UCS is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Comment:
  29 ;;;   Mule-UCS can apply many kind of conversions to Unicode.
  30 ;;;   However, we should define fundamental configurations to
  31 ;;;   realize Unicode utilization.
  32 ;;;   This module provide such facilities, that is APIs for
  33 ;;;   other applications to use Unicode, UTF, and so on.
  34
  35 ;; We've seen bugs with this far too often. The
  36 ;; mucs-ignore-version-incompatiblities thing is so we can have the package
  37 ;; compiled by 21.5, when that becomes necessary--only use it if you know
  38 ;; what you are doing!
  39 (if (and (not (boundp 'mucs-ignore-version-incompatibilities))
  40          (fboundp 'unicode-precedence-list))
  41     (error "Your XEmacs version is incompatible with Mule-UCS; not loaded."))
  42
  43 ;;; private charset definition.
  44
  45 (require 'mule-uni)
  46
  47 ;; Load the ISO 8859-13,14,15,16 character sets, to allow us to create
  48 ;; mappings for them.
  49 (require 'latin-euro-standards)
  50
  51 ;;; Autoload section
  52 (autoload 'ucs-to-char "unicode")
  53 (autoload 'char-to-ucs "unicode")
  54 (autoload 'tae-modify-translation "tae")
  55 (autoload 'insert-ucs-character "unicode"
  56   "Insert character which is converted from give UCS codepoint."
  57   t)
  58
  59 ;;; un-define post-read-conversion and pre-write-conversion.
  60
  61 (defvar un-define-enable-buffer-conversion t
  62   "* non-nil means the UTF-* coding-systems converts buffer contents
  63 by calling post-read-conversion and pre-write-conversion functions.")
  64
  65 (defvar un-define-post-read-conversion-charsets-alist
  66   (append
  67    '((thai-tis620 . thai-post-read-conversion))
  68    (if (fboundp (function tibetan-post-read-conversion))
  69        '((tibetan . tibetan-post-read-conversion)))
  70     ;; in-is13194-devanagari-post-read-conversion does not work correctly.
  71     ;; I disabled the below line.
  72     ;; '((indian-is13194 . in-is13194-devanagari-post-read-conversion)))
  73     ))
  74
  75 (defvar un-define-pre-write-conversion-charsets-alist
  76   (append
  77    ;; Disabled because read-multibyte-character
  78    ;; decompose composite characters
  79    ;; '((thai-tis620 . thai-pre-write-conversion))
  80    '((indian-is13194 . in-is13194-devanagari-pre-write-conversion)
  81      (indian-1-column . in-is13194-devanagari-pre-write-conversion)
  82      (indian-2-column . in-is13194-devanagari-pre-write-conversion))
  83    (if (fboundp (function tibetan-pre-write-canonicalize-for-unicode))
  84        '((tibetan . tibetan-pre-write-canonicalize-for-unicode)))))
  85
  86 (defun un-define-post-read-conversion (len)
  87   (if un-define-enable-buffer-conversion
  88       (let* ((curpos (point))
  89              (charsets (find-charset-region curpos (+ curpos len)))
  90              slot func applied)
  91         (while charsets
  92           (setq slot (assq (car charsets)
  93                            un-define-post-read-conversion-charsets-alist)
  94                 func (cdr slot)
  95                 charsets (cdr charsets))
  96           (if (and slot
  97                    (not (memq func applied)))
  98               (progn
  99                 (setq len (funcall func len)
 100                       applied (cons func applied)))))))
 101   len)
 102
 103 (defun un-define-pre-write-conversion (from to)
 104   (if un-define-enable-buffer-conversion
 105       (let ((charsets (if (stringp from)
 106                           (find-charset-string from)
 107                         (find-charset-region from to)))
 108             slot func applied)
 109         (while charsets
 110           (setq slot (assq (car charsets)
 111                            un-define-pre-write-conversion-charsets-alist)
 112                 func (cdr slot)
 113                 charsets (cdr charsets))
 114           (if (and slot
 115                    (not (memq func applied)))
 116               (progn
 117                 (funcall func from to)
 118                 (setq applied (cons func applied)))))))
 119   nil)
 120
 121 ;;; Required for compile, and also persistent section.
 122 (eval-and-compile
 123
 124 ;
 125 ; unicode basic translation charset list.
 126 ;
 127   (defvar unicode-basic-translation-charset-order-list
 128     (let ((cand
 129            (append
 130             '(ascii
 131               latin-iso8859-1
 132               latin-iso8859-2
 133               latin-iso8859-3
 134               latin-iso8859-4
 135               cyrillic-iso8859-5
 136                                         ;  arabic-iso8859-6
 137               greek-iso8859-7
 138               hebrew-iso8859-8
 139               latin-iso8859-9
 140               latin-iso8859-13
 141               latin-iso8859-14
 142               latin-iso8859-15
 143               latin-iso8859-16
 144               ipa
 145               japanese-jisx0208
 146               japanese-jisx0212
 147               chinese-gb2312
 148               chinese-cns11643-1
 149               chinese-cns11643-2
 150               chinese-cns11643-3
 151               chinese-cns11643-4
 152               chinese-cns11643-5
 153               chinese-cns11643-6
 154               chinese-cns11643-7
 155               chinese-big5-1
 156               chinese-big5-2
 157               korean-ksc5601
 158               latin-jisx0201
 159               katakana-jisx0201
 160               thai-tis620
 161               ethiopic
 162               indian-is13194
 163               chinese-sisheng
 164               vietnamese-viscii-lower
 165               vietnamese-viscii-upper)
 166             (if (fboundp
 167                  (function tibetan-pre-write-canonicalize-for-unicode))
 168                 '(tibetan))
 169             '(mule-unicode-0100-24ff
 170               mule-unicode-2500-33ff
 171               mule-unicode-e000-ffff)))
 172           elem result)
 173       (while (setq elem (car cand))
 174         (if (or (funcall-if-possible (function find-charset) elem)
 175                 (funcall-if-possible (function charsetp) elem))
 176             (setq result (cons elem result)))
 177         (setq cand (cdr cand)))
 178       (nreverse result))
 179     "*Charset order used by unicode-basic-translation.")
 180
 181   (defvar un-define-safe-charsets-for-coding-systems
 182     (append
 183      unicode-basic-translation-charset-order-list
 184      '(indian-2-column)))
 185
 186 ;
 187 ; Default translation rule symbol per charset.
 188 ;
 189
 190 ; Make symbol of translation rule for Unicode.
 191   (mapcar
 192    (lambda (cs)
 193      (put cs
 194           'translation-rule-for-unicode
 195           (intern (format "unicode-%s-translation-rule" cs))))
 196    unicode-basic-translation-charset-order-list)
 197
 198   (defun unicode-get-translation-rule-from-charset (charset)
 199     (or (get charset 'translation-rule-for-unicode)
 200         (error "Charset:%S has no translation rule for Unicode"
 201                charset)))
 202
 203 ;
 204 ; font encoder charset spec alist
 205 ;
 206
 207   (defvar unicode-font-encoder-charset-spec-alist
 208     (mapcar
 209      (lambda (cs)
 210        (cons cs
 211              (or (get cs 'mccl-font-encoder)
 212                  `(list
 213                    (mccl-font-convert-font-encoding)
 214                    (tae-compile
 215                     (quote
 216                      ,(unicode-get-translation-rule-from-charset cs)))
 217                    (mccl-font-flat-code-to-font-encoding 2)))))
 218      unicode-basic-translation-charset-order-list))
 219
 220 ;;
 221 ;; Configuration functions for convenience.
 222 ;;
 223
 224   (defun un-define-decode-template (tr read write)
 225     (mucs-ccl-stream-form
 226      (mucs-ccl-read 'ucs-generic read)
 227      (tae-compile tr t)
 228      (mucs-ccl-write write)))
 229
 230   (defun un-define-encode-template (tr read write)
 231     (mucs-ccl-stream-form
 232      (mucs-ccl-read 'char-1 read)
 233      (tae-compile tr nil)
 234      (mucs-ccl-write write)))
 235
 236   (defun un-define-get-coding-system-alist
 237     (coding-category &optional mime-charset charsets)
 238     (append
 239      '((pre-write-conversion . un-define-pre-write-conversion)
 240        (post-read-conversion . un-define-post-read-conversion))
 241      (if mime-charset
 242          (list (cons 'mime-charset mime-charset)))
 243      (if (and coding-category
 244               (get coding-category 'coding-category-index))
 245          (list (cons 'coding-category coding-category)))
 246      (list (cons 'safe-charsets
 247                  (or charsets
 248                      un-define-safe-charsets-for-coding-systems)))))
 249   )
 250
 251 (eval-when-compile
 252
 253   ;; predefined configuration
 254   ;; Any settings in here affect only
 255   ;; byte-compiled file.
 256   (require 'un-trbase)
 257   (require 'mccl-font)
 258   (require 'utf))
 259
 260 (mucs-define-package
 261  un-define
 262
 263 ;;
 264 ;; conversion definition.
 265 ;;
 266
 267 ;;; For stream conversion.
 268
 269 ; UTF-8 conversions
 270
 271  (mucs-define-conversion
 272   utf-8-unix-stream-encoder
 273   stream
 274   (utf-8-encode-buffer-magnification
 275    ((un-define-encode-template
 276      'unicode-basic-stream-translation-rule 'emacs-mule 'utf-8))))
 277  (mucs-define-conversion
 278   utf-8-unix-stream-decoder
 279   stream
 280   (utf-8-decode-buffer-magnification
 281    ((un-define-decode-template
 282      'unicode-basic-stream-translation-rule 'utf-8 'emacs-mule))))
 283
 284  (mucs-define-conversion
 285   utf-8-dos-stream-encoder
 286   stream
 287   (utf-8-encode-buffer-magnification
 288    ((un-define-encode-template
 289      'unicode-basic-stream-translation-rule 'emacs-mule 'utf-8-dos))))
 290  (mucs-define-conversion
 291   utf-8-dos-stream-decoder
 292   stream
 293   (utf-8-decode-buffer-magnification
 294    ((un-define-decode-template
 295      'unicode-basic-stream-translation-rule 'utf-8 'emacs-mule-dos))))
 296
 297  (mucs-define-conversion
 298   utf-8-mac-stream-encoder
 299   stream
 300   (utf-8-encode-buffer-magnification
 301    ((un-define-encode-template
 302      'unicode-mac-line-separator-translation-rule
 303      'emacs-mule 'utf-8))))
 304  (mucs-define-conversion
 305   utf-8-mac-stream-decoder
 306   stream
 307   (utf-8-decode-buffer-magnification
 308    ((un-define-decode-template
 309      'unicode-mac-line-separator-translation-rule
 310      'utf-8 'emacs-mule))))
 311
 312 ; UTF-8 with signature conversions
 313
 314  (mucs-define-conversion
 315   utf-8-ws-unix-stream-encoder
 316   stream
 317   (utf-8-encode-buffer-magnification
 318    ((mucs-ccl-write-utf-8-signature)
 319     (un-define-encode-template
 320      'unicode-basic-stream-translation-rule
 321      'emacs-mule 'utf-8))))
 322
 323  (mucs-define-conversion
 324   utf-8-ws-dos-stream-encoder
 325   stream
 326   (utf-8-encode-buffer-magnification
 327    ((mucs-ccl-write-utf-8-signature)
 328     (un-define-encode-template
 329      'unicode-basic-stream-translation-rule
 330      'emacs-mule 'utf-8-dos))))
 331
 332  (mucs-define-conversion
 333   utf-8-ws-mac-stream-encoder
 334   stream
 335   (utf-8-encode-buffer-magnification
 336    ((mucs-ccl-write-utf-8-signature)
 337     (un-define-encode-template
 338      'unicode-mac-line-separator-translation-rule
 339      'emacs-mule 'utf-8))))
 340
 341 ; UTF-16-le conversions
 342
 343  (mucs-define-conversion
 344   utf-16-le-unix-stream-encoder
 345   stream
 346   (utf-16-encode-buffer-magnification
 347    ((mucs-ccl-write-utf-16-le-signature)
 348     (un-define-encode-template
 349      'unicode-basic-stream-translation-rule
 350      'emacs-mule 'utf-16-le))))
 351  (mucs-define-conversion
 352   utf-16-le-no-signature-unix-stream-encoder
 353   stream
 354   (utf-16-encode-buffer-magnification
 355    ((un-define-encode-template
 356      'unicode-basic-stream-translation-rule
 357      'emacs-mule 'utf-16-le))))
 358  (mucs-define-conversion
 359   utf-16-le-unix-stream-decoder
 360   stream
 361   (utf-16-decode-buffer-magnification
 362    ((un-define-decode-template
 363      'unicode-basic-stream-translation-rule
 364      'utf-16-le 'emacs-mule))))
 365
 366  (mucs-define-conversion
 367   utf-16-le-dos-stream-encoder
 368   stream
 369   (utf-16-encode-buffer-magnification
 370    ((mucs-ccl-write-utf-16-le-signature)
 371     (un-define-encode-template
 372      'unicode-basic-stream-translation-rule
 373      'emacs-mule 'utf-16-le-dos))))
 374  (mucs-define-conversion
 375   utf-16-le-no-signature-dos-stream-encoder
 376   stream
 377   (utf-16-encode-buffer-magnification
 378    ((un-define-encode-template
 379      'unicode-basic-stream-translation-rule
 380      'emacs-mule 'utf-16-le-dos))))
 381  (mucs-define-conversion
 382   utf-16-le-dos-stream-decoder
 383   stream
 384   (utf-16-decode-buffer-magnification
 385    ((un-define-decode-template
 386      'unicode-basic-stream-translation-rule
 387      'utf-16-le 'emacs-mule-dos))))
 388
 389  (mucs-define-conversion
 390   utf-16-le-mac-stream-encoder
 391   stream
 392   (utf-16-encode-buffer-magnification
 393    ((mucs-ccl-write-utf-16-le-signature)
 394     (un-define-encode-template
 395      'unicode-mac-line-separator-translation-rule
 396      'emacs-mule 'utf-16-le))))
 397  (mucs-define-conversion
 398   utf-16-le-no-signature-mac-stream-encoder
 399   stream
 400   (utf-16-encode-buffer-magnification
 401    ((un-define-encode-template
 402      'unicode-mac-line-separator-translation-rule
 403      'emacs-mule 'utf-16-le))))
 404  (mucs-define-conversion
 405   utf-16-le-mac-stream-decoder
 406   stream
 407   (utf-16-decode-buffer-magnification
 408    ((un-define-decode-template
 409      'unicode-mac-line-separator-translation-rule
 410      'utf-16-le 'emacs-mule))))
 411
 412  ;; unicode line separator(the abberiviation is ul.)
 413  (mucs-define-conversion
 414   utf-16-le-ul-stream-encoder
 415   stream
 416   (utf-16-encode-buffer-magnification
 417    ((mucs-ccl-write-utf-16-le-signature)
 418     (un-define-encode-template
 419      'unicode-line-separator-translation-rule
 420      'emacs-mule 'utf-16-le))))
 421  (mucs-define-conversion
 422   utf-16-le-no-signature-ul-stream-encoder
 423   stream
 424   (utf-16-encode-buffer-magnification
 425    ((un-define-encode-template
 426      'unicode-line-separator-translation-rule
 427      'emacs-mule 'utf-16-le))))
 428  (mucs-define-conversion
 429   utf-16-le-ul-stream-decoder
 430   stream
 431   (utf-16-decode-buffer-magnification
 432    ((un-define-decode-template
 433      'unicode-line-separator-translation-rule
 434      'utf-16-le 'emacs-mule))))
 435
 436 ; UTF-16-be conversions
 437
 438  (mucs-define-conversion
 439   utf-16-be-unix-stream-encoder
 440   stream
 441   (utf-16-encode-buffer-magnification
 442    ((mucs-ccl-write-utf-16-be-signature)
 443     (un-define-encode-template
 444      'unicode-basic-stream-translation-rule
 445      'emacs-mule 'utf-16-be))))
 446  (mucs-define-conversion
 447   utf-16-be-no-signature-unix-stream-encoder
 448   stream
 449   (utf-16-encode-buffer-magnification
 450    ((un-define-encode-template
 451      'unicode-basic-stream-translation-rule
 452      'emacs-mule 'utf-16-be))))
 453  (mucs-define-conversion
 454   utf-16-be-unix-stream-decoder
 455   stream
 456   (utf-16-decode-buffer-magnification
 457    ((un-define-decode-template
 458      'unicode-basic-stream-translation-rule
 459      'utf-16-be 'emacs-mule))))
 460
 461  (mucs-define-conversion
 462   utf-16-be-dos-stream-encoder
 463   stream
 464   (utf-16-encode-buffer-magnification
 465    ((mucs-ccl-write-utf-16-be-signature)
 466     (un-define-encode-template
 467      'unicode-basic-stream-translation-rule
 468      'emacs-mule 'utf-16-be-dos))))
 469  (mucs-define-conversion
 470   utf-16-be-no-signature-dos-stream-encoder
 471   stream
 472   (utf-16-encode-buffer-magnification
 473    ((un-define-encode-template
 474      'unicode-basic-stream-translation-rule
 475      'emacs-mule 'utf-16-be-dos))))
 476  (mucs-define-conversion
 477   utf-16-be-dos-stream-decoder
 478   stream
 479   (utf-16-decode-buffer-magnification
 480    ((un-define-decode-template
 481      'unicode-basic-stream-translation-rule
 482      'utf-16-be 'emacs-mule-dos))))
 483
 484  (mucs-define-conversion
 485   utf-16-be-mac-stream-encoder
 486   stream
 487   (utf-16-encode-buffer-magnification
 488    ((mucs-ccl-write-utf-16-be-signature)
 489     (un-define-encode-template
 490      'unicode-mac-line-separator-translation-rule
 491      'emacs-mule 'utf-16-be))))
 492  (mucs-define-conversion
 493   utf-16-be-no-signature-mac-stream-encoder
 494   stream
 495   (utf-16-encode-buffer-magnification
 496    ((un-define-encode-template
 497      'unicode-mac-line-separator-translation-rule
 498      'emacs-mule 'utf-16-be))))
 499  (mucs-define-conversion
 500   utf-16-be-mac-stream-decoder
 501   stream
 502   (utf-16-decode-buffer-magnification
 503    ((un-define-decode-template
 504      'unicode-mac-line-separator-translation-rule
 505      'utf-16-be 'emacs-mule))))
 506
 507  ;; unicode line separator(the abberiviation is ul.)
 508  (mucs-define-conversion
 509   utf-16-be-ul-stream-encoder
 510   stream
 511   (utf-16-encode-buffer-magnification
 512    ((mucs-ccl-write-utf-16-be-signature)
 513     (un-define-encode-template
 514      'unicode-line-separator-translation-rule
 515      'emacs-mule 'utf-16-be))))
 516  (mucs-define-conversion
 517   utf-16-be-no-signature-ul-stream-encoder
 518   stream
 519   (utf-16-encode-buffer-magnification
 520    ((un-define-encode-template
 521      'unicode-line-separator-translation-rule
 522      'emacs-mule 'utf-16-be))))
 523  (mucs-define-conversion
 524   utf-16-be-ul-stream-decoder
 525   stream
 526   (utf-16-decode-buffer-magnification
 527    ((un-define-decode-template
 528      'unicode-line-separator-translation-rule
 529      'utf-16-be 'emacs-mule))))
 530
 531 ; UTF-7 conversions
 532
 533  (mucs-define-conversion
 534   utf-7-unix-stream-encoder
 535   stream
 536   (utf-7-encode-buffer-magnification
 537    ((un-define-encode-template
 538      'unicode-basic-stream-translation-rule 'emacs-mule 'utf-7))
 539    ((mucs-ccl-utf-7-encode-eof))))
 540  (mucs-define-conversion
 541   utf-7-safe-unix-stream-encoder
 542   stream
 543   (utf-7-encode-buffer-magnification
 544    ((un-define-encode-template
 545      'unicode-basic-stream-translation-rule
 546      'emacs-mule 'utf-7-safe))
 547    ((mucs-ccl-utf-7-encode-eof))))
 548  (mucs-define-conversion
 549   utf-7-unix-stream-decoder
 550   stream
 551   (utf-7-decode-buffer-magnification
 552    ((un-define-decode-template
 553      'unicode-basic-stream-translation-rule 'utf-7 'emacs-mule))))
 554
 555  (mucs-define-conversion
 556   utf-7-dos-stream-encoder
 557   stream
 558   (utf-7-encode-buffer-magnification
 559    ((un-define-encode-template
 560      'unicode-basic-stream-translation-rule 'emacs-mule 'utf-7-dos))
 561    ((mucs-ccl-utf-7-encode-eof))))
 562  (mucs-define-conversion
 563   utf-7-safe-dos-stream-encoder
 564   stream
 565   (utf-7-encode-buffer-magnification
 566    ((un-define-encode-template
 567      'unicode-basic-stream-translation-rule
 568      'emacs-mule 'utf-7-safe-dos))
 569    ((mucs-ccl-utf-7-encode-eof))))
 570  (mucs-define-conversion
 571   utf-7-dos-stream-decoder
 572   stream
 573   (utf-7-decode-buffer-magnification
 574    ((un-define-decode-template
 575      'unicode-basic-stream-translation-rule 'utf-7 'emacs-mule-dos))))
 576
 577  (mucs-define-conversion
 578   utf-7-mac-stream-encoder
 579   stream
 580   (utf-7-encode-buffer-magnification
 581    ((un-define-encode-template
 582      'unicode-mac-line-separator-translation-rule
 583      'emacs-mule 'utf-7))
 584    ((mucs-ccl-utf-7-encode-eof))))
 585  (mucs-define-conversion
 586   utf-7-safe-mac-stream-encoder
 587   stream
 588   (utf-7-encode-buffer-magnification
 589    ((un-define-encode-template
 590      'unicode-mac-line-separator-translation-rule
 591      'emacs-mule 'utf-7-safe))
 592    ((mucs-ccl-utf-7-encode-eof))))
 593  (mucs-define-conversion
 594   utf-7-mac-stream-decoder
 595   stream
 596   (utf-7-decode-buffer-magnification
 597    ((un-define-decode-template
 598      'unicode-mac-line-separator-translation-rule
 599      'utf-7 'emacs-mule))))
 600
 601 ;;; For non-stream conversion.
 602
 603  (mucs-define-conversion
 604   emacs-char-to-ucs-codepoint-conversion
 605   (char-1 . ucs-generic)
 606   (0 ((tae-compile 'unicode-basic-non-stream-translation-rule nil))))
 607
 608  (mucs-define-conversion
 609   ucs-codepoint-to-emacs-char-conversion
 610   (ucs-generic . char-1)
 611   (0 ((tae-compile 'unicode-basic-non-stream-translation-rule t))))
 612
 613 ;;; For font encoder
 614
 615  (mucs-define-conversion
 616   unicode-font-encoder
 617   font
 618   (0 ((mccl-font-encoder
 619        unicode-font-encoder-charset-spec-alist))))
 620
 621 ;;
 622 ;; coding-system-definition.
 623 ;;
 624
 625  (mapcar
 626   (lambda (x)
 627     (mapcar
 628      (lambda (y)
 629        (mucs-define-coding-system
 630         (nth 0 y) (nth 1 y) (nth 2 y)
 631         (nth 3 y) (nth 4 y) (nth 5 y) (nth 6 y))
 632        (coding-system-put (car y) 'alias-coding-systems (list (car x)))
 633        (when (memq (car x) (coding-category-list))
 634          (coding-system-put (car y) 'category (car x))))
 635      (cdr x)))
 636   `((utf-8
 637      (utf-8-unix
 638       ?u "UTF-8 coding system"
 639       utf-8-unix-stream-decoder utf-8-unix-stream-encoder
 640       ,(un-define-get-coding-system-alist
 641         'coding-category-utf-8 'utf-8)
 642       unix)
 643      (utf-8-dos
 644       ?u "UTF-8 coding system"
 645       utf-8-dos-stream-decoder utf-8-dos-stream-encoder
 646       ,(un-define-get-coding-system-alist
 647         'coding-category-utf-8 'utf-8)
 648       dos)
 649      (utf-8-mac
 650       ?u "UTF-8 coding system"
 651       utf-8-mac-stream-decoder utf-8-mac-stream-encoder
 652       ,(un-define-get-coding-system-alist
 653         'coding-category-utf-8 'utf-8)
 654       mac)
 655      (utf-8
 656       ?u "UTF-8 coding system"
 657       utf-8-unix-stream-decoder utf-8-unix-stream-encoder
 658       ,(un-define-get-coding-system-alist
 659         'coding-category-utf-8 'utf-8)
 660       [utf-8-unix utf-8-dos utf-8-mac]))
 661
 662     (utf-8-ws
 663      (utf-8-ws-unix
 664       ?u "UTF-8 with signature coding system"
 665       utf-8-unix-stream-decoder utf-8-ws-unix-stream-encoder
 666       ,(un-define-get-coding-system-alist
 667         'coding-category-utf-8 'utf-8)
 668       unix)
 669      (utf-8-ws-dos
 670       ?u "UTF-8 with signature coding system"
 671       utf-8-dos-stream-decoder utf-8-ws-dos-stream-encoder
 672       ,(un-define-get-coding-system-alist
 673         'coding-category-utf-8 'utf-8)
 674       dos)
 675      (utf-8-ws-mac
 676       ?u "UTF-8 with signature coding system"
 677       utf-8-mac-stream-decoder utf-8-ws-mac-stream-encoder
 678       ,(un-define-get-coding-system-alist
 679         'coding-category-utf-8 'utf-8)
 680       mac)
 681      (utf-8-ws
 682       ?u "UTF-8 with signature coding system"
 683       utf-8-unix-stream-decoder utf-8-ws-unix-stream-encoder
 684       ,(un-define-get-coding-system-alist
 685         'coding-category-utf-8 'utf-8)
 686       [utf-8-ws-unix utf-8-ws-dos utf-8-ws-mac]))
 687
 688     (utf-16-le
 689      (utf-16-le-unix
 690       ?U "UTF-16 Little Endian coding system"
 691       utf-16-le-unix-stream-decoder utf-16-le-unix-stream-encoder
 692       ,(un-define-get-coding-system-alist
 693         'coding-category-utf-16-le)
 694       unix)
 695      (utf-16-le-dos
 696       ?U "UTF-16 Little Endian coding system"
 697       utf-16-le-dos-stream-decoder utf-16-le-dos-stream-encoder
 698       ,(un-define-get-coding-system-alist
 699         'coding-category-utf-16-le)
 700       dos)
 701      (utf-16-le-mac
 702       ?U "UTF-16 Little Endian coding system"
 703       utf-16-le-mac-stream-decoder utf-16-le-mac-stream-encoder
 704       ,(un-define-get-coding-system-alist
 705         'coding-category-utf-16-le)
 706       mac)
 707      (utf-16-le
 708       ?U "UTF-16 Little Endian coding system(Line serparator is U+2028)"
 709       utf-16-le-ul-stream-decoder utf-16-le-ul-stream-encoder
 710       ,(un-define-get-coding-system-alist
 711         'coding-category-utf-16-le)
 712       [utf-16-le-unix utf-16-le-dos utf-16-le-mac]))
 713
 714     (utf-16-le-no-signature
 715      (utf-16-le-no-signature-unix
 716       ?U "Same as utf-16-le but generate no Unicode signature."
 717       utf-16-le-unix-stream-decoder
 718       utf-16-le-no-signature-unix-stream-encoder
 719       ,(un-define-get-coding-system-alist
 720         'coding-category-utf-16-le)
 721       unix)
 722      (utf-16-le-no-signature-dos
 723       ?U "Same as utf-16-le but generate no Unicode signature."
 724       utf-16-le-dos-stream-decoder
 725       utf-16-le-no-signature-dos-stream-encoder
 726       ,(un-define-get-coding-system-alist
 727         'coding-category-utf-16-le)
 728       dos)
 729      (utf-16-le-no-signature-mac
 730       ?U "Same as utf-16-le but generate no Unicode signature."
 731       utf-16-le-mac-stream-decoder
 732       utf-16-le-no-signature-mac-stream-encoder
 733       ,(un-define-get-coding-system-alist
 734         'coding-category-utf-16-le)
 735       mac)
 736      (utf-16-le-no-signature
 737       ?U "Same as utf-16-le but generate no Unicode signature."
 738       utf-16-le-ul-stream-decoder
 739       utf-16-le-no-signature-ul-stream-encoder
 740       ,(un-define-get-coding-system-alist
 741         'coding-category-utf-16-le)
 742       [utf-16-le-no-signature-unix
 743        utf-16-le-no-signature-dos
 744        utf-16-le-no-signature-mac]))
 745
 746     (utf-16-be
 747      (utf-16-be-unix
 748       ?U "UTF-16 Big Endian coding system"
 749       utf-16-be-unix-stream-decoder utf-16-be-unix-stream-encoder
 750       ,(un-define-get-coding-system-alist
 751         'coding-category-utf-16-be)
 752       unix)
 753     (utf-16-be-dos
 754      ?U "UTF-16 Big Endian coding system"
 755      utf-16-be-dos-stream-decoder utf-16-be-dos-stream-encoder
 756      ,(un-define-get-coding-system-alist
 757        'coding-category-utf-16-be)
 758      dos)
 759     (utf-16-be-mac
 760      ?U "UTF-16 Big Endian coding system"
 761      utf-16-be-mac-stream-decoder utf-16-be-mac-stream-encoder
 762      ,(un-define-get-coding-system-alist
 763        'coding-category-utf-16-be)
 764      mac)
 765     (utf-16-be
 766      ?U "UTF-16 Big Endian coding system(Line serparator is U+2028)"
 767      utf-16-be-ul-stream-decoder utf-16-be-ul-stream-encoder
 768      ,(un-define-get-coding-system-alist
 769        'coding-category-utf-16-be)
 770      [utf-16-be-unix utf-16-be-dos utf-16-be-mac]))
 771
 772     (utf-16-be-no-signature
 773      (utf-16-be-no-signature-unix
 774       ?U "Same as utf-16-be but generate no Unicode signature."
 775       utf-16-be-unix-stream-decoder
 776       utf-16-be-no-signature-unix-stream-encoder
 777       ,(un-define-get-coding-system-alist
 778         'coding-category-utf-16-be)
 779       unix)
 780     (utf-16-be-no-signature-dos
 781      ?U "Same as utf-16-be but generate no Unicode signature."
 782      utf-16-be-dos-stream-decoder
 783      utf-16-be-no-signature-dos-stream-encoder
 784      ,(un-define-get-coding-system-alist
 785        'coding-category-utf-16-be)
 786      dos)
 787     (utf-16-be-no-signature-mac
 788      ?U "Same as utf-16-be but generate no Unicode signature."
 789      utf-16-be-mac-stream-decoder
 790      utf-16-be-no-signature-mac-stream-encoder
 791      ,(un-define-get-coding-system-alist
 792        'coding-category-utf-16-be)
 793      mac)
 794     (utf-16-be-no-signature
 795      ?U "Same as utf-16-be but generate no Unicode signature."
 796      utf-16-be-ul-stream-decoder
 797      utf-16-be-no-signature-ul-stream-encoder
 798      ,(un-define-get-coding-system-alist
 799        'coding-category-utf-16-be)
 800      [utf-16-be-no-signature-unix
 801       utf-16-be-no-signature-dos
 802       utf-16-be-no-signature-mac]))
 803
 804     (utf-7
 805      (utf-7-unix
 806       ?7 "UTF-7 coding system.  Output Set O characters directly."
 807       utf-7-unix-stream-decoder utf-7-unix-stream-encoder
 808       ,(un-define-get-coding-system-alist
 809         'coding-category-ccl 'utf-7)
 810       unix)
 811      (utf-7-dos
 812       ?7 "UTF-7 coding system.  Output Set O characters directly."
 813       utf-7-dos-stream-decoder utf-7-dos-stream-encoder
 814       ,(un-define-get-coding-system-alist
 815         'coding-category-ccl 'utf-7)
 816       dos)
 817      (utf-7-mac
 818       ?7 "UTF-7 coding system.  Output Set O characters directly."
 819       utf-7-mac-stream-decoder utf-7-mac-stream-encoder
 820       ,(un-define-get-coding-system-alist
 821         'coding-category-ccl 'utf-7)
 822       mac)
 823      (utf-7
 824       ?7 "UTF-7 coding system.  Output Set O characters directly."
 825       utf-7-unix-stream-decoder utf-7-unix-stream-encoder
 826       ,(un-define-get-coding-system-alist
 827         'coding-category-ccl 'utf-7)
 828       [utf-7-unix utf-7-dos utf-7-mac]))
 829
 830     (utf-7-safe
 831      (utf-7-safe-unix
 832       ?7 "UTF-7 coding system.  Shift Set O characters."
 833       utf-7-unix-stream-decoder utf-7-safe-unix-stream-encoder
 834       ,(un-define-get-coding-system-alist
 835         'coding-category-ccl 'utf-7)
 836       unix)
 837     (utf-7-safe-dos
 838      ?7 "UTF-7 coding system.  Shift Set O characters."
 839      utf-7-dos-stream-decoder utf-7-safe-dos-stream-encoder
 840      ,(un-define-get-coding-system-alist
 841        'coding-category-ccl 'utf-7)
 842      dos)
 843     (utf-7-safe-mac
 844      ?7 "UTF-7 coding system.  Shift Set O characters."
 845      utf-7-mac-stream-decoder utf-7-safe-mac-stream-encoder
 846      ,(un-define-get-coding-system-alist
 847        'coding-category-ccl 'utf-7)
 848      mac)
 849     (utf-7-safe
 850      ?7 "UTF-7 coding system.  Shift Set O characters."
 851      utf-7-unix-stream-decoder utf-7-safe-unix-stream-encoder
 852      ,(un-define-get-coding-system-alist
 853        'coding-category-ccl 'utf-7)
 854      [utf-7-safe-unix utf-7-safe-dos utf-7-safe-mac]))
 855     ))
 856
 857 ) ;; un-define package definition ends here
 858
 859 ; font encoder setup (for Meadow)
 860 (if (featurep 'meadow)
 861     (w32-regist-font-encoder
 862      'unicode-font-encoder 'unicode-font-encoder))
 863
 864 ;;; coding-category setup
 865 (let (category-list)
 866 ;; set up coding-category
 867   (if (boundp 'coding-category-utf-8)
 868       (setq coding-category-utf-8 'utf-8
 869             category-list (cons 'coding-category-utf-8
 870                                 category-list)))
 871   (if (boundp 'coding-category-utf-16-be)
 872       (setq coding-category-utf-16-be 'utf-16-be
 873             category-list (cons 'coding-category-utf-16-be
 874                                 category-list)))
 875   (if (boundp 'coding-category-utf-16-le)
 876       (setq coding-category-utf-16-le 'utf-16-le
 877             category-list (cons 'coding-category-utf-16-le
 878                                 category-list)))
 879 ;; setup detect coding priority.
 880   (if category-list
 881       (progn
 882         (set-coding-priority
 883          category-list)
 884         (add-hook 'set-language-environment-hook
 885                   `(lambda ()
 886                      (set-coding-priority (quote ,category-list)))))))
 887
 888 ;
 889 ; Charset order dynamic modification. (Very simple version!)
 890 ;
 891
 892 (defun un-define-generate-basic-translation-rule (order-list)
 893   `(| ,@(mapcar
 894          (function unicode-get-translation-rule-from-charset)
 895          order-list)))
 896
 897 ;;;###autoload
 898 (defun un-define-change-charset-order (&optional order-list)
 899   "Change UCS to Mule charset conversion priority.
 900
 901 ORDER-LIST is a list of charsets.  When translating a UCS character to a
 902 Mule character, the first charset in the list which contains the character
 903 is used.  ORDER-LIST may be abbreviated to the charsets of interest.  In
 904 this case, charsets in ORDER-LIST are given highest priority in that order,
 905 followed by any charsets not mentioned, with the same relative order as in
 906 the current priority list.
 907
 908 Use `list-character-sets' to get a list of character sets."
 909   (if (null order-list)
 910       (setq order-list
 911             unicode-basic-translation-charset-order-list))
 912   (tae-modify-translation
 913    'unicode-basic-translation-rule
 914    (un-define-generate-basic-translation-rule
 915     order-list)))
 916
 917 (provide 'un-define)
 918
 919 ;;; un-define ends here.