xemacs-beta: lisp/mule/mule-coding.el annotate

annotate lisp/mule/mule-coding.el @ 4614:afbfad080ddd

The URLs in our current config.guess and config.sub files are obsolete. Update to the latest upstream release to get correct URLs, as well as fixes and enhancements to those scripts.

author	Jerry James <james@xemacs.org>
date	Wed, 11 Feb 2009 11:09:35 -0700
parents	c786c3fd0740
children	257b468bf2ca

rev	line source
502 7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben] ben parents: 448 diff changeset	1 ;;; mule-coding.el --- Coding-system functions for Mule. -- coding: iso-2022-7bit; --
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	2
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	4 ;; Licensed to the Free Software Foundation.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	5 ;; Copyright (C) 1995 Amdahl Corporation.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	6 ;; Copyright (C) 1995 Sun Microsystems.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	7 ;; Copyright (C) 1997 MORIOKA Tomohiko
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	8 ;; Copyright (C) 2001 Ben Wing.
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	9
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	10 ;; This file is part of XEmacs.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	11
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	12 ;; XEmacs is free software; you can redistribute it and/or modify it
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	13 ;; under the terms of the GNU General Public License as published by
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	14 ;; the Free Software Foundation; either version 2, or (at your option)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	15 ;; any later version.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	16
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	17 ;; XEmacs is distributed in the hope that it will be useful, but
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	20 ;; General Public License for more details.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	21
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	22 ;; You should have received a copy of the GNU General Public License
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	23 ;; along with XEmacs; see the file COPYING. If not, write to the
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	25 ;; Boston, MA 02111-1307, USA.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	26
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	27 ;;; Commentary:
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	28
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	29 ;;; split off of mule.el and mostly moved to coding.el
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	30
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	31 ;; Needed for make-8-bit-coding-system.
4080 476d0799d704 [xemacs-hg @ 2007-07-27 18:56:45 by aidan] aidan parents: 4072 diff changeset	32 (eval-when-compile (require 'ccl))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	33
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	34 ;;; Code:
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	35
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	36 (defun coding-system-force-on-output (coding-system register)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	37 "Return the 'force-on-output property of CODING-SYSTEM for the specified REGISTER."
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	38 (check-type register integer)
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	39 (coding-system-property
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	40 coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	41 (case register
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	42 (0 'force-g0-on-output)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	43 (1 'force-g1-on-output)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	44 (2 'force-g2-on-output)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	45 (3 'force-g3-on-output)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	46 (t (signal 'args-out-of-range (list register 0 3))))))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	47
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	48 (defun coding-system-short (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	49 "Return the 'short property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	50 (coding-system-property coding-system 'short))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	51
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	52 (defun coding-system-no-ascii-eol (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	53 "Return the 'no-ascii-eol property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	54 (coding-system-property coding-system 'no-ascii-eol))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	55
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	56 (defun coding-system-no-ascii-cntl (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	57 "Return the 'no-ascii-cntl property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	58 (coding-system-property coding-system 'no-ascii-cntl))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	59
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	60 (defun coding-system-seven (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	61 "Return the 'seven property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	62 (coding-system-property coding-system 'seven))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	63
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	64 (defun coding-system-lock-shift (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	65 "Return the 'lock-shift property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	66 (coding-system-property coding-system 'lock-shift))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	67
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	68 ;;(defun coding-system-use-japanese-jisx0201-roman (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	69 ;; "Return the 'use-japanese-jisx0201-roman property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	70 ;; (coding-system-property coding-system 'use-japanese-jisx0201-roman))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	71
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	72 ;;(defun coding-system-use-japanese-jisx0208-1978 (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	73 ;; "Return the 'use-japanese-jisx0208-1978 property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	74 ;; (coding-system-property coding-system 'use-japanese-jisx0208-2978))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	75
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	76 (defun coding-system-no-iso6429 (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	77 "Return the 'no-iso6429 property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	78 (coding-system-property coding-system 'no-iso6429))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	79
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	80 (defun coding-system-ccl-encode (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	81 "Return the CCL 'encode property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	82 (coding-system-property coding-system 'encode))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	83
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	84 (defun coding-system-ccl-decode (coding-system)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	85 "Return the CCL 'decode property of CODING-SYSTEM."
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	86 (coding-system-property coding-system 'decode))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	87
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	88 (defun coding-system-iso2022-charset (coding-system register)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	89 "Return the charset initially designated to REGISTER in CODING-SYSTEM.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	90 The allowable range of REGISTER is 0 through 3."
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	91 (if (or (< register 0) (> register 3))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	92 (error 'args-out-of-range "coding-system-charset REGISTER" register 0 3))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	93 (coding-system-property coding-system (nth register '(charset-g0
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	94 charset-g1
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	95 charset-g2
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	96 charset-g3))))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	97
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	98
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	99 ;;;; Definitions of predefined coding systems
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	100
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	101 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	102 'ctext 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	103 "Compound Text"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	104 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	105 charset-g1 latin-iso8859-1
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	106 eol-type nil
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	107 safe-charsets t ;; Reasonable
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	108 mnemonic "CText"))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	109
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	110 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	111 'iso-2022-8bit-ss2 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	112 "ISO-2022 8-bit w/SS2"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	113 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	114 charset-g1 latin-iso8859-1
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	115 charset-g2 t ;; unspecified but can be used later.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	116 short t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	117 safe-charsets (ascii katakana-jisx0201 japanese-jisx0208-1978
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	118 japanese-jisx0208 japanese-jisx0212 japanese-jisx0213-1
1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	119 japanese-jisx0213-2)
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	120 mnemonic "ISO8/SS"
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	121 documentation "ISO 2022 based 8-bit encoding using SS2 for 96-charset"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	122 ))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	123
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	124 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	125 'iso-2022-7bit-ss2 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	126 "ISO-2022 7-bit w/SS2"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	127 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	128 charset-g2 t ;; unspecified but can be used later.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	129 seven t
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	130 short t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	131 safe-charsets t
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	132 mnemonic "ISO7/SS"
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	133 documentation "ISO 2022 based 7-bit encoding using SS2 for 96-charset"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	134 eol-type nil))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	135
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	136 ;; (copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2)
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	137 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	138 'iso-2022-jp-2 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	139 "ISO-2022-JP-2"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	140 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	141 charset-g2 t ;; unspecified but can be used later.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	142 seven t
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	143 short t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	144 safe-charsets t
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	145 mnemonic "ISO7/SS"
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	146 eol-type nil))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	147
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	148 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	149 'iso-2022-7bit 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	150 "ISO 2022 7-bit"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	151 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	152 seven t
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	153 short t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	154 safe-charsets t
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	155 mnemonic "ISO7"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	156 documentation "ISO-2022-based 7-bit encoding using only G0"
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	157 ))
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	158
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	159 ;; compatibility for old XEmacsen
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	160 (define-coding-system-alias 'iso-2022-7 'iso-2022-7bit)
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	161
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	162 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	163 'iso-2022-8 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	164 "ISO-2022 8-bit"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	165 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	166 charset-g1 latin-iso8859-1
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	167 short t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	168 safe-charsets t
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	169 mnemonic "ISO8"
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	170 documentation "ISO-2022 eight-bit coding system. No single-shift or locking-shift."
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	171 ))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	172
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	173 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	174 'escape-quoted 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	175 "Escape-Quoted (for .ELC files)"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	176 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	177 charset-g1 latin-iso8859-1
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	178 eol-type lf
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	179 escape-quoted t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	180 safe-charsets t
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	181 mnemonic "ESC/Quot"
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	182 documentation "ISO-2022 eight-bit coding system with escape quoting; used for .ELC files."
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	183 ))
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	184
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	185 (make-coding-system
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	186 'iso-2022-lock 'iso2022
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	187 "ISO-2022 w/locking-shift"
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	188 '(charset-g0 ascii
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	189 charset-g1 t ;; unspecified but can be used later.
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	190 seven t
4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	191 lock-shift t
4568 1d74a1d115ee Add #'query-coding-region tests; do the work necessary to get them running. Aidan Kehoe <kehoea@parhasard.net> parents: 4567 diff changeset	192 safe-charsets t
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	193 mnemonic "ISO7/Lock"
771 943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben] ben parents: 528 diff changeset	194 documentation "ISO-2022 coding system using Locking-Shift for 96-charset."
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	195 ))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	196
333 4f79e16b1112 Import from CVS: tag r21-0-64 cvs parents: diff changeset	197
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	198 ;; This is used by people writing CCL programs, but is called at runtime.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	199 (defun define-translation-hash-table (symbol table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	200 "Define SYMBOL as the name of the hash translation TABLE for use in CCL.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	201
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	202 Analogous to `define-translation-table', but updates
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	203 `translation-hash-table-vector' and the table is for use in the CCL
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	204 `lookup-integer' and `lookup-character' functions."
4145 edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	205 (check-argument-type #'symbolp symbol)
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	206 (check-argument-type #'hash-table-p table)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	207 (let ((len (length translation-hash-table-vector))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	208 (id 0)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	209 done)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	210 (put symbol 'translation-hash-table table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	211 (while (not done)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	212 (if (>= id len)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	213 (setq translation-hash-table-vector
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	214 (vconcat translation-hash-table-vector [nil])))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	215 (let ((slot (aref translation-hash-table-vector id)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	216 (if (or (not slot)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	217 (eq (car slot) symbol))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	218 (progn
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	219 (aset translation-hash-table-vector id (cons symbol table))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	220 (setq done t))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	221 (setq id (1+ id)))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	222 (put symbol 'translation-hash-table-id id)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	223 id))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	224
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	225 (defvar make-8-bit-private-use-start (decode-char 'ucs #xE000)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	226 "Start of a 256 code private use area for make-8-bit-coding-system.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	227
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	228 This is used to ensure that distinct octets on disk for a given coding
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	229 system map to distinct XEmacs characters, preventing a spurious changes when
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	230 a file is read, not changed, and then written. ")
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	231
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	232 (defun make-8-bit-generate-helper (decode-table encode-table
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	233 encode-failure-octet)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	234 "Helper function, `make-8-bit-generate-encode-program-and-skip-chars-strings',
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	235 which see.
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	236
4145 edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	237 Deals with the case where ASCII and another character set can both be
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	238 encoded unambiguously and completely into the coding-system; if this is so,
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	239 returns a list comprised of such a ccl-program and the character set in
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	240 question. If not, it returns a list with both entries nil."
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	241 (let ((tentative-encode-program-parts
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	242 (eval-when-compile
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	243 (let* ((vec-len 128)
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	244 (compiled
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	245 (append
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	246 (ccl-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	247 `(1
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	248 (loop
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	249 (read-multibyte-character r0 r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	250 (if (r0 == ,(charset-id 'ascii))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	251 (write r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	252 ((if (r0 == #xABAB)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	253 ;; #xBFFE is a sentinel in the compiled
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	254 ;; program.
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	255 ((r0 = r1 & #x7F)
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	256 (write r0 ,(make-vector vec-len #xBFFE)))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	257 ((mule-to-unicode r0 r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	258 (if (r0 == #xFFFD)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	259 (write #xBEEF)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	260 ((lookup-integer encode-table-sym r0 r3)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	261 (if r7
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	262 (write-multibyte-character r0 r3)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	263 (write #xBEEF))))))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	264 (repeat)))) nil))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	265 (first-part compiled)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	266 (last-part
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	267 (member-if-not (lambda (entr) (eq #xBFFE entr))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	268 (member-if
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	269 (lambda (entr) (eq #xBFFE entr))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	270 first-part))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	271 (while compiled
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	272 (when (eq #xBFFE (cadr compiled))
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	273 (assert (= vec-len (search '(#xBFFE) (cdr compiled)
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	274 :test #'/=)) nil
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	275 "Strange ccl vector length")
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	276 (setcdr compiled nil))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	277 (setq compiled (cdr compiled)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	278 ;; Is the generated code as we expect it to be?
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	279 (assert (and (memq #xABAB first-part)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	280 (memq #xBEEF14 last-part))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	281 nil
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	282 "This code assumes that the constant #xBEEF is #xBEEF14 in \
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	283 compiled CCL code,\nand that the constant #xABAB is #xABAB. If that is
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	284 not the case, and it appears not to be--that's why you're getting this
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	285 message--it will not work. ")
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	286 (list first-part last-part vec-len))))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	287 (charset-lower -1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	288 (charset-upper -1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	289 worth-trying known-charsets encode-program
4605 c786c3fd0740 Listen to the byte-compiler, core Lisp. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	290 other-charset-vector ucs)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	291
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	292 (loop for char across decode-table
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	293 do (pushnew (char-charset char) known-charsets))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	294 (setq known-charsets (delq 'ascii known-charsets))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	295
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	296 (loop for known-charset in known-charsets
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	297 do
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	298 ;; This is not possible for two dimensional charsets.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	299 (when (eq 1 (charset-dimension known-charset))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	300 (if (eq 'control-1 known-charset)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	301 (setq charset-lower 0
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	302 charset-upper 31)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	303 ;; There should be a nicer way to get the limits here.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	304 (condition-case args-out-of-range
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	305 (make-char known-charset #x100)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	306 (args-out-of-range
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	307 (setq charset-lower (third args-out-of-range)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	308 charset-upper (fourth args-out-of-range)))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	309 (loop
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	310 for i from charset-lower to charset-upper
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	311 always (and (setq ucs
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	312 (encode-char (make-char known-charset i) 'ucs))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	313 (gethash ucs encode-table))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	314 finally (setq worth-trying known-charset))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	315
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	316 ;; Only trying this for one charset at a time, the first find.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	317 (when worth-trying (return))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	318
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	319 ;; Okay, this charset is not worth trying, Try the next.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	320 (setq charset-lower -1
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	321 charset-upper -1
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	322 worth-trying nil)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	323
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	324 (when worth-trying
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	325 (setq other-charset-vector
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	326 (make-vector (third tentative-encode-program-parts)
eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	327 encode-failure-octet))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	328 (loop for i from charset-lower to charset-upper
4090 751ae075e76e [xemacs-hg @ 2007-08-01 13:53:32 by aidan] aidan parents: 4085 diff changeset	329 do (aset other-charset-vector i
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	330 (gethash (encode-char (make-char worth-trying i)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	331 'ucs) encode-table)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	332 (setq encode-program
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	333 (nsublis
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	334 (list (cons #xABAB (charset-id worth-trying)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	335 (nconc
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	336 (copy-list (first
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	337 tentative-encode-program-parts))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	338 (append other-charset-vector nil)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	339 (copy-tree (second
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	340 tentative-encode-program-parts))))))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	341 (values encode-program worth-trying)))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	342
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	343 (defun make-8-bit-generate-encode-program-and-skip-chars-strings
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	344 (decode-table encode-table encode-failure-octet)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	345 "Generate a CCL program to encode a 8-bit fixed-width charset.
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	346
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	347 DECODE-TABLE must have 256 non-cons entries, and will be regarded as
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	348 describing a map from the octet corresponding to an offset in the
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	349 table to the that entry in the table. ENCODE-TABLE is a hash table
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	350 map from unicode values to characters in the range [0,255].
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	351 ENCODE-FAILURE-OCTET describes an integer between 0 and 255
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	352 \(inclusive) to write in the event that a character cannot be encoded. "
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	353 (check-argument-type #'vectorp decode-table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	354 (check-argument-range (length decode-table) #x100 #x100)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	355 (check-argument-type #'hash-table-p encode-table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	356 (check-argument-type #'integerp encode-failure-octet)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	357 (check-argument-range encode-failure-octet #x00 #xFF)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	358 (let ((encode-program nil)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	359 (general-encode-program
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	360 (eval-when-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	361 (let ((prog (append
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	362 (ccl-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	363 `(1
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	364 (loop
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	365 (read-multibyte-character r0 r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	366 (mule-to-unicode r0 r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	367 (if (r0 == #xFFFD)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	368 (write #xBEEF)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	369 ((lookup-integer encode-table-sym r0 r3)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	370 (if r7
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	371 (write-multibyte-character r0 r3)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	372 (write #xBEEF))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	373 (repeat)))) nil)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	374 (assert (memq #xBEEF14 prog)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	375 nil
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	376 "This code assumes that the constant #xBEEF is #xBEEF14 \
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	377 in compiled CCL code.\nIf that is not the case, and it appears not to
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	378 be--that's why you're getting this message--it will not work. ")
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	379 prog)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	380 (encode-program-with-ascii-optimisation
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	381 (eval-when-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	382 (let ((prog (append
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	383 (ccl-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	384 `(1
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	385 (loop
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	386 (read-multibyte-character r0 r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	387 (if (r0 == ,(charset-id 'ascii))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	388 (write r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	389 ((mule-to-unicode r0 r1)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	390 (if (r0 == #xFFFD)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	391 (write #xBEEF)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	392 ((lookup-integer encode-table-sym r0 r3)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	393 (if r7
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	394 (write-multibyte-character r0 r3)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	395 (write #xBEEF))))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	396 (repeat)))) nil)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	397 (assert (memq #xBEEF14 prog)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	398 nil
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	399 "This code assumes that the constant #xBEEF is #xBEEF14 \
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	400 in compiled CCL code.\nIf that is not the case, and it appears not to
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	401 be--that's why you're getting this message--it will not work. ")
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	402 prog)))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	403 (ascii-encodes-as-itself nil)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	404 (control-1-encodes-as-itself t)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	405 (invalid-sequence-code-point-start
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	406 (eval-when-compile
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	407 (char-to-unicode
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	408 (aref (decode-coding-string "\xd8\x00\x00\x00" 'utf-16-be) 3))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	409 further-char-set skip-chars invalid-sequences-skip-chars)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	410
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	411 ;; Is this coding system ASCII-compatible? If so, we can avoid the hash
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	412 ;; table lookup for those characters.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	413 (loop
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	414 for i from #x00 to #x7f
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	415 always (eq (int-to-char i) (gethash i encode-table))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	416 finally (setq ascii-encodes-as-itself t))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	417
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	418 ;; Note that this logic handles EBCDIC badly. For example, CP037,
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	419 ;; MIME name ebcdic-na, has the entire repertoire of ASCII and
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	420 ;; Latin 1, and thus a more optimal ccl encode program would check
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	421 ;; for those character sets and use tables. But for now, we do a
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	422 ;; hash table lookup for every character.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	423 (if (null ascii-encodes-as-itself)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	424 ;; General encode program. Pros; general and correct. Cons;
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	425 ;; slow, a hash table lookup + mule-unicode conversion is done
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	426 ;; for every character encoding.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	427 (setq encode-program general-encode-program)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	428 (multiple-value-setq
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	429 (encode-program further-char-set)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	430 ;; Encode program with ascii-ascii mapping (based on a
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	431 ;; character's mule character set), and one other mule
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	432 ;; character set using table-based encoding, other
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	433 ;; character sets using hash table lookups.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	434 ;; make-8-bit-non-ascii-completely-coveredp only returns
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	435 ;; such a mapping if some non-ASCII charset with
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	436 ;; characters in decode-table is entirely covered by
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	437 ;; encode-table.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	438 (make-8-bit-generate-helper decode-table encode-table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	439 encode-failure-octet))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	440 (unless encode-program
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	441 ;; If make-8-bit-non-ascii-completely-coveredp returned nil,
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	442 ;; but ASCII still encodes as itself, do one-to-one mapping
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	443 ;; for ASCII, and a hash table lookup for everything else.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	444 (setq encode-program encode-program-with-ascii-optimisation)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	445
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	446 (setq encode-program
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	447 (nsublis
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	448 (list (cons #xBEEF14
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	449 (logior (lsh encode-failure-octet 8)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	450 #x14)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	451 (copy-tree encode-program)))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	452 (loop
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	453 for i from #x80 to #x9f
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	454 do (unless (= i (aref decode-table i))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	455 (setq control-1-encodes-as-itself nil)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	456 (return)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	457 (loop
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	458 for i from #x00 to #xFF
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	459 initially (setq skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	460 (cond
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	461 ((and ascii-encodes-as-itself
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	462 control-1-encodes-as-itself further-char-set)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	463 (concat "\x00-\x9f" (charset-skip-chars-string
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	464 further-char-set)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	465 ((and ascii-encodes-as-itself
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	466 control-1-encodes-as-itself)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	467 "\x00-\x9f")
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	468 ((null ascii-encodes-as-itself)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	469 (skip-chars-quote (apply #'string
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	470 (append decode-table nil))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	471 (further-char-set
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	472 (concat (charset-skip-chars-string 'ascii)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	473 (charset-skip-chars-string further-char-set)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	474 (t
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	475 (charset-skip-chars-string 'ascii)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	476 invalid-sequences-skip-chars "")
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	477 with decoded-ucs = nil
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	478 with decoded = nil
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	479 with no-ascii-transparency-skip-chars-list =
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	480 (unless ascii-encodes-as-itself (append decode-table nil))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	481 ;; Can't use #'match-string here, see:
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	482 ;; http://mid.gmane.org/18829.34118.709782.704574@parhasard.net
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	483 with skip-chars-test =
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	484 #'(lambda (skip-chars-string testing)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	485 (with-temp-buffer
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	486 (insert testing)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	487 (goto-char (point-min))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	488 (skip-chars-forward skip-chars-string)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	489 (= (point) (point-max))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	490 do
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	491 (setq decoded (aref decode-table i)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	492 decoded-ucs (char-to-unicode decoded))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	493 (cond
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	494 ((<= invalid-sequence-code-point-start decoded-ucs
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	495 (+ invalid-sequence-code-point-start #xFF))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	496 (setq invalid-sequences-skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	497 (concat (string decoded)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	498 invalid-sequences-skip-chars))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	499 (assert (not (funcall skip-chars-test skip-chars decoded))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	500 "This char should only be skipped with \
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	501 `invalid-sequences-skip-chars', not by `skip-chars'"))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	502 ((not (funcall skip-chars-test skip-chars decoded))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	503 (if ascii-encodes-as-itself
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	504 (setq skip-chars (concat skip-chars (string decoded)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	505 (push decoded no-ascii-transparency-skip-chars-list))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	506 finally (unless ascii-encodes-as-itself
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	507 (setq skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	508 (skip-chars-quote
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	509 (apply #'string
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	510 no-ascii-transparency-skip-chars-list)))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	511 (values encode-program skip-chars invalid-sequences-skip-chars)))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	512
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	513 (defun make-8-bit-create-decode-encode-tables (unicode-map)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	514 "Return a list \(DECODE-TABLE ENCODE-TABLE) given UNICODE-MAP.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	515 UNICODE-MAP should be an alist mapping from integer octet values to
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	516 characters with UCS code points; DECODE-TABLE will be a 256-element
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	517 vector, and ENCODE-TABLE will be a hash table mapping from 256 numbers
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	518 to 256 distinct characters. "
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	519 (check-argument-type #'listp unicode-map)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	520 (let ((decode-table (make-vector 256 nil))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	521 (encode-table (make-hash-table :size 256))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	522 (private-use-start (encode-char make-8-bit-private-use-start 'ucs))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	523 (invalid-sequence-code-point-start
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	524 (eval-when-compile
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	525 (char-to-unicode
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	526 (aref (decode-coding-string "\xd8\x00\x00\x00" 'utf-16-be) 3))))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	527 desired-ucs decode-table-entry)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	528
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	529 (loop for (external internal)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	530 in unicode-map
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	531 do
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	532 (aset decode-table external internal)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	533 (assert (not (eq (encode-char internal 'ucs) -1))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	534 nil
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	535 "Looks like you're calling make-8-bit-coding-system in a \
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	536 dumped file, \nand you're either not providing a literal UNICODE-MAP
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	537 or PROPS. Don't do that; make-8-bit-coding-system relies on sensible
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	538 Unicode mappings being available, which they are at compile time for
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	539 dumped files (but this requires the mentioned literals), but not, for
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	540 most of them, at run time. ")
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	541
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	542 (puthash (encode-char internal 'ucs)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	543 ;; This is semantically an integer, but Dave Love's design
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	544 ;; for lookup-integer in CCL means we need to store it as a
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	545 ;; character.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	546 (int-to-char external)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	547 encode-table))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	548
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	549 ;; Now, go through the decode table. For octet values above #x7f, if the
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	550 ;; decode table entry is nil, this means that they have an undefined
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	551 ;; mapping (= they map to XEmacs characters with keys in
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	552 ;; unicode-error-default-translation-table); for octet values below or
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	553 ;; equal to #x7f, it means that they map to ASCII.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	554
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	555 ;; If any entry (whether below or above #x7f) in the decode-table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	556 ;; already maps to some character with a key in
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	557 ;; unicode-error-default-translation-table, it is treated as an
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	558 ;; undefined octet by `query-coding-region'. That is, it is not
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	559 ;; necessary for an octet value to be above #x7f for this to happen.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	560
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	561 (dotimes (i 256)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	562 (setq decode-table-entry (aref decode-table i))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	563 (if decode-table-entry
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	564 (when (get-char-table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	565 decode-table-entry
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	566 unicode-error-default-translation-table)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	567 ;; The caller is explicitly specifying that this octet
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	568 ;; corresponds to an invalid sequence on disk:
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	569 (assert (= (get-char-table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	570 decode-table-entry
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	571 unicode-error-default-translation-table) i)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	572 "Bad argument to `make-8-bit-coding-system'.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	573 If you're going to designate an octet with value below #x80 as invalid
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	574 for this coding system, make sure to map it to the invalid sequence
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	575 character corresponding to its octet value on disk. "))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	576
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	577 ;; decode-table-entry is nil; either the octet is to be treated as
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	578 ;; contributing to an error sequence (when (> #x7f i)), or it should
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	579 ;; be attempted to treat it as ASCII-equivalent.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	580 (setq desired-ucs (or (and (< i #x80) i)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	581 (+ invalid-sequence-code-point-start i)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	582 (while (gethash desired-ucs encode-table)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	583 (assert (not (< i #x80))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	584 "UCS code point should not already be in encode-table!"
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	585 ;; There is one invalid sequence char per octet value;
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	586 ;; with eight-bit-fixed coding systems, it makes no sense
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	587 ;; for us to be multiply allocating them.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	588 (gethash desired-ucs encode-table))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	589 (setq desired-ucs (+ private-use-start desired-ucs)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	590 private-use-start (+ private-use-start 1)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	591 (puthash desired-ucs (int-to-char i) encode-table)
4085 023ebc75c06e [xemacs-hg @ 2007-07-28 09:32:26 by aidan] aidan parents: 4080 diff changeset	592 (setq desired-ucs (if (> desired-ucs #xFF)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	593 (unicode-to-char desired-ucs)
4085 023ebc75c06e [xemacs-hg @ 2007-07-28 09:32:26 by aidan] aidan parents: 4080 diff changeset	594 ;; So we get Latin-1 when run at dump time,
023ebc75c06e [xemacs-hg @ 2007-07-28 09:32:26 by aidan] aidan parents: 4080 diff changeset	595 ;; instead of JIT-allocated characters.
023ebc75c06e [xemacs-hg @ 2007-07-28 09:32:26 by aidan] aidan parents: 4080 diff changeset	596 (int-to-char desired-ucs)))
023ebc75c06e [xemacs-hg @ 2007-07-28 09:32:26 by aidan] aidan parents: 4080 diff changeset	597 (aset decode-table i desired-ucs)))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	598 (values decode-table encode-table)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	599
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	600 (defun make-8-bit-generate-decode-program (decode-table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	601 "Given DECODE-TABLE, generate a CCL program to decode an 8-bit charset.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	602 DECODE-TABLE must have 256 non-cons entries, and will be regarded as
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	603 describing a map from the octet corresponding to an offset in the
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	604 table to the that entry in the table. "
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	605 (check-argument-type #'vectorp decode-table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	606 (check-argument-range (length decode-table) #x100 #x100)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	607 (let ((decode-program-parts
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	608 (eval-when-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	609 (let* ((compiled
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	610 (append
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	611 (ccl-compile
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	612 `(3
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	613 ((read r0)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	614 (loop
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	615 (write-read-repeat r0 ,(make-vector
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	616 256 'sentinel)))))) nil))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	617 (first-part compiled)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	618 (last-part
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	619 (member-if-not #'symbolp
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	620 (member-if-not #'integerp first-part))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	621 ;; Chop off the sentinel sentinel sentinel [..] part.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	622 (while compiled
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	623 (if (symbolp (cadr compiled))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	624 (setcdr compiled nil))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	625 (setq compiled (cdr compiled)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	626 (list first-part last-part)))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	627 (nconc
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	628 ;; copy-list needed, because the structure of the literal provided
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	629 ;; by our eval-when-compile hangs around.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	630 (copy-list (first decode-program-parts))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	631 (append decode-table nil)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	632 (second decode-program-parts))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	633
4145 edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	634 (defun make-8-bit-choose-category (decode-table)
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	635 "Given DECODE-TABLE, return an appropriate coding category.
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	636 DECODE-TABLE is a 256-entry vector describing the mapping from octets on
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	637 disk to XEmacs characters for some fixed-width 8-bit coding system. "
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	638 (check-argument-type #'vectorp decode-table)
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	639 (check-argument-range (length decode-table) #x100 #x100)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	640 (loop
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	641 named category
4559 bd1a68c34d44 Merge my change of 2008-05-14 to the query-coding-region code. Aidan Kehoe <kehoea@parhasard.net> parents: 4558 diff changeset	642 for i from #x80 to #x9F
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	643 do (unless (= i (aref decode-table i))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	644 (return-from category 'no-conversion))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	645 finally return 'iso-8-1))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	646
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	647 (defun 8-bit-fixed-query-coding-region (begin end coding-system &optional
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	648 buffer ignore-invalid-sequencesp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	649 errorp highlightp)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	650 "The `query-coding-region' implementation for 8-bit-fixed coding systems.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	651
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	652 Uses the `8-bit-fixed-query-from-unicode' and `8-bit-fixed-query-skip-chars'
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	653 coding system properties. The former is a hash table mapping from valid
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	654 Unicode code points to on-disk octets in the coding system; the latter a set
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	655 of characters as used by `skip-chars-forward'. Both of these properties are
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	656 generated automatically by `make-8-bit-coding-system'.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	657
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	658 See that the documentation of `query-coding-region'; see also
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	659 `make-8-bit-coding-system'. "
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	660 (check-argument-type #'coding-system-p
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	661 (setq coding-system (find-coding-system coding-system)))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	662 (check-argument-type #'integer-or-marker-p begin)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	663 (check-argument-type #'integer-or-marker-p end)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	664 (let ((from-unicode
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	665 (or (coding-system-get coding-system '8-bit-fixed-query-from-unicode)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	666 (coding-system-get (coding-system-base coding-system)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	667 '8-bit-fixed-query-from-unicode)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	668 (skip-chars-arg
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	669 (or (coding-system-get coding-system '8-bit-fixed-query-skip-chars)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	670 (coding-system-get (coding-system-base coding-system)
6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	671 '8-bit-fixed-query-skip-chars)))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	672 (invalid-sequences-skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	673 (or (coding-system-get coding-system
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	674 '8-bit-fixed-invalid-sequences-skip-chars)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	675 (coding-system-get (coding-system-base coding-system)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	676 '8-bit-fixed-invalid-sequences-skip-chars)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	677 (ranges (make-range-table))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	678 (case-fold-search nil)
4605 c786c3fd0740 Listen to the byte-compiler, core Lisp. Aidan Kehoe <kehoea@parhasard.net> parents: 4604 diff changeset	679 char-after fail-range-start fail-range-end extent
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	680 failed invalid-sequences-looking-at failed-reason
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	681 previous-failed-reason)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	682 (check-type from-unicode hash-table)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	683 (check-type skip-chars-arg string)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	684 (check-type invalid-sequences-skip-chars string)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	685 (setq invalid-sequences-looking-at
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	686 (if (equal "" invalid-sequences-skip-chars)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	687 ;; Regexp that will never match.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	688 #r".\{0,0\}"
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	689 (concat "[" invalid-sequences-skip-chars "]")))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	690 (when ignore-invalid-sequencesp
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	691 (setq skip-chars-arg
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	692 (concat skip-chars-arg invalid-sequences-skip-chars)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	693 (save-excursion
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	694 (when highlightp
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	695 (query-coding-clear-highlights begin end buffer))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	696 (goto-char begin buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	697 (skip-chars-forward skip-chars-arg end buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	698 (while (< (point buffer) end)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	699 (setq char-after (char-after (point buffer) buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	700 fail-range-start (point buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	701 (while (and
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	702 (< (point buffer) end)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	703 (or (and
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	704 (not (gethash (encode-char char-after 'ucs) from-unicode))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	705 (setq failed-reason 'unencodable))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	706 (and (not ignore-invalid-sequencesp)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	707 (looking-at invalid-sequences-looking-at buffer)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	708 (setq failed-reason 'invalid-sequence)))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	709 (or (null previous-failed-reason)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	710 (eq previous-failed-reason failed-reason)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	711 (forward-char 1 buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	712 (setq char-after (char-after (point buffer) buffer)
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	713 failed t
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	714 previous-failed-reason failed-reason))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	715 (if (= fail-range-start (point buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	716 ;; The character can actually be encoded by the coding
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	717 ;; system; check the characters past it.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	718 (forward-char 1 buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	719 ;; The character actually failed.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	720 (when errorp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	721 (error 'text-conversion-error
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	722 (format "Cannot encode %s using coding system"
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	723 (buffer-substring fail-range-start (point buffer)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	724 buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	725 (coding-system-name coding-system)))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	726 (assert (not (null previous-failed-reason)) t
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	727 "previous-failed-reason should always be non-nil here")
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	728 (put-range-table fail-range-start
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	729 ;; If char-after is non-nil, we're not at
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	730 ;; the end of the buffer.
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	731 (setq fail-range-end (if char-after
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	732 (point buffer)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	733 (point-max buffer)))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	734 previous-failed-reason ranges)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	735 (setq previous-failed-reason nil)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	736 (when highlightp
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	737 (setq extent (make-extent fail-range-start fail-range-end buffer))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	738 (set-extent-priority extent (+ mouse-highlight-priority 2))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	739 (set-extent-face extent 'query-coding-warning-face))
4551 6812571bfcb9 Fix some bugs. Aidan Kehoe <kehoea@parhasard.net> parents: 4549 diff changeset	740 (skip-chars-forward skip-chars-arg end buffer)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	741 (if failed
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	742 (values nil ranges)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	743 (values t nil)))))
4145 edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	744
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	745 (defun make-8-bit-coding-system (name unicode-map &optional description props)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	746 "Make and return a fixed-width 8-bit CCL coding system named NAME.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	747 NAME must be a symbol, and UNICODE-MAP a list.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	748
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	749 UNICODE-MAP is a plist describing a map from octets in the coding
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	750 system NAME (as integers) to XEmacs characters. Those XEmacs
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	751 characters will be used explicitly on decoding, but for encoding (most
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	752 relevantly, on writing to disk) XEmacs characters that map to the same
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	753 Unicode code point will be unified. This means that the ISO-8859-?
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	754 characters that map to the same Unicode code point will not be
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	755 distinct when written to disk, which is normally what is intended; it
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	756 also means that East Asian Han characters from different XEmacs
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	757 character sets will not be distinct when written to disk, which is
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	758 less often what is intended.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	759
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	760 Any octets not mapped, and with values above #x7f, will be decoded into
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	761 XEmacs characters that reflect that their values are undefined. These
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	762 characters will be displayed in a language-environment-specific way. See
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	763 `unicode-error-default-translation-table' and the
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	764 `invalid-sequence-coding-system' argument to `set-language-info'.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	765
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	766 These characters will normally be treated as invalid when checking whether
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	767 text can be encoded with `query-coding-region'--see the
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	768 IGNORE-INVALID-SEQUENCESP argument to that function to avoid this. It is
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	769 possible to specify that octets with values less than #x80 (or indeed
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	770 greater than it) be treated in this way, by specifying explicitly that they
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	771 correspond to the character mapping to that octet in
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	772 `unicode-error-default-translation-table'. Far fewer coding systems
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	773 override the ASCII mapping, though, so this is not the default.
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	774
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	775 DESCRIPTION and PROPS are as in `make-coding-system', which see. This
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	776 function also accepts two additional (optional) properties in PROPS;
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	777 `aliases', giving a list of aliases to be initialized for this
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	778 coding-system, and `encode-failure-octet', an integer between 0 and 256 to
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	779 write in place of XEmacs characters that cannot be encoded, defaulting to
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	780 the code for tilde `~'. "
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	781 (check-argument-type #'symbolp name)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	782 (check-argument-type #'listp unicode-map)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	783 (check-argument-type #'stringp
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	784 (or description
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	785 (setq description
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	786 (format "Coding system used for %s." name))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	787 (check-valid-plist props)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	788 (let ((encode-failure-octet (or (plist-get props 'encode-failure-octet)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	789 (char-to-int ?~)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	790 (aliases (plist-get props 'aliases))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	791 (hash-table-sym (gentemp (format "%s-encode-table" name)))
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	792 encode-program decode-program result decode-table encode-table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	793 skip-chars invalid-sequences-skip-chars)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	794
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	795 ;; Some more sanity checking.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	796 (check-argument-range encode-failure-octet 0 #xFF)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	797 (check-argument-type #'listp aliases)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	798
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	799 ;; Don't pass on our extra data to make-coding-system.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	800 (setq props (plist-remprop props 'encode-failure-octet)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	801 props (plist-remprop props 'aliases))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	802
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	803 (multiple-value-setq
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	804 (decode-table encode-table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	805 (make-8-bit-create-decode-encode-tables unicode-map))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	806
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	807 ;; Register the decode-table.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	808 (define-translation-hash-table hash-table-sym encode-table)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	809
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	810 ;; Generate the programs and skip-chars strings.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	811 (setq decode-program (make-8-bit-generate-decode-program decode-table))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	812 (multiple-value-setq
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	813 (encode-program skip-chars invalid-sequences-skip-chars)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	814 (make-8-bit-generate-encode-program-and-skip-chars-strings
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	815 decode-table encode-table encode-failure-octet))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	816
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	817 (unless (vectorp encode-program)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	818 (setq encode-program
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	819 (apply #'vector
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	820 (nsublis (list (cons 'encode-table-sym hash-table-sym))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	821 (copy-tree encode-program)))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	822 (unless (vectorp decode-program)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	823 (setq decode-program
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	824 (apply #'vector decode-program)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	825
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	826 ;; And now generate the actual coding system.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	827 (setq result
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	828 (make-coding-system
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	829 name 'ccl
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	830 description
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	831 (plist-put (plist-put props 'decode decode-program)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	832 'encode encode-program)))
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	833 (coding-system-put name '8-bit-fixed t)
4145 edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	834 (coding-system-put name 'category
edb00a8b4eff [xemacs-hg @ 2007-08-26 20:00:29 by aidan] aidan parents: 4103 diff changeset	835 (make-8-bit-choose-category decode-table))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	836 (coding-system-put name '8-bit-fixed-query-skip-chars
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	837 skip-chars)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	838 (coding-system-put name '8-bit-fixed-invalid-sequences-skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	839 invalid-sequences-skip-chars)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	840 (coding-system-put name '8-bit-fixed-query-from-unicode encode-table)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	841 (coding-system-put name 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	842 #'8-bit-fixed-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	843 (coding-system-put (intern (format "%s-unix" name))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	844 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	845 #'8-bit-fixed-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	846 (coding-system-put (intern (format "%s-dos" name))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	847 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	848 #'8-bit-fixed-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	849 (coding-system-put (intern (format "%s-mac" name))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	850 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	851 #'8-bit-fixed-query-coding-region)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	852 (loop for alias in aliases
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	853 do (define-coding-system-alias alias name))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	854 result))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	855
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	856 (define-compiler-macro make-8-bit-coding-system (&whole form name unicode-map
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	857 &optional description props)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	858 ;; We provide the compiler macro (= macro that is expanded only on
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	859 ;; compilation, and that can punt to a runtime version of the
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	860 ;; associate function if necessary) not for reasons of speed, though
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	861 ;; it does speed up things at runtime a little, but because the
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	862 ;; Unicode mappings are available at compile time in the dumped
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	863 ;; files, but they are not available at run time for the vast
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	864 ;; majority of them.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	865
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	866 (if (not (and (and (consp name) (eq (car name) 'quote))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	867 (and (consp unicode-map) (eq (car unicode-map) 'quote))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	868 (and (or (and (consp props) (eq (car props) 'quote))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	869 (null props)))))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	870 ;; The call does not use literals; do it at runtime.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	871 form
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	872 (setq name (cadr name)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	873 unicode-map (cadr unicode-map)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	874 props (if props (cadr props)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	875 (let ((encode-failure-octet
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	876 (or (plist-get props 'encode-failure-octet) (char-to-int ?~)))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	877 (aliases (plist-get props 'aliases))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	878 encode-program decode-program
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	879 decode-table encode-table
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	880 skip-chars invalid-sequences-skip-chars)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	881
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	882 ;; Some sanity checking.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	883 (check-argument-range encode-failure-octet 0 #xFF)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	884 (check-argument-type #'listp aliases)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	885
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	886 ;; Don't pass on our extra data to make-coding-system.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	887 (setq props (plist-remprop props 'encode-failure-octet)
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	888 props (plist-remprop props 'aliases))
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	889
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	890 ;; Work out encode-table and decode-table
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	891 (multiple-value-setq
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	892 (decode-table encode-table)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	893 (make-8-bit-create-decode-encode-tables unicode-map))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	894
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	895 ;; Generate the decode and encode programs, and the skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	896 ;; arguments.
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	897 (setq decode-program (make-8-bit-generate-decode-program decode-table))
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	898 (multiple-value-setq
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	899 (encode-program skip-chars invalid-sequences-skip-chars)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	900 (make-8-bit-generate-encode-program-and-skip-chars-strings
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	901 decode-table encode-table encode-failure-octet))
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	902
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	903 ;; And return the generated code.
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	904 `(let ((encode-table-sym (gentemp (format "%s-encode-table" ',name)))
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	905 (encode-table ,encode-table))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	906 (define-translation-hash-table encode-table-sym encode-table)
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	907 (make-coding-system
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	908 ',name 'ccl ,description
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	909 (plist-put (plist-put ',props 'decode
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	910 ,(apply #'vector decode-program))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	911 'encode
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	912 (apply #'vector
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	913 (nsublis
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	914 (list (cons
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	915 'encode-table-sym
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	916 (symbol-value 'encode-table-sym)))
b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	917 ',encode-program))))
4295 eded49463f9a [xemacs-hg @ 2007-11-29 13:37:51 by aidan] aidan parents: 4145 diff changeset	918 (coding-system-put ',name '8-bit-fixed t)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	919 (coding-system-put ',name 'category
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	920 ',(make-8-bit-choose-category decode-table))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	921 (coding-system-put ',name '8-bit-fixed-query-skip-chars
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	922 ,skip-chars)
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	923 (coding-system-put ',name '8-bit-fixed-invalid-sequences-skip-chars
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	924 ,invalid-sequences-skip-chars)
4549 68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	925 (coding-system-put ',name '8-bit-fixed-query-from-unicode encode-table)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	926 (coding-system-put ',name 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	927 #'8-bit-fixed-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	928 (coding-system-put ',(intern (format "%s-unix" name))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	929 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	930 #'8-bit-fixed-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	931 (coding-system-put ',(intern (format "%s-dos" name))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	932 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	933 #'8-bit-fixed-query-coding-region)
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	934 (coding-system-put ',(intern (format "%s-mac" name))
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	935 'query-coding-function
68d1ca56cffa First part of interactive checks that coding systems encode regions. Aidan Kehoe <kehoea@parhasard.net> parents: 4299 diff changeset	936 #'8-bit-fixed-query-coding-region)
4072 aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	937 ,(macroexpand `(loop for alias in ',aliases
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	938 do (define-coding-system-alias alias
aa28d959af41 [xemacs-hg @ 2007-07-22 22:03:29 by aidan] aidan parents: 771 diff changeset	939 ',name)))
4103 b4f4e0cc90f1 [xemacs-hg @ 2007-08-07 23:08:47 by aidan] aidan parents: 4090 diff changeset	940 (find-coding-system ',name)))))
4299 f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	941
f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	942 ;; Ideally this would be in latin.el, but code-init.el uses it.
f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	943 (make-8-bit-coding-system
f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	944 'iso-8859-1
4604 e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	945 (loop
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	946 for i from #x80 to #xff
e0a8715fdb1f Support new IGNORE-INVALID-SEQUENCESP argument, #'query-coding-region. Aidan Kehoe <kehoea@parhasard.net> parents: 4568 diff changeset	947 collect (list i (int-char i))) ;; Identical to Latin-1.
4299 f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	948 "ISO-8859-1 (Latin-1)"
f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	949 '(mnemonic "Latin 1"
f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	950 documentation "The most used encoding of Western Europe and the Americas."
f4c3ffe60a4f [xemacs-hg @ 2007-12-01 14:24:46 by aidan] aidan parents: 4295 diff changeset	951 aliases (iso-latin-1 latin-1)))

Mercurial > hg > xemacs-beta

annotate lisp/mule/mule-coding.el @ 4614:afbfad080ddd