X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-message.el;h=c943e50ce5910c359fe93f020115041984a56080;hp=6acb78e15a02f43b5c96c32ac20cfbdc15a0f49c;hb=9a40faf27d1ddc378072d9a78dae747f44fc757a;hpb=fe7ce5e9a344721b1ecdd4d9ec1adce5dc908a49

diff --git a/lisp/riece-message.el b/lisp/riece-message.el
index 6acb78e..c943e50 100644
--- a/lisp/riece-message.el
+++ b/lisp/riece-message.el
@@ -23,8 +23,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'riece-inlines))
-
 (require 'riece-identity)
 (require 'riece-channel)
 (require 'riece-user)
@@ -37,6 +35,11 @@
   :prefix "riece-"
   :group 'riece)
 
+(defcustom riece-message-filter-functions nil
+  "Functions to filter incoming messages."
+  :type 'function
+  :group 'riece-message)
+
 (defcustom riece-message-make-open-bracket-function
   #'riece-message-make-open-bracket
   "Function which makes `open-bracket' string for each message."
@@ -62,108 +65,127 @@
   :group 'riece-message)
 
 (defun riece-message-make-open-bracket (message)
-  "Makes `open-bracket' string for MESSAGE."
-  (riece-message-make-bracket message t))
+  "Make `open-bracket' string for MESSAGE."
+  (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)
+	    "("
+	  "<")))))
 
 (defun riece-message-make-close-bracket (message)
-  "Makes `close-bracket' string for MESSAGE."
-  (riece-message-make-bracket message nil))
-
-(defun riece-message-make-bracket (message open-p)
-  (if (eq open-p (riece-message-own-p message))
-      (if (eq (riece-message-type message) 'notice)
-	  "-"
-	(if (eq (riece-message-type message) 'action)
-	    "]"
-	  (if (riece-message-private-p message)
-	      (if (riece-message-own-p message)
-		  ">"
-		"=")
-	    (if (riece-message-external-p message)
-		")"
-	      ">"))))
-    (if (eq (riece-message-type message) 'notice)
-	"-"
-      (if (eq (riece-message-type message) 'action)
-	  "["
-	(if (riece-message-private-p message)
-	    (if (riece-message-own-p message)
-		  "<"
-	      "=")
-	  (if (riece-message-external-p message)
-	      "("
-	    "<"))))))
+  "Make `close-bracket' string for MESSAGE."
+  (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)
+	    ")"
+	  ">")))))
 
 (defun riece-message-make-name (message)
-  "Makes local identity for MESSAGE."
-  (riece-identity-prefix
-   (if (and (riece-message-private-p message)
-	    (riece-message-own-p message))
-       (riece-message-target message)
-     (riece-message-speaker message))))
+  "Make local identity for MESSAGE."
+  (if (riece-message-private-p message)
+      (if (riece-message-own-p message)
+	  (riece-format-identity (riece-message-target message) t)
+	(riece-format-identity (riece-message-speaker message) t))
+    (riece-format-identity (riece-message-speaker message) t)))
 
 (defun riece-message-make-global-name (message)
-  "Makes global identity for MESSAGE."
+  "Make global identity for MESSAGE."
   (if (riece-message-private-p message)
       (if (riece-message-own-p message)
-	  (riece-identity-prefix (riece-message-target message))
-	(riece-identity-prefix (riece-message-speaker message)))
-    (concat (riece-identity-prefix (riece-message-target message)) ":"
-	    (riece-identity-prefix (riece-message-speaker message)))))
+	  (riece-format-identity (riece-message-target message) t)
+	(riece-format-identity (riece-message-speaker message) t))
+    (concat (riece-format-identity (riece-message-target message) t) ":"
+	    (riece-format-identity (riece-message-speaker message) t))))
 
 (defun riece-message-buffer (message)
   "Return the buffer where MESSAGE should appear."
-  (let* ((target (if (riece-identity-equal-no-server
-		      (riece-message-target message)
-		      (riece-current-nickname))
-		     (riece-message-speaker message)
-		   (riece-message-target message)))
-	 (entry (riece-identity-assoc-no-server
-		 target riece-channel-buffer-alist)))
-    (unless entry
+  (let ((target (if (riece-message-private-p message)
+		    (if (riece-message-own-p message)
+			(riece-message-target message)
+		      (riece-message-speaker message))
+		  (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
-	(riece-switch-to-channel target))
-      (riece-redisplay-buffers)
-      (setq entry (riece-identity-assoc-no-server
-		   target riece-channel-buffer-alist)))
-    (cdr entry)))
+	(riece-switch-to-channel target)))
+    (riece-channel-buffer target)))
 
 (defun riece-message-parent-buffers (message buffer)
   "Return the parents of BUFFER where MESSAGE should appear.
 Normally they are *Dialogue* and/or *Others*."
-  (if (or (and buffer (riece-frozen buffer))
-	  (and riece-current-channel
-	       (not (riece-identity-equal-no-server
+  (if (and buffer (riece-frozen buffer)) ;the message might not be
+					 ;visible in buffer's window
+      (list riece-dialogue-buffer riece-others-buffer)
+    (if (and riece-current-channel	;the message is not sent to
+					;the current channel
+	     (if (riece-message-private-p message)
+		 (if (riece-message-own-p message)
+		     (not (riece-identity-equal
+			   (riece-message-target message)
+			   riece-current-channel))
+		   (not (riece-identity-equal
+			 (riece-message-speaker message)
+			 riece-current-channel)))
+	       (not (riece-identity-equal
 		     (riece-message-target message)
 		     riece-current-channel))))
-      (list riece-dialogue-buffer riece-others-buffer)
-    riece-dialogue-buffer))
+	(list riece-dialogue-buffer riece-others-buffer)
+      riece-dialogue-buffer)))
+
+(defun riece-format-message (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
+	 (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-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))
+      (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))
+    (with-current-buffer buffer
+      (run-hook-with-args 'riece-after-display-message-functions message))))
 
 (defun riece-display-message (message)
   "Display MESSAGE object."
-  (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))
-	 (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
-		  (concat
-		   (riece-concat-server-name
-		    (concat open-bracket global-name close-bracket
-			    " " (riece-message-text message)))
-		   "\n"))
-    (run-hook-with-args 'riece-after-display-message-functions message)))
+  (let ((functions riece-message-filter-functions))
+    (setq message (copy-sequence message))
+    (while (and functions message)
+      (setq message (funcall (car functions) message)
+	    functions (cdr functions)))
+    (if message
+	(riece-display-message-1 message))))
 
 (defun riece-make-message (speaker target text &optional type own-p)
   "Make an instance of message object.
@@ -196,27 +218,44 @@ Currently possible values are `action' and `notice'."
   "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."
-  (if (riece-message-own-p message)
-      (not (riece-channel-p (riece-message-target message)))
-    (riece-identity-equal-no-server
-     (riece-message-target message)
-     (riece-current-nickname))))
+  (not (or (riece-channel-p (riece-identity-prefix
+			     (riece-message-speaker message)))
+	   (riece-channel-p (riece-identity-prefix
+			     (riece-message-target message))))))
 
 (defun riece-message-external-p (message)
   "Return t if MESSAGE is from outside the channel."
-  (not (riece-identity-member-no-server
-	(riece-message-target message)
-	(mapcar #'riece-make-identity
-		(riece-user-get-channels (riece-message-speaker message))))))
-
-(defun riece-own-channel-message (message &optional channel type)
-  "Display MESSAGE as you sent to CHNL."
-  (riece-display-message
-   (riece-make-message (riece-current-nickname)
-		       (or channel riece-current-channel)
-		       message type t)))
+  (not (riece-identity-member
+	(riece-message-speaker message)
+	(let ((target (riece-message-target message)))
+	  (riece-with-server-buffer (riece-identity-server target)
+	    (mapcar
+	     (lambda (user)
+	       (riece-make-identity (car user) riece-server-name))
+	     (riece-channel-get-users (riece-identity-prefix target))))))))
 
 (provide 'riece-message)