Changes committed gnus/lisp (ChangeLog lpath.el mm-url.el mm-util.el)

Modified: ChangeLog lpath.el mm-url.el mm-util.el

* 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.


Index: ChangeLog
diff -u gnus/lisp/ChangeLog:7.1965 gnus/lisp/ChangeLog:7.1966
--- ChangeLog:7.1965	Mon Jan  5 21:50:39 2009
+++ ChangeLog	Mon Jan  5 23:09:39 2009
@@ -1,3 +1,12 @@
+2009-01-05  Katsumi Yamaoka  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* time-date.el: Require cl for `declare'.
Index: lpath.el
diff -u gnus/lisp/lpath.el:7.49 gnus/lisp/lpath.el:7.50
--- lpath.el:7.49	Thu Dec  4 02:58:21 2008
+++ lpath.el	Mon Jan  5 23:09:39 2009
@@ -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)))
 
Index: mm-url.el
diff -u gnus/lisp/mm-url.el:7.22 gnus/lisp/mm-url.el:7.23
--- mm-url.el:7.22	Mon May 19 10:47:42 2008
+++ mm-url.el	Mon Jan  5 23:09:39 2009
@@ -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 <[email protected]>
 
@@ -366,10 +367,10 @@
   (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))
 			  ?#))))
Index: mm-util.el
diff -u gnus/lisp/mm-util.el:7.88 gnus/lisp/mm-util.el:7.89
--- mm-util.el:7.88	Wed Dec 24 03:30:41 2008
+++ mm-util.el	Mon Jan  5 23:09:39 2009
@@ -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 <[email protected]>
 ;;	MORIOKA Tomohiko <[email protected]>
@@ -224,6 +224,44 @@
      ((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