From: ueno <ueno>
Date: Mon, 29 Aug 2005 06:02:58 +0000 (+0000)
Subject: Merge channel-coding branch.
X-Git-Tag: riece-2_0_0~5
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=db33cfdd5cabbc8dac9474d0ebd6cae41d99500e;p=elisp%2Friece.git

Merge channel-coding branch.
---

diff --git a/NEWS b/NEWS
index 3289563..d85f26b 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,12 @@
 * Major changes in 2.0.0
 
+** Support multiple coding-systems on a server.
+   You can use different coding-systems for different channels. (ueno)
+   For example:
+   (setq riece-channel-coding-system-alist
+	 '(("#euc-jp" . euc-jp)
+	   ("#utf-8 irc.freenode.net" . utf-8)))
+
 ** Support uninstall, unload (dangerous) operations for add-ons.
    Now you can fully customize riece-addons in the add-on listing
    mode. (ueno)
@@ -40,7 +47,7 @@
    To use it, after configure, do "make compile-individually" in
    lisp/.  (ueno)
 
-** Include a document for developers (doc/HACKING.ja) (ueno)
+** Include a document for developers (doc/HACKING{,.ja}) (ueno)
 
 * Major changes in 1.0.8
 
diff --git a/NEWS.ja b/NEWS.ja
index 256a388..9d3638a 100644
--- a/NEWS.ja
+++ b/NEWS.ja
@@ -1,5 +1,11 @@
 * Riece 2.0.0 の主な変更点
 
+** チャンネル毎にエンコーディングを指定できるようにした (ueno)
+   設定例：
+   (setq riece-channel-coding-system-alist
+	 '(("#euc-jp" . euc-jp)
+	   ("#utf-8 irc.freenode.net" . utf-8)))
+
 ** アドオンの uninstall, unload (危険) に対応。
    アドオン一覧モードで riece-addons のカスタマイズが可能 (ueno)
 
@@ -35,7 +41,7 @@
 ** elisp ファイルを１つずつ byte-compile する make ルールを設けた。
    configure 後、lisp/ 以下で make compile-individually (ueno)
 
-** 開発者向けの文書 (doc/HACKING.ja) を同梱 (ueno)
+** 開発者向けの文書 (doc/HACKING{,.ja}) を同梱 (ueno)
 
 * Riece 1.0.8 の主な変更点
 
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4340871..235a5dd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,49 @@
+2005-08-29  Daiki Ueno  <ueno@unixuser.org>
+
+	* riece-server.el (riece-server-keyword-map): Abolished
+	:coding-system-alist keyword.
+	(riece-send-string): Take the target identity as the 2nd argument.
+
+	* riece-identity.el (riece-channel-coding-system-alist): Renamed
+	from riece-coding-system-alist.
+
+	* riece-globals.el (riece-coding-system-alist): Abolished.
+
+	* riece-commands.el (riece-command-topic): Pass the target
+	identity to riece-send-string.
+	(riece-command-kick): Ditto.
+	(riece-command-send-message): Ditto.
+	(riece-command-enter-message-to-user): Ditto.
+	(riece-command-join-channel): Ditto.
+	(riece-command-part-channel): Ditto.
+
+2005-08-29  Daiki Ueno  <ueno@unixuser.org>
+
+	* riece-identity.el (riece-coding-system-for-identity): Moved from
+	riece-coding.el.
+	(riece-decoded-string-for-identity): Ditto.
+
+	* riece-300.el (riece-handle-322-message): Decode message per
+	channel.
+	(riece-handle-set-topic): Ditto.
+
+	* riece-handle.el (riece-handle-notice-message): Decode message
+	per channel.
+	(riece-handle-part-message): Ditto.
+	(riece-handle-kick-message): Ditto.
+	(riece-handle-topic-message): Ditto.
+
+2005-08-28  Daiki Ueno  <ueno@unixuser.org>
+
+	* riece-handle.el (riece-handle-privmsg-message): Use
+	riece-decoded-string & riece-decoded-string-for-identity.
+
+	* riece-coding.el (riece-coding-system-alist): New user option.
+	(riece-coding-system-for-identity): New function.
+	(riece-encoded-string): New function.
+	(riece-decoded-string): New alias.
+	(riece-decoded-string-for-identity): New function.
+
 2005-08-27  Daiki Ueno  <ueno@unixuser.org>
 
 	* riece-addon.el (riece-uninstall-addon): Don't check the add-on
