;;; Code:
-(eval-when-compile (require 'riece-inlines))
-
(require 'riece-identity)
(require 'riece-channel)
(require 'riece-user)
: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."
: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 (riece-message-own-p message)
+ ">"
+ (if (eq (riece-message-type message) 'notice)
+ "{"
+ (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)
- ")"
- ">"))))
+ "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) 'action)
- "["
- (if (riece-message-private-p message)
- (if (riece-message-own-p message)
- "<"
- "=")
- (if (riece-message-external-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,
;; 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))
-
-(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)))
+ (list riece-dialogue-buffer riece-others-buffer)
+ riece-dialogue-buffer)))
+
+(defun riece-display-message-1 (message)
+ (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)))
+ 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
(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"))
+ (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)))
+(defun riece-display-message (message)
+ "Display MESSAGE object."
+ (let ((functions riece-message-filter-functions))
+ (setq message (copy-sequence message))
+ (while functions
+ (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.
Arguments are appropriate to the sender, the receiver, and text
(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)