* mm-util.el (mm-ucs-to-char): New function.

* mm-url.el (mm-url-decode-entities): Use it.

* lpath.el: Fbind decode-char, int-to-char, ucs-to-char and unicode-to-char.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e3b10a9..98690fc 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2009-01-05  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * mm-util.el (mm-ucs-to-char): New function.
+
+       * mm-url.el (mm-url-decode-entities): Use it.
+
+       * lpath.el: Fbind decode-char, int-to-char, ucs-to-char and
+       unicode-to-char.
+
 2009-01-05  Dave Love  <fx@gnu.org>
 
        * time-date.el: Require cl for `declare'.

diff --git a/lisp/lpath.el b/lisp/lpath.el
index af6b1cf..55ef8d6 100644 (file)
--- a/lisp/lpath.el
+++ b/lisp/lpath.el
@@ -32,14 +32,14 @@
      '(clear-string
        custom-autoload delete-annotation delete-extent device-connection
        dfw-device events-to-keys find-face font-lock-set-defaults
-       get-char-table glyph-height glyph-width help-buffer ldap-search-entries
-       mail-aliases-setup make-annotation make-event make-glyph
-       make-network-process map-extents message-xmas-redefine put-char-table
-       run-mode-hooks set-extent-property set-itimer-function
-       set-keymap-default-binding temp-directory unicode-precedence-list
-       url-generic-parse-url url-http-file-exists-p
-       valid-image-instantiator-format-p vcard-pretty-print
-       w3-coding-system-for-mime-charset window-pixel-height
+       get-char-table glyph-height glyph-width help-buffer int-to-char
+       ldap-search-entries mail-aliases-setup make-annotation make-event
+       make-glyph make-network-process map-extents message-xmas-redefine
+       put-char-table run-mode-hooks set-extent-property set-itimer-function
+       set-keymap-default-binding temp-directory ucs-to-char
+       unicode-precedence-list unicode-to-char url-generic-parse-url
+       url-http-file-exists-p valid-image-instantiator-format-p
+       vcard-pretty-print w3-coding-system-for-mime-charset window-pixel-height
        window-pixel-width))
     (maybe-bind
      '(eudc-protocol
@@ -60,7 +60,7 @@
      mail-abbrevs-setup make-mode-line-mouse-map make-network-process
      mouse-minibuffer-check mouse-movement-p mouse-scroll-subr
      pgg-display-output-buffer posn-point posn-window put-image read-event
-     select-safe-coding-system sort-coding-systems track-mouse
+     select-safe-coding-system sort-coding-systems track-mouse ucs-to-char
      url-generic-parse-url url-http-file-exists-p url-insert-file-contents
      vcard-pretty-print w3m-detect-meta-charset w3m-region window-edges))
   (maybe-bind
@@ -80,9 +80,9 @@
            (featurep 'sxemacs))
     (maybe-fbind
      '(custom-autoload
-       display-graphic-p display-images-p display-visual-class
+       decode-char display-graphic-p display-images-p display-visual-class
        get-display-table put-display-table select-frame-set-input-focus
-       unicode-precedence-list w32-focus-frame x-focus-frame))
+       unicode-precedence-list unicode-to-char w32-focus-frame x-focus-frame))
     (maybe-bind
      '(default-file-name-coding-system scroll-margin)))
 

diff --git a/lisp/mm-url.el b/lisp/mm-url.el
index 4434e5a..46ca174 100644 (file)
--- a/lisp/mm-url.el
+++ b/lisp/mm-url.el
@@ -1,6 +1,7 @@
 ;;; mm-url.el --- a wrapper of url functions/commands for Gnus
 
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;   Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 
@@ -366,10 +367,10 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
   (goto-char (point-min))
   (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t)
     (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
-                       (let ((c
-                              (string-to-number (substring
-                                                 (match-string 1) 1))))
-                         (if (mm-char-or-char-int-p c) c 32))
+                       (let ((c (mm-ucs-to-char
+                                 (string-to-number
+                                  (substring (match-string 1) 1)))))
+                         (if (mm-char-or-char-int-p c) c ?#))
                      (or (cdr (assq (intern (match-string 1))
                                     mm-url-html-entities))
                          ?#))))

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index c2bcd3f..3d8538d 100644 (file)
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -1,7 +1,7 @@
 ;;; mm-util.el --- Utility functions for Mule and low level things
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -224,6 +224,44 @@ to the contents of the accessible portion of the buffer."
      ((fboundp 'char-valid-p) 'char-valid-p)
      (t 'identity))))
 
+;; `ucs-to-char' is a function that Mule-UCS provides.
+(if (featurep 'xemacs)
+    (cond ((and (fboundp 'unicode-to-char) ;; XEmacs 21.5.
+               (subrp (symbol-function 'unicode-to-char)))
+          (if (featurep 'mule)
+              (defalias 'mm-ucs-to-char 'unicode-to-char)
+            (defun mm-ucs-to-char (codepoint)
+              "Convert Unicode codepoint to character."
+              (or (unicode-to-char codepoint) ?#))))
+         ((featurep 'mule)
+          (defun mm-ucs-to-char (codepoint)
+            "Convert Unicode codepoint to character."
+            (if (fboundp 'ucs-to-char) ;; Mule-UCS is loaded.
+                (progn
+                  (defalias 'mm-ucs-to-char
+                    (lambda (codepoint)
+                      "Convert Unicode codepoint to character."
+                      (condition-case nil
+                          (or (ucs-to-char codepoint) ?#)
+                        (error ?#))))
+                  (mm-ucs-to-char codepoint))
+              (condition-case nil
+                  (or (int-to-char codepoint) ?#)
+                (error ?#)))))
+         (t
+          (defun mm-ucs-to-char (codepoint)
+            "Convert Unicode codepoint to character."
+            (condition-case nil
+                (or (int-to-char codepoint) ?#)
+              (error ?#)))))
+  (if (let ((char (make-char 'japanese-jisx0208 36 34)))
+       (eq char (decode-char 'ucs char)))
+      ;; Emacs 23.
+      (defalias 'mm-ucs-to-char 'identity)
+    (defun mm-ucs-to-char (codepoint)
+      "Convert Unicode codepoint to character."
+      (or (decode-char 'ucs codepoint) ?#))))
+
 ;; Fixme:  This seems always to be used to read a MIME charset, so it
 ;; should be re-named and fixed (in Emacs) to offer completion only on
 ;; proper charset names (base coding systems which have a