@@ -421,6 +467,27 @@
 	* riece-debug.el (riece-debug-1): New function.
 	(riece-debug): Always return nil.
 
+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-300.el b/lisp/riece-300.el
index 109f2f2..ab992c3 100644
--- a/lisp/riece-300.el
+++ b/lisp/riece-300.el
@@ -257,27 +257,29 @@
 		(cons (cons channel (substring string (match-end 0)))
 		      riece-353-message-alist))))))
 
-(defun riece-handle-322-message (prefix number name string)
-  (if (string-match "^\\([^ ]+\\) \\([0-9]+\\) :?" string)
-      (let* ((channel (match-string 1 string))
-	     (visible (match-string 2 string))
-	     (topic (substring string (match-end 0))))
-	(riece-channel-set-topic (riece-get-channel channel) topic)
-	(let* ((channel-identity (riece-make-identity channel
-						      riece-server-name))
-	       (buffer (riece-channel-buffer channel-identity)))
-	  (riece-insert-info buffer (concat visible " users, topic: "
-					    topic "\n"))
-	  (riece-insert-info
-	   (if (and riece-channel-buffer-mode
-		    (not (eq buffer riece-channel-buffer)))
-	       (list riece-dialogue-buffer riece-others-buffer)
-	     riece-dialogue-buffer)
-	   (concat
-	    (riece-concat-server-name
-	     (format "%s: %s users, topic: %s"
-		     (riece-format-identity channel-identity t) visible topic))
-	    "\n"))))))
+(defun riece-handle-322-message (prefix number name decoded)
+  (let* ((parameters (riece-split-parameters (riece-decoded-string decoded)))
+	 (channel (car parameters))
+	 (visible (nth 1 parameters))
+	 (channel-identity (riece-make-identity channel riece-server-name))
+	 (buffer (riece-channel-buffer channel-identity))
+	 topic)
+    (setq parameters (riece-split-parameters
+		      (riece-decoded-string-for-identity decoded
+							 channel-identity))
+	  topic (nth 1 parameters))
+    (riece-channel-set-topic (riece-get-channel channel) topic)
+    (riece-insert-info buffer (concat visible " users, topic: " topic "\n"))
+    (riece-insert-info
+     (if (and riece-channel-buffer-mode
+	      (not (eq buffer riece-channel-buffer)))
+	 (list riece-dialogue-buffer riece-others-buffer)
+       riece-dialogue-buffer)
+     (concat
+      (riece-concat-server-name
+       (format "%s: %s users, topic: %s"
+	       (riece-format-identity channel-identity t) visible topic))
+      "\n"))))
 
 (defun riece-handle-324-message (prefix number name string)
   (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) " string)
@@ -301,31 +303,32 @@
 		     mode-string))
 	    "\n"))))))
 
