Mercurial > hg > xemacs-beta

comparison lisp/coding.el @ 5081:baffa6ca776a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Backed out changeset c673987f5f3d
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 26 Feb 2010 15:22:15 +0000
parents c673987f5f3d
children 88f955fa5a7f
comparison
equal deleted inserted replaced
5068:c673987f5f3d 5081:baffa6ca776a
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))
488 (define-coding-system-alias 'escape-quoted 'binary) 490 (define-coding-system-alias 'escape-quoted 'binary)
489 491
490 ;; These are so that gnus and friends work when not mule: 492 ;; These are so that gnus and friends work when not mule: