From: ueno <ueno>
Date: Sat, 4 Jun 2005 03:51:44 +0000 (+0000)
Subject: * riece-server.el (riece-server-keyword-map): Add :coding-system-alist.
X-Git-Tag: channel-coding-mergepoint~19
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=6e989585d1652450dc5cfdfc2ae7aaa3d881c16b;p=elisp%2Friece.git

* riece-server.el (riece-server-keyword-map): Add :coding-system-alist.

* riece-irc.el (riece-irc-open-server): Init riece-coding-system-alist.

* riece-handle.el (riece-handle-privmsg-message): Retry with the
channel's coding-system if it differs from the server's
coding-system.

* riece-commands.el (riece-command-send-message): Pass prefix to
riece-send-string.

* riece-globals.el (riece-coding-system-alist): New variable.

* riece-coding.el (riece-decode-coding-string-1): Split from
riece-decode-coding-string; set riece-coding-encoded-string and
riece-coding-decoded-coding-system properties on decoded string.
(riece-retry-decode-coding-string): New function.
(riece-decoded-coding-system): Use it.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d03a783..6f15dc5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,24 @@
+2005-06-04  Daiki Ueno  <ueno@unixuser.org>
+
+	* riece-server.el (riece-server-keyword-map): Add :coding-system-alist.
+
+	* riece-irc.el (riece-irc-open-server): Init riece-coding-system-alist.
+
+	* riece-handle.el (riece-handle-privmsg-message): Retry with the
+	channel's coding-system if it differs from the server's
+	coding-system.
+
+	* riece-commands.el (riece-command-send-message): Pass prefix to
+	riece-send-string.
+
+	* riece-globals.el (riece-coding-system-alist): New variable.
+
+	* riece-coding.el (riece-decode-coding-string-1): Split from
+	riece-decode-coding-string; set riece-coding-encoded-string and
+	riece-coding-decoded-coding-system properties on decoded string.
+	(riece-retry-decode-coding-string): New function.
+	(riece-decoded-coding-system): Use it.
+
 2005-06-03  Daiki Ueno  <ueno@unixuser.org>
 
 	* riece-ruby.el: New file.
diff --git a/lisp/riece-coding.el b/lisp/riece-coding.el
index acb8880..459797b 100644
--- a/lisp/riece-coding.el
+++ b/lisp/riece-coding.el
@@ -55,11 +55,32 @@ specifying the coding systems for decoding and encoding respectively."
 (defun riece-decode-coding-string (string)
   (if (and (local-variable-p 'riece-coding-system (current-buffer))
 	   riece-coding-system)		;should be nil on non-Mule environment
-      (if (consp riece-coding-system)
-	  (decode-coding-string string (car riece-coding-system))
-	(decode-coding-string string riece-coding-system))
+      (riece-decode-coding-string-1 string
+				    (if (consp riece-coding-system)
+					(car riece-coding-system)
+				      riece-coding-system))
     string))
 
+(defun riece-retry-decode-coding-string (string coding-system)
+  (if (eq (get-text-property 0 'riece-coding-decoded-coding-system string)
+	  coding-system)
+      string
+    (riece-decode-coding-string-1
+     (get-text-property 0 'riece-coding-encoded-string string)
+     coding-system)))
+
+(defun riece-decoded-coding-system (string)
+  (get-text-property 0 'riece-coding-decoded-coding-system string))
+
+(defun riece-decode-coding-string-1 (string coding-system)
+  (let* ((decoded (decode-coding-string string coding-system))
+	 (length (length decoded)))
+    (put-text-property 0 length 'riece-coding-encoded-string
+		       string decoded)
+    (put-text-property 0 length 'riece-coding-decoded-coding-system
+		       coding-system decoded)
+    decoded))
+
 (provide 'riece-coding)
 
 ;;; riece-coding.el ends here
diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el
index 90b88fd..b3398ce 100644
--- a/lisp/riece-commands.el
+++ b/lisp/riece-commands.el
@@ -378,14 +378,16 @@ the layout to the selected layout-name."
 	(riece-send-string
 	 (format "NOTICE %s :%s\r\n"
 		 (riece-identity-prefix riece-current-channel)
-		 message))
+		 message)
+	 (riece-identity-prefix riece-current-channel))
 	(riece-display-message
 	 (riece-make-message (riece-current-nickname) riece-current-channel
 			     message 'notice t)))
     (riece-send-string
      (format "PRIVMSG %s :%s\r\n"
 	     (riece-identity-prefix riece-current-channel)
-	     message))
+	     message)
+     (riece-identity-prefix riece-current-channel))
     (riece-display-message
      (riece-make-message (riece-current-nickname) riece-current-channel
 			 message nil t))))
diff --git a/lisp/riece-globals.el b/lisp/riece-globals.el
index 814d41f..8a9b634 100644
--- a/lisp/riece-globals.el
+++ b/lisp/riece-globals.el
@@ -129,6 +129,9 @@ Local to the server buffers.")
 (defvar riece-coding-system nil
   "Coding system for process I/O.
 Local to the server buffers.")
+(defvar riece-coding-system-alist nil
+  "An alist mapping prefixes to coding-systems.
+Local to the server buffers.")
 
 ;;; Variables local to the channel buffers:
 (defvar riece-freeze nil
diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el
index cf5e0be..e516689 100644
--- a/lisp/riece-handle.el
+++ b/lisp/riece-handle.el
@@ -82,15 +82,23 @@
   (let* ((user (riece-prefix-nickname prefix))
 	 (parameters (riece-split-parameters string))
 	 (targets (split-string (car parameters) ","))
+	 (coding-system (cdr (assoc (car targets) riece-coding-system-alist)))
 	 (message (nth 1 parameters)))
-    (riece-display-message
-     (riece-make-message (riece-make-identity user
-					      riece-server-name)
-			 (riece-make-identity (car targets)
-					      riece-server-name)
-			 message nil
-			 (riece-identity-equal-no-server
-			  user riece-real-nickname)))))
+    (if (eq coding-system
+	    (riece-decoded-coding-system string))
+	(riece-display-message
+	 (riece-make-message (riece-make-identity user
+						  riece-server-name)
+			     (riece-make-identity (car targets)
+						  riece-server-name)
+			     message
+			     nil
+			     (riece-identity-equal-no-server
+			      user riece-real-nickname)))
+      (riece-handle-privmsg-message
+       prefix
+       (riece-retry-decode-coding-string string
+					 coding-system)))))
 
 (defun riece-handle-notice-message (prefix string)
   (let* ((user (if prefix
diff --git a/lisp/riece-irc.el b/lisp/riece-irc.el
index caecdc7..d9c1ccd 100644
--- a/lisp/riece-irc.el
+++ b/lisp/riece-irc.el
@@ -86,7 +86,8 @@
 	(with-current-buffer (process-buffer process)
 	  (setq riece-last-nickname riece-real-nickname
 		riece-nick-accepted 'sent
-		riece-coding-system coding))
+		riece-coding-system coding
+		riece-coding-system-alist coding-system-alist))
 	process))))
 
 (defun riece-irc-quit-server-process (process &optional message)
diff --git a/lisp/riece-server.el b/lisp/riece-server.el
index 3204193..48ad91e 100644
--- a/lisp/riece-server.el
+++ b/lisp/riece-server.el
@@ -38,7 +38,8 @@
       (:username riece-username)
       (:password)
       (:function riece-default-open-connection-function)
-      (:coding riece-default-coding-system))
+      (:coding riece-default-coding-system)
+      (:coding-system-alist))
     "Mapping from keywords to default values.
 All keywords that can be used must be listed here."))
 
@@ -162,8 +163,7 @@ the `riece-server-keyword-map' variable."
 	  (setq riece-send-size 0))
       (while (and (not (riece-queue-empty riece-send-queue))
 		  (<= riece-send-size riece-max-send-size))
-	(setq string (riece-encode-coding-string
-		      (riece-queue-dequeue riece-send-queue))
+	(setq string (riece-queue-dequeue riece-send-queue)
 	      length (length string))
 	(if (> length riece-max-send-size)
 	    (message "Long message (%d > %d)" length riece-max-send-size)
@@ -193,13 +193,23 @@ the `riece-server-keyword-map' variable."
 	  (if (riece-server-opened "")
 	      "")))))
 
-(defun riece-send-string (string)
+(defun riece-send-string (string &optional prefix)
   (let* ((server-name (riece-current-server-name))
-	 (process (riece-server-process server-name)))
+	 (process (riece-server-process server-name))
+	 coding-system)
     (unless process
       (error "%s" (substitute-command-keys
 		   "Type \\[riece-command-open-server] to open server.")))
-    (riece-process-send-string process string)))
+    (riece-process-send-string
+     process
+     (if (and prefix
+	      (setq coding-system
+		    (cdr (assoc prefix
+				(plist-get (riece-server-properties
+					    server-name)
+					   :coding-system-alist)))))
+	 (encode-coding-string string coding-system)
+       (riece-encode-coding-string string)))))
 
 (defun riece-open-server (server server-name)
   (let ((protocol (or (plist-get server :protocol)
@@ -264,6 +274,7 @@ the `riece-server-keyword-map' variable."
     (make-local-variable 'riece-channel-obarray)
     (setq riece-channel-obarray (make-vector riece-channel-obarray-size 0))
     (make-local-variable 'riece-coding-system)
+    (make-local-variable 'riece-coding-system-alist)
     (buffer-disable-undo)
     (erase-buffer)))