-(defun riece-handle-set-topic (prefix number name string remove)
-  (if (string-match "^\\([^ ]+\\) :?" string)
-      (let* ((channel (match-string 1 string))
-	     (message (substring string (match-end 0)))
-	     (channel-identity (riece-make-identity channel riece-server-name))
-	     (buffer (riece-channel-buffer channel-identity)))
-	(if remove
-	    (riece-channel-set-topic (riece-get-channel channel) nil)
-	  (riece-channel-set-topic (riece-get-channel channel) message)
-	  (riece-insert-info buffer (concat "Topic: " message "\n"))
-	  (riece-insert-info
-	   (if (and riece-channel-buffer-mode
-		    (not (eq buffer riece-channel-buffer)))
-	       (list riece-dialogue-buffer riece-others-buffer)
-	     riece-dialogue-buffer)
-	   (concat
-	    (riece-concat-server-name
-	     (format "Topic for %s: %s"
-		     (riece-format-identity channel-identity t)
-		     message))
-	    "\n")))
-	(riece-emit-signal 'channel-topic-changed
-			    channel-identity
-			    (unless remove
-			      message)))))
+(defun riece-handle-set-topic (prefix number name decoded remove)
+  (let* ((parameters (riece-split-parameters (riece-decoded-string decoded)))
+	 (channel (car parameters))
+	 topic
+	 (channel-identity (riece-make-identity channel riece-server-name))
+	 (buffer (riece-channel-buffer channel-identity)))
+    (if remove
+	(riece-channel-set-topic (riece-get-channel channel) nil)
+      (setq parameters (riece-split-parameters
+			(riece-decoded-string-for-identity decoded
+							   channel-identity))
+	    topic (nth 1 parameters))
+      (riece-channel-set-topic (riece-get-channel channel) topic)
+      (riece-insert-info buffer (concat "Topic: " topic "\n"))
+      (riece-insert-info
+       (if (and riece-channel-buffer-mode
+		(not (eq buffer riece-channel-buffer)))
+	   (list riece-dialogue-buffer riece-others-buffer)
+	 riece-dialogue-buffer)
+       (concat
+	(riece-concat-server-name
+	 (format "Topic for %s: %s"
+		 (riece-format-identity channel-identity t)
+		 topic))
+	"\n")))
+    (riece-emit-signal 'channel-topic-changed channel-identity topic)))
 
 (defun riece-handle-331-message (prefix number name string)
   (riece-handle-set-topic prefix number name string t))
diff --git a/lisp/riece-coding.el b/lisp/riece-coding.el
index 701795c..3b5f934 100644
--- a/lisp/riece-coding.el
+++ b/lisp/riece-coding.el
@@ -55,11 +55,35 @@ 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-decode-coding-string-1 (string coding-system)
+  (let* ((decoded (decode-coding-string string coding-system))
+	 (length (length decoded)))
+    (put-text-property 0 length 'riece-decoded-encoded-string
+		       string decoded)
+    (put-text-property 0 length 'riece-decoded-coding-system
+		       coding-system decoded)
+    decoded))
+
+;; The following functions are API used by handler functions.  For the
+;; meantime DECODED is actually a string (with some text properties).
+;; In the future, however, the implementation _should_ be changed so
+;; that decoding phase is delayed until the body of handler functions.
+(defun riece-decoded-coding-system (decoded)
+  "Return the coding-system used for decoding DECODED."
+  (get-text-property 0 'riece-decoded-coding-system decoded))
+
+(defun riece-decoded-encoded-string (decoded)
+  "Return the string before decoding."
+  (get-text-property 0 'riece-decoded-encoded-string decoded))
+
+(defalias 'riece-decoded-string 'identity)
+
 (provide 'riece-coding)
 
 ;;; riece-coding.el ends here
diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el
index 7bcbfa5..116d58a 100644
--- a/lisp/riece-commands.el
+++ b/lisp/riece-commands.el
@@ -194,7 +194,8 @@ the layout to the selected layout-name."
 				0)))))
   (riece-send-string (format "TOPIC %s :%s\r\n"
 			     (riece-identity-prefix riece-current-channel)
-			     topic)))
+			     topic)
+		     riece-current-channel))
 
 (defun riece-command-invite (user)
   (interactive
@@ -227,7 +228,8 @@ the layout to the selected layout-name."
 	       user message)
      (format "KICK %s %s\r\n"
 	     (riece-identity-prefix riece-current-channel)
-	     user))))
+	     user))
+   riece-current-channel))
 
 (defun riece-command-names (pattern)
   (interactive
@@ -385,14 +387,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-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-current-channel)
     (riece-display-message
      (riece-make-message (riece-current-nickname) riece-current-channel
 			 message nil t))))
@@ -431,7 +435,8 @@ the layout to the selected layout-name."
 	       (riece-line-beginning-position)
 	       (riece-line-end-position))))
     (riece-send-string
-     (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text))
+     (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text)
+     user)
     (riece-display-message
      (riece-make-message (riece-current-nickname) user text nil t)))
   (let ((next-line-add-newlines t))
@@ -442,13 +447,13 @@ the layout to the selected layout-name."
     (unless process
       (error "%s" (substitute-command-keys
 		   "Type \\[riece-command-open-server] to open server.")))
-    (riece-process-send-string process
-			       (if key
-				   (format "JOIN %s :%s\r\n"
-					   (riece-identity-prefix target)
-					   key)
-				 (format "JOIN %s\r\n"
-					 (riece-identity-prefix target))))))
+    (riece-send-string (if key
+			   (format "JOIN %s :%s\r\n"
+				   (riece-identity-prefix target)
+				   key)
+			 (format "JOIN %s\r\n"
+				 (riece-identity-prefix target)))
+		       target)))
 
 (defun riece-command-join-partner (target)
   (let ((pointer (riece-identity-member target riece-current-channels)))
@@ -480,13 +485,13 @@ the layout to the selected layout-name."
 
 (defun riece-command-part-channel (target message)
   (let ((process (riece-server-process (riece-identity-server target))))
-    (riece-process-send-string process
-			       (if message
-				   (format "PART %s :%s\r\n"
-					   (riece-identity-prefix target)
-					   message)
-				 (format "PART %s\r\n"
-					 (riece-identity-prefix target))))))
+    (riece-send-string (if message
+			   (format "PART %s :%s\r\n"
+				   (riece-identity-prefix target)
+				   message)
+			 (format "PART %s\r\n"
+				 (riece-identity-prefix target)))
+		       target)))
 
 (defun riece-command-part (target &optional message)
   (interactive
diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el
index cf5e0be..53be6f2 100644
--- a/lisp/riece-handle.el
+++ b/lisp/riece-handle.el
@@ -78,26 +78,37 @@
 				 (riece-format-identity new-identity t)))
 			  "\n"))))
 
