* riece-ctcp.el (riece-ctcp-action-format-message): New function.

(riece-handle-ctcp-action-request): Use it.
(riece-command-ctcp-action): Use it.

* riece-message.el (riece-message-format-function-alist): New user
option.
(riece-display-message-1): Pick a format function from
riece-message-format-function-alist.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e094a27..850dfca 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2007-04-18  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-ctcp.el (riece-ctcp-action-format-message): New function.
+       (riece-handle-ctcp-action-request): Use it.
+       (riece-command-ctcp-action): Use it.
+
+       * riece-message.el (riece-message-format-function-alist): New user
+       option.
+       (riece-display-message-1): Pick a format function from
+       riece-message-format-function-alist.
+
 2007-04-16  Daiki Ueno  <ueno@unixuser.org>
 
        * riece-rdcc.el (riece-rdcc-server-port): New user option.

diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el
index 8e47be0..854e416 100644 (file)
--- a/lisp/riece-ctcp.el
+++ b/lisp/riece-ctcp.el
@@ -170,32 +170,35 @@
               (riece-format-identity target-identity t)))
       "\n"))))
 
+(defun riece-ctcp-action-format-message (message &optional global)
+  (riece-with-server-buffer (riece-identity-server
+                            (riece-message-speaker message))
+    (concat
+     (if global
+        (riece-concat-server-name
+         (concat riece-ctcp-action-prefix
+                 (riece-format-identity (riece-message-target message) t) ": "
+                 (riece-identity-prefix (riece-message-speaker message)) " "
+                 (riece-message-text message)))
+       (concat riece-ctcp-action-prefix
+              (riece-identity-prefix (riece-message-speaker message)) " "
+              (riece-message-text message)))
+     "\n")))
+
 (defun riece-handle-ctcp-action-request (prefix target string)
   (let ((buffer (if (riece-channel-p target)
                    (riece-channel-buffer (riece-make-identity
                                           target riece-server-name))))
        (user (riece-prefix-nickname prefix)))
-    (riece-insert buffer (concat riece-ctcp-action-prefix
-                                (riece-format-identity
-                                 (riece-make-identity user riece-server-name)
-                                 t)
-                                " " string
-                                "\n"))
-    (riece-insert
-     (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
-             (concat riece-ctcp-action-prefix
-                     (riece-format-identity
-                      (riece-make-identity target riece-server-name)
-                      t)
-                     ": "
-                     (riece-format-identity
-                      (riece-make-identity user riece-server-name)
-                      t)
-                     " " string)) "\n"))))
+    (riece-display-message
+     (riece-make-message (riece-make-identity user
+                                             riece-server-name)
+                        (riece-make-identity target
+                                             riece-server-name)
+                        string
+                        'action
+                        (riece-identity-equal-no-server
+                         user riece-real-nickname)))))
 
 (defun riece-handle-ctcp-time-request (prefix target string)
   (let* ((target-identity (riece-make-identity target riece-server-name))
@@ -345,23 +348,8 @@
   (riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n"
                             (riece-identity-prefix target)
                             action))
-  (let ((buffer (riece-channel-buffer target)))
-    (riece-insert
-     buffer
-     (concat riece-ctcp-action-prefix
-            (riece-identity-prefix (riece-current-nickname)) " " action "\n"))
-    (riece-insert
-     (if (and riece-channel-buffer-mode
-             (not (eq buffer riece-channel-buffer)))
-        (list riece-dialogue-buffer riece-others-buffer)
-       riece-dialogue-buffer)
-     (concat
-      (riece-with-server-buffer (riece-identity-server target)
-       (riece-concat-server-name
-        (concat riece-ctcp-action-prefix
-                (riece-format-identity target t) ": "
-                (riece-identity-prefix (riece-current-nickname)) " " action)))
-      "\n"))))
+  (riece-display-message
+   (riece-make-message (riece-current-nickname) target action 'action t)))
 
 (defun riece-command-ctcp-time (target)
   (interactive
@@ -387,7 +375,11 @@
   (if (memq 'riece-highlight riece-addons)
       (setq riece-dialogue-font-lock-keywords
            (cons riece-ctcp-dialogue-font-lock-keywords
-                 riece-dialogue-font-lock-keywords))))
+                 riece-dialogue-font-lock-keywords)))
+  (unless (assq 'action riece-message-format-function-alist)
+    (setq riece-message-format-function-alist
+         (cons (cons 'action #'riece-ctcp-action-format-message)
+               riece-message-format-function-alist))))
 
 (defun riece-ctcp-uninstall ()
   (remove-hook 'riece-privmsg-hook 'riece-handle-ctcp-request)

diff --git a/lisp/riece-message.el b/lisp/riece-message.el
index e32c45f..df388f1 100644 (file)
--- a/lisp/riece-message.el
+++ b/lisp/riece-message.el
@@ -64,6 +64,11 @@
   :type 'function
   :group 'riece-message)
 
+(defcustom riece-message-format-function-alist nil
+  "Alist mapping message types to format functions."
+  :type 'list
+  :group 'riece-message)
+
 (defun riece-message-make-open-bracket (message)
   "Make `open-bracket' string for MESSAGE."
   (if (eq (riece-message-type message) 'notice)
@@ -164,6 +169,10 @@ Normally they are *Dialogue* and/or *Others*."
 
 (defun riece-display-message-1 (message)
   (let ((buffer (riece-message-buffer message))
+       (format-message-function
+        (or (cdr (assq (riece-message-type message)
+                       riece-message-format-function-alist))
+            #'riece-format-message))
        parent-buffers)
     (when (and buffer
               (riece-message-own-p message)
@@ -172,8 +181,8 @@ Normally they are *Dialogue* and/or *Others*."
        (setq riece-freeze nil))
       (riece-emit-signal 'buffer-freeze-changed buffer nil))
     (setq parent-buffers (riece-message-parent-buffers message buffer))
-    (riece-insert buffer (riece-format-message message))
-    (riece-insert parent-buffers (riece-format-message message t))
+    (riece-insert buffer (funcall format-message-function message))
+    (riece-insert parent-buffers (funcall format-message-function message t))
     (with-current-buffer buffer
       (run-hook-with-args 'riece-after-display-message-functions message))))
 
@@ -192,7 +201,7 @@ Normally they are *Dialogue* and/or *Others*."
 Arguments are appropriate to the sender, the receiver, and text
 content, respectively.
 Optional 4th argument TYPE specifies the type of the message.
-Currently possible values are `action' and `notice'.
+Currently possible values are `nil' or `notice'.
 Optional 5th argument is the flag to indicate that this message is not
 from the network."
   (vector speaker target text type own-p))