From 6e989585d1652450dc5cfdfc2ae7aaa3d881c16b Mon Sep 17 00:00:00 2001 From: ueno Date: Sat, 4 Jun 2005 03:51:44 +0000 Subject: [PATCH] * 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. --- lisp/ChangeLog | 21 +++++++++++++++++++++ lisp/riece-coding.el | 27 ++++++++++++++++++++++++--- lisp/riece-commands.el | 6 ++++-- lisp/riece-globals.el | 3 +++ lisp/riece-handle.el | 24 ++++++++++++++++-------- lisp/riece-irc.el | 3 ++- lisp/riece-server.el | 23 +++++++++++++++++------ 7 files changed, 87 insertions(+), 20 deletions(-) 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 + + * 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 * 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))) -- 1.7.10.4