-(defun riece-handle-privmsg-message (prefix string)
+(defun riece-handle-privmsg-message (prefix decoded)
   (let* ((user (riece-prefix-nickname prefix))
-	 (parameters (riece-split-parameters string))
+	 (parameters (riece-split-parameters (riece-decoded-string decoded)))
 	 (targets (split-string (car parameters) ","))
-	 (message (nth 1 parameters)))
+	 message)
+    (setq parameters (riece-split-parameters
+		      (riece-decoded-string-for-identity
+		       decoded
+		       (riece-make-identity (car targets) riece-server-name)))
+	  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
+			 message
+			 nil
 			 (riece-identity-equal-no-server
 			  user riece-real-nickname)))))
 
-(defun riece-handle-notice-message (prefix string)
+(defun riece-handle-notice-message (prefix decoded)
   (let* ((user (if prefix
 		   (riece-prefix-nickname prefix)))
-	 (parameters (riece-split-parameters string))
+	 (parameters (riece-split-parameters (riece-decoded-string decoded)))
 	 (targets (split-string (car parameters) ","))
-	 (message (nth 1 parameters)))
+	 message)
+    (setq parameters (riece-split-parameters
+		      (riece-decoded-string-for-identity
+		       decoded
+		       (riece-make-identity (car targets) riece-server-name)))
+	  message (nth 1 parameters))
     (if user
 	(riece-display-message
 	 (riece-make-message (riece-make-identity user
@@ -152,18 +163,22 @@
 	  "\n")))
       (setq channels (cdr channels)))))
 
