From db33cfdd5cabbc8dac9474d0ebd6cae41d99500e Mon Sep 17 00:00:00 2001 From: ueno Date: Mon, 29 Aug 2005 06:02:58 +0000 Subject: [PATCH] Merge channel-coding branch. --- NEWS | 9 ++++- NEWS.ja | 8 +++- lisp/ChangeLog | 67 ++++++++++++++++++++++++++++++++++ lisp/riece-300.el | 95 +++++++++++++++++++++++++----------------------- lisp/riece-coding.el | 30 +++++++++++++-- lisp/riece-commands.el | 43 ++++++++++++---------- lisp/riece-handle.el | 57 ++++++++++++++++++++--------- lisp/riece-identity.el | 40 ++++++++++++++++++++ lisp/riece-server.el | 19 +++++++--- 9 files changed, 275 insertions(+), 93 deletions(-) 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 + + * 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 + + * 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 + + * 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 * 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 + + * 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-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) -- 1.7.10.4