X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-message.el;h=6bbd35fcb3357582fde49ca957c046ecca59202b;hp=f2312adf9a1d179e9c082258a71776011a735f7f;hb=06192de2dfd91f1db9a11666fea57819be49a675;hpb=a5e19c37af7b4d289e9b8fe0c44c223305322a38 diff --git a/lisp/riece-message.el b/lisp/riece-message.el index f2312ad..6bbd35f 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,104 +65,126 @@ :group 'riece-message) (defun riece-message-make-open-bracket (message) - "Makes `open-bracket' string for MESSAGE." - (riece-message-make-bracket message t)) - -(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 (riece-message-private-p message) - (if (riece-message-own-p message) - ">" - "=") - (if (riece-message-external-p message) - ")" - ">"))) + "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-own-p message) - "<" - "=") + "=" (if (riece-message-external-p 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 (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)) + (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 (riece-current-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)) + (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 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. @@ -194,25 +219,21 @@ Currently possible values are `action' and `notice'." (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)