Mercurial > hg > xemacs-beta

comparison lisp/coding.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 f00192e1cd49 308d34e9f07d
comparison
equal deleted inserted replaced
5127:a9c41067dd88 5128:7be849cb8828
3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. 3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
4 ;; Licensed to the Free Software Foundation. 4 ;; Licensed to the Free Software Foundation.
5 ;; Copyright (C) 1995 Amdahl Corporation. 5 ;; Copyright (C) 1995 Amdahl Corporation.
6 ;; Copyright (C) 1995 Sun Microsystems. 6 ;; Copyright (C) 1995 Sun Microsystems.
7 ;; Copyright (C) 1997 MORIOKA Tomohiko 7 ;; Copyright (C) 1997 MORIOKA Tomohiko
8 ;; Copyright (C) 2000, 2001, 2002, 2010 Ben Wing. 8 ;; Copyright (C) 2000, 2001, 2002 Ben Wing.
9 9
10 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
11 11
12 ;; XEmacs is free software; you can redistribute it and/or modify it 12 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by 13 ;; under the terms of the GNU General Public License as published by
462 The optional third argument CHARSET is, for the moment, ignored." 462 The optional third argument CHARSET is, for the moment, ignored."
463 (check-argument-type #'characterp char) 463 (check-argument-type #'characterp char)
464 (and (query-coding-string char coding-system) 464 (and (query-coding-string char coding-system)
465 (encode-coding-string char coding-system))) 465 (encode-coding-string char coding-system)))
466 466
467 (defun decode-char (quote-ucs code &optional restriction) 467 (if (featurep 'mule)
468 "FSF compatibility--return Mule character with Unicode codepoint CODE. 468 (progn
469 The second argument must be 'ucs, the third argument is ignored. " 469 ;; Under Mule, we do much of the complicated coding system creation in
470 ;; We're prepared to accept invalid Unicode in unicode-to-char, but not in 470 ;; Lisp and especially at compile time. We need some function
471 ;; this function, which is the API that should actually be used, since 471 ;; definition for this function to be created in this file, but we can
472 ;; it's available in GNU and in Mule-UCS. 472 ;; leave assigning the docstring to the autoload cookie
473 (check-argument-range code #x0 #x10FFFF) 473 ;; handling later. Thankfully; that docstring is big.
474 (assert (eq quote-ucs 'ucs) t 474 (autoload 'make-coding-system "mule/make-coding-system")
475 "Sorry, decode-char doesn't yet support anything but the UCS. ") 475
476 (unicode-to-char code)) 476 ;; (During byte-compile before dumping, make-coding-system may already
477 477 ;; have been loaded, make sure not to overwrite the correct compiler
478 (defun encode-char (char quote-ucs &optional restriction) 478 ;; macro:)
479 "FSF compatibility--return the Unicode code point of CHAR. 479 (when (eq 'autoload (car (symbol-function 'make-coding-system)))
480 The second argument must be 'ucs, the third argument is ignored. " 480 ;; Make sure to pick up the correct compiler macro when compiling
481 (assert (eq quote-ucs 'ucs) t 481 ;; files:
482 "Sorry, encode-char doesn't yet support anything but the UCS. ") 482 (define-compiler-macro make-coding-system (&whole form name type
483 (char-to-unicode char)) 483 &optional description props)
484 484 (load (second (symbol-function 'make-coding-system)))
485 (unless (featurep 'mule) 485 (funcall (get 'make-coding-system 'cl-compiler-macro)
486 form name type description props))))
487
486 ;; Mule's not available; 488 ;; Mule's not available;
487 (fset 'make-coding-system (symbol-function 'make-coding-system-internal)) 489 (fset 'make-coding-system (symbol-function 'make-coding-system-internal))
490 (define-compiler-macro make-coding-system (&whole form name type
491 &optional description props)
492 (cond
493 ;; We shouldn't normally see these forms under non-Mule; they're all in
494 ;; the mule/ subdirectory.
495 ((equal '(quote fixed-width) type)
496 form)
497 ((byte-compile-constp type)
498 `(funcall (or (and (fboundp 'make-coding-system-internal)
499 'make-coding-system-internal) 'make-coding-system)
500 ,@(cdr form)))
501 (t form)))
502
488 (define-coding-system-alias 'escape-quoted 'binary) 503 (define-coding-system-alias 'escape-quoted 'binary)
489 504
490 ;; These are so that gnus and friends work when not mule: 505 ;; These are so that gnus and friends work when not mule:
491 (define-coding-system-alias 'iso-8859-1 'raw-text) 506 (define-coding-system-alias 'iso-8859-1 'raw-text)
492 (define-coding-system-alias 'ctext 'raw-text)) 507 (define-coding-system-alias 'ctext 'raw-text))