Mercurial > hg > xemacs-beta

comparison lisp/mule/make-coding-system.el @ 5128:7be849cb8828 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sun, 07 Mar 2010 02:09:59 -0600
parents 88f955fa5a7f
children 311f6817efc2 308d34e9f07d
comparison
equal deleted inserted replaced
5127:a9c41067dd88 5128:7be849cb8828
1 ;;; make-coding-system.el; Provides the #'make-coding-system function and 1 ;;; make-coding-system.el; Provides the #'make-coding-system function and
2 ;;; much of the implementation of the fixed-width coding system type. 2 ;;; much of the implementation of the fixed-width coding system type.
3 3
4 ;; Copyright (C) 2009 Free Software Foundation 4 ;; Copyright (C) 2009 Free Software Foundation
5 ;; Copyright (C) 2010 Ben Wing.
6 5
7 ;; Author: Aidan Kehoe 6 ;; Author: Aidan Kehoe
8 7
9 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
10 9
24 ;; Boston, MA 02110-1301, USA. 23 ;; Boston, MA 02110-1301, USA.
25 24
26 ;;; Commentary: 25 ;;; Commentary:
27 26
28 ;;; Code: 27 ;;; Code:
28
29 (defvar fixed-width-private-use-start ?\uE000
30 "Start of a 256 code private use area for fixed-width coding systems.
31
32 This is used to ensure that distinct octets on disk for a given coding
33 system map to distinct XEmacs characters, preventing spurious changes when
34 a file is read, not changed, and then written. ")
29 35
30 (defun fixed-width-generate-helper (decode-table encode-table 36 (defun fixed-width-generate-helper (decode-table encode-table
31 encode-failure-octet) 37 encode-failure-octet)
32 "Helper func, `fixed-width-generate-encode-program-and-skip-chars-strings', 38 "Helper func, `fixed-width-generate-encode-program-and-skip-chars-strings',
33 which see. 39 which see.
315 vector, and ENCODE-TABLE will be a hash table mapping from 256 numbers 321 vector, and ENCODE-TABLE will be a hash table mapping from 256 numbers
316 to 256 distinct characters." 322 to 256 distinct characters."
317 (check-argument-type #'listp unicode-map) 323 (check-argument-type #'listp unicode-map)
318 (let ((decode-table (make-vector 256 nil)) 324 (let ((decode-table (make-vector 256 nil))
319 (encode-table (make-hash-table :size 256 :rehash-threshold 0.999)) 325 (encode-table (make-hash-table :size 256 :rehash-threshold 0.999))
320 (private-use-start #xE000) 326 (private-use-start (encode-char fixed-width-private-use-start 'ucs))
321 (invalid-sequence-code-point-start 327 (invalid-sequence-code-point-start
322 (eval-when-compile 328 (eval-when-compile
323 (char-to-unicode 329 (char-to-unicode
324 (aref (decode-coding-string "\xd8\x00\x00\x00" 'utf-16-be) 3)))) 330 (aref (decode-coding-string "\xd8\x00\x00\x00" 'utf-16-be) 3))))
325 desired-ucs decode-table-entry) 331 desired-ucs decode-table-entry)