Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-coding.el @ 4103:b4f4e0cc90f1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-08-07 23:08:47 by aidan] Eliminate byte compiler warnings, give nicer errors in the absence of packages.
author aidan
date Tue, 07 Aug 2007 23:09:22 +0000
parents 751ae075e76e
children edb00a8b4eff
comparison
equal deleted inserted replaced
4102:9856d458deda 4103:b4f4e0cc90f1
628 props (if props (cadr props))) 628 props (if props (cadr props)))
629 (let ((encode-failure-octet 629 (let ((encode-failure-octet
630 (or (plist-get props 'encode-failure-octet) (char-to-int ?~))) 630 (or (plist-get props 'encode-failure-octet) (char-to-int ?~)))
631 (aliases (plist-get props 'aliases)) 631 (aliases (plist-get props 'aliases))
632 encode-program decode-program 632 encode-program decode-program
633 decode-table encode-table res) 633 decode-table encode-table)
634 634
635 ;; Some sanity checking. 635 ;; Some sanity checking.
636 (check-argument-range encode-failure-octet 0 #xFF) 636 (check-argument-range encode-failure-octet 0 #xFF)
637 (check-argument-type #'listp aliases) 637 (check-argument-type #'listp aliases)
638 638
650 encode-program (make-8-bit-generate-encode-program 650 encode-program (make-8-bit-generate-encode-program
651 decode-table encode-table encode-failure-octet)) 651 decode-table encode-table encode-failure-octet))
652 652
653 ;; And return the generated code. 653 ;; And return the generated code.
654 `(let ((encode-table-sym (gentemp (format "%s-encode-table" ',name))) 654 `(let ((encode-table-sym (gentemp (format "%s-encode-table" ',name)))
655 result) 655 ;; The case-fold-search bind shouldn't be necessary. If I take
656 ;; it, out, though, I get:
657 ;;
658 ;; (invalid-read-syntax "Multiply defined symbol label" 1)
659 ;;
660 ;; when the file is byte compiled.
661 (case-fold-search t))
656 (define-translation-hash-table encode-table-sym ,encode-table) 662 (define-translation-hash-table encode-table-sym ,encode-table)
657 (setq result 663 (make-coding-system
658 (make-coding-system 664 ',name 'ccl ,description
659 ',name 'ccl ,description 665 (plist-put (plist-put ',props 'decode
660 (plist-put (plist-put ',props 'decode 666 ,(apply #'vector decode-program))
661 ,(apply #'vector decode-program)) 667 'encode
662 'encode 668 (apply #'vector
663 (apply #'vector 669 (nsublis
664 (nsublis 670 (list (cons
665 (list (cons 671 'encode-table-sym
666 'encode-table-sym 672 (symbol-value 'encode-table-sym)))
667 (symbol-value 'encode-table-sym))) 673 ',encode-program))))
668 ',encode-program)))))
669 (coding-system-put ',name 'category 'iso-8-1) 674 (coding-system-put ',name 'category 'iso-8-1)
670 ,(macroexpand `(loop for alias in ',aliases 675 ,(macroexpand `(loop for alias in ',aliases
671 do (define-coding-system-alias alias 676 do (define-coding-system-alias alias
672 ',name))) 677 ',name)))
673 'result)))) 678 (find-coding-system ',name)))))
674
675