Mercurial > hg > xemacs-beta

comparison lisp/coding.el @ 5126:2a462149bd6a 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 Wed, 24 Feb 2010 19:04:27 -0600
parents c673987f5f3d
children baffa6ca776a
comparison
equal deleted inserted replaced
5125:b5df3737028a 5126:2a462149bd6a
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 Ben Wing. 8 ;; Copyright (C) 2000, 2001, 2002, 2010 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 (if (featurep 'mule) 467 (defun decode-char (quote-ucs code &optional restriction)
468 (progn 468 "FSF compatibility--return Mule character with Unicode codepoint CODE.
469 ;; Under Mule, we do much of the complicated coding system creation in 469 The second argument must be 'ucs, the third argument is ignored. "
470 ;; Lisp and especially at compile time. We need some function 470 ;; We're prepared to accept invalid Unicode in unicode-to-char, but not in
471 ;; definition for this function to be created in this file, but we can 471 ;; this function, which is the API that should actually be used, since
472 ;; leave assigning the docstring to the autoload cookie 472 ;; it's available in GNU and in Mule-UCS.
473 ;; handling later. Thankfully; that docstring is big. 473 (check-argument-range code #x0 #x10FFFF)
474 (autoload 'make-coding-system "mule/make-coding-system") 474 (assert (eq quote-ucs 'ucs) t
475 475 "Sorry, decode-char doesn't yet support anything but the UCS. ")
476 ;; (During byte-compile before dumping, make-coding-system may already 476 (unicode-to-char code))
477 ;; have been loaded, make sure not to overwrite the correct compiler 477
478 ;; macro:) 478 (defun encode-char (char quote-ucs &optional restriction)
479 (when (eq 'autoload (car (symbol-function 'make-coding-system))) 479 "FSF compatibility--return the Unicode code point of CHAR.
480 ;; Make sure to pick up the correct compiler macro when compiling 480 The second argument must be 'ucs, the third argument is ignored. "
481 ;; files: 481 (assert (eq quote-ucs 'ucs) t
482 (define-compiler-macro make-coding-system (&whole form name type 482 "Sorry, encode-char doesn't yet support anything but the UCS. ")
483 &optional description props) 483 (char-to-unicode char))
484 (load (second (symbol-function 'make-coding-system))) 484
485 (funcall (get 'make-coding-system 'cl-compiler-macro) 485 (unless (featurep 'mule)
486 form name type description props))))
487
488 ;; Mule's not available; 486 ;; Mule's not available;
489 (fset 'make-coding-system (symbol-function 'make-coding-system-internal)) 487 (fset 'make-coding-system (symbol-function 'make-coding-system-internal))
490 (define-coding-system-alias 'escape-quoted 'binary) 488 (define-coding-system-alias 'escape-quoted 'binary)
491 489
492 ;; These are so that gnus and friends work when not mule: 490 ;; These are so that gnus and friends work when not mule: