Fix error on make update-mcat.
[riece] / lisp / riece-message.el
index c50aa1d..ba156a4 100644 (file)
@@ -18,8 +18,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
 
 ;;; Code:
 
@@ -30,7 +30,7 @@
 (require 'riece-misc)
 
 (defgroup riece-message nil
 (require 'riece-misc)
 
 (defgroup riece-message nil
-  "Messages"
+  "Display messages."
   :tag "Message"
   :prefix "riece-"
   :group 'riece)
   :tag "Message"
   :prefix "riece-"
   :group 'riece)
   :type 'function
   :group 'riece-message)
 
   :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."
 (defun riece-message-make-open-bracket (message)
   "Make `open-bracket' string for MESSAGE."
-  (if (riece-message-own-p message)
-      ">"
-    (if (eq (riece-message-type message) 'notice)
-       "{"
+  (if (eq (riece-message-type message) 'notice)
+      "{"
+    (if (riece-message-own-p message)
+       ">"
       (if (riece-message-private-p message)
          "="
        (if (riece-message-external-p message)
       (if (riece-message-private-p message)
          "="
        (if (riece-message-external-p message)
 
 (defun riece-message-make-close-bracket (message)
   "Make `close-bracket' string for MESSAGE."
 
 (defun riece-message-make-close-bracket (message)
   "Make `close-bracket' string for MESSAGE."
-  (if (riece-message-own-p message)
-      "<"
-    (if (eq (riece-message-type message) 'notice)
-       "}"
+  (if (eq (riece-message-type message) 'notice)
+      "}"
+    (if (riece-message-own-p message)
+       "<"
       (if (riece-message-private-p message)
          "="
        (if (riece-message-external-p message)
       (if (riece-message-private-p message)
          "="
        (if (riece-message-external-p message)
                  (riece-message-target message))))
     (unless (riece-identity-member target riece-current-channels)
       (riece-join-channel target)
                  (riece-message-target message))))
     (unless (riece-identity-member target riece-current-channels)
       (riece-join-channel target)
-      ;; If you are not joined any channel,
+      ;; If you are not joined to any channel,
       ;; switch to the target immediately.
       (unless riece-current-channel
       ;; switch to the target immediately.
       (unless riece-current-channel
-       (riece-switch-to-channel target))
-      (riece-redisplay-buffers))
+       (riece-switch-to-channel target)))
     (riece-channel-buffer target)))
 
 (defun riece-message-parent-buffers (message buffer)
     (riece-channel-buffer target)))
 
 (defun riece-message-parent-buffers (message buffer)
@@ -143,42 +147,52 @@ Normally they are *Dialogue* and/or *Others*."
        (list riece-dialogue-buffer riece-others-buffer)
       riece-dialogue-buffer)))
 
        (list riece-dialogue-buffer riece-others-buffer)
       riece-dialogue-buffer)))
 
-(defun riece-display-message-1 (message)
+(defun riece-format-message-1 (message &optional global)
   (let ((open-bracket
         (funcall riece-message-make-open-bracket-function message))
        (close-bracket
         (funcall riece-message-make-close-bracket-function message))
        (name
   (let ((open-bracket
         (funcall riece-message-make-open-bracket-function message))
        (close-bracket
         (funcall riece-message-make-close-bracket-function message))
        (name
-        (funcall riece-message-make-name-function message))
-       (global-name
-        (funcall riece-message-make-global-name-function message))
-       (buffer (riece-message-buffer message))
-       (server-name (riece-identity-server (riece-message-speaker message)))
+        (if global
+            (funcall riece-message-make-global-name-function message)
+          (funcall riece-message-make-name-function message)))
+       (server-name (riece-identity-server (riece-message-speaker message))))
+    (riece-with-server-buffer server-name
+      (concat
+       (if global
+          (riece-concat-server-name
+           (concat open-bracket name close-bracket
+                   " " (riece-message-text message)))
+        (concat open-bracket name close-bracket
+                " " (riece-message-text message)))
+       "\n"))))
+
+(defun riece-format-message (message &optional global)
+  (funcall (or (cdr (assq (riece-message-type message)
+                         riece-message-format-function-alist))
+              #'riece-format-message-1)
+          message global))
+
+(defun riece-display-message-1 (message)
+  (let ((buffer (riece-message-buffer message))
        parent-buffers)
     (when (and buffer
               (riece-message-own-p message)
               (riece-own-frozen buffer))
       (with-current-buffer buffer
        (setq riece-freeze nil))
        parent-buffers)
     (when (and buffer
               (riece-message-own-p message)
               (riece-own-frozen buffer))
       (with-current-buffer buffer
        (setq riece-freeze nil))
-      (riece-update-status-indicators))
+      (riece-emit-signal 'buffer-freeze-changed buffer nil))
     (setq parent-buffers (riece-message-parent-buffers message buffer))
     (setq parent-buffers (riece-message-parent-buffers message buffer))
-    (riece-insert buffer
-                 (concat open-bracket name close-bracket
-                         " " (riece-message-text message) "\n"))
-    (riece-insert parent-buffers
-                 (if (equal server-name "")
-                     (concat open-bracket global-name close-bracket
-                             " " (riece-message-text message) "\n")
-                    (concat open-bracket global-name close-bracket
-                            " " (riece-message-text message)
-                            " (from " server-name ")\n")))
-    (run-hook-with-args 'riece-after-display-message-functions message)))
+    (riece-insert buffer (riece-format-message message))
+    (riece-insert parent-buffers (riece-format-message message t))
+    (with-current-buffer buffer
+      (run-hook-with-args 'riece-after-display-message-functions message))))
 
 (defun riece-display-message (message)
   "Display MESSAGE object."
   (let ((functions riece-message-filter-functions))
     (setq message (copy-sequence message))
 
 (defun riece-display-message (message)
   "Display MESSAGE object."
   (let ((functions riece-message-filter-functions))
     (setq message (copy-sequence message))
-    (while functions
+    (while (and functions message)
       (setq message (funcall (car functions) message)
            functions (cdr functions)))
     (if message
       (setq message (funcall (car functions) message)
            functions (cdr functions)))
     (if message
@@ -189,7 +203,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.
 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))
 Optional 5th argument is the flag to indicate that this message is not
 from the network."
   (vector speaker target text type own-p))
@@ -215,6 +229,27 @@ Currently possible values are `action' and `notice'."
   "Return t if MESSAGE is not from the network."
   (aref message 4))
 
   "Return t if MESSAGE is not from the network."
   (aref message 4))
 
+(defun riece-message-set-speaker (message speaker)
+  "Set the sender of MESSAGE."
+  (aset message 0 speaker))
+
+(defun riece-message-set-target (message target)
+  "Set the receiver of MESSAGE."
+  (aset message 1 target))
+
+(defun riece-message-set-text (message text)
+  "Set the text part of MESSAGE."
+  (aset message 2 text))
+
+(defun riece-message-set-type (message type)
+  "Set the type of MESSAGE.
+Currently possible values are `action' and `notice'."
+  (aset message 3 type))
+
+(defun riece-message-set-own-p (message own-p)
+  "Set t if MESSAGE is not from the network."
+  (aset message 4 own-p))
+
 (defun riece-message-private-p (message)
   "Return t if MESSAGE is a private message."
   (not (or (riece-channel-p (riece-identity-prefix
 (defun riece-message-private-p (message)
   "Return t if MESSAGE is a private message."
   (not (or (riece-channel-p (riece-identity-prefix