-(defun riece-handle-part-message (prefix string)
+(defun riece-handle-part-message (prefix decoded)
   (let* ((user (riece-prefix-nickname prefix))
-	 (parameters (riece-split-parameters string))
+	 (parameters (riece-split-parameters (riece-decoded-string decoded)))
 	 ;; RFC2812 3.2.2 doesn't recommend server to send part
 	 ;; messages which contain multiple targets.
 	 (channels (split-string (car parameters) ","))
-	 (message (nth 1 parameters))
 	 (user-identity (riece-make-identity user riece-server-name)))
     (while channels
       (let* ((channel-identity (riece-make-identity (car channels)
 						    riece-server-name))
-	     (buffer (riece-channel-buffer channel-identity)))
+	     (buffer (riece-channel-buffer channel-identity))
+	     message)
+	(setq parameters (riece-split-parameters
+			  (riece-decoded-string-for-identity decoded
+							     channel-identity))
+	      message (nth 1 parameters))
 	(riece-insert-change
 	 buffer
 	 (concat
@@ -189,15 +204,19 @@
       (riece-naming-assert-part user (car channels))
       (setq channels (cdr channels)))))
 
-(defun riece-handle-kick-message (prefix string)
+(defun riece-handle-kick-message (prefix decoded)
   (let* ((kicker (riece-prefix-nickname prefix))
-	 (parameters (riece-split-parameters string))
+	 (parameters (riece-split-parameters (riece-decoded-string decoded)))
 	 (channel (car parameters))
 	 (user (nth 1 parameters))
-	 (message (nth 2 parameters))
+	 message
 	 (kicker-identity (riece-make-identity kicker riece-server-name))
 	 (channel-identity (riece-make-identity channel riece-server-name))
 	 (user-identity (riece-make-identity user riece-server-name)))
+    (setq parameters (riece-split-parameters
+		      (riece-decoded-string-for-identity decoded
+							 channel-identity))
+	  message (nth 2 parameters))
     (riece-naming-assert-part user channel)
     (let ((buffer (riece-channel-buffer channel-identity)))
       (riece-insert-change
@@ -331,13 +350,17 @@
 	       (riece-format-identity channel-identity)))
       "\n"))))
 
-(defun riece-handle-topic-message (prefix string)
+(defun riece-handle-topic-message (prefix decoded)
   (let* ((user (riece-prefix-nickname prefix))
-	 (parameters (riece-split-parameters string))
+	 (parameters (riece-split-parameters (riece-decoded-string decoded)))
 	 (channel (car parameters))
-	 (topic (nth 1 parameters))
+	 topic
 	 (user-identity (riece-make-identity user riece-server-name))
 	 (channel-identity (riece-make-identity channel riece-server-name)))
+    (setq parameters (riece-split-parameters
+		      (riece-decoded-string-for-identity decoded
+							 channel-identity))
+	  topic (nth 1 parameters))
     (riece-channel-set-topic (riece-get-channel channel) topic)
     (riece-emit-signal 'channel-topic-changed
 		       channel-identity topic)
diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el
index adada4c..deb1398 100644
--- a/lisp/riece-identity.el
+++ b/lisp/riece-identity.el
@@ -27,6 +27,12 @@
 (require 'riece-globals)
 (require 'riece-coding)
 
+(defcustom riece-channel-coding-system-alist nil
+  "An alist mapping from channels to coding-systems."
+  :type '(repeat (cons (string :tag "Channel")
+		       (symbol :tag "Coding system")))
+  :group 'riece-coding)
+
 (defvar riece-abbrev-identity-string-function nil)
 (defvar riece-expand-identity-string-function nil)
 
@@ -184,6 +190,40 @@ The rest of arguments are the same as `completing-read'."
 ;;;      (error "Invalid channel name!"))
     identity))
 
+(defun riece-coding-system-for-identity (identity)
+  (let ((alist riece-channel-coding-system-alist)
+	matcher)
+    (catch 'found
+      (while alist
+	(setq matcher (riece-parse-identity (car (car alist))))
+	(if (and (equal (riece-identity-server matcher)
+			(riece-identity-server identity))
+		 (equal (riece-identity-prefix matcher)
+			(riece-identity-prefix identity)))
+	    (throw 'found (cdr (car alist))))
+	(setq alist (cdr alist))))))
+
+(defun riece-decoded-string-for-identity (decoded identity)
+  "Return the string decoded for IDENTITY."
+  (let ((coding-system (riece-coding-system-for-identity identity)))
+    (if (and coding-system
+	     (not (eq (riece-decoded-coding-system decoded)
+		      (if (consp coding-system)
+			  (car coding-system)
+			coding-system))))
+	(riece-decode-coding-string-1 (riece-decoded-encoded-string decoded)
+				      coding-system)
+      decoded)))
+
+(defun riece-encode-coding-string-for-identity (string identity)
+  (let ((coding-system (riece-coding-system-for-identity identity)))
+    (if coding-system
+	(encode-coding-string string
+			      (if (consp coding-system)
+				  (cdr coding-system)
+				coding-system))
+      (riece-encode-coding-string string))))
+
 (provide 'riece-identity)
 
 ;;; riece-identity.el ends here
diff --git a/lisp/riece-server.el b/lisp/riece-server.el
index 9ee0e90..be1c8a7 100644
--- a/lisp/riece-server.el
+++ b/lisp/riece-server.el
@@ -162,8 +162,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 +192,21 @@ the `riece-server-keyword-map' variable."
 	  (if (riece-server-opened "")
 	      "")))))
 
-(defun riece-send-string (string)
-  (let* ((server-name (riece-current-server-name))
-	 (process (riece-server-process server-name)))
+(defun riece-send-string (string &optional identity)
+  (let* ((server-name (if identity
+			  (riece-identity-server identity)
+			(riece-current-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
+     (with-current-buffer (process-buffer process)
+       (if identity
+	   (riece-encode-coding-string-for-identity string identity)
+	 (riece-encode-coding-string string))))))
 
 (defun riece-open-server (server server-name)
   (let ((protocol (or (plist-get server :protocol)