X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-message.el;h=e32c45f28fbf8347864dd8fcc88fe946591ee749;hb=419476bd3456c9ed74f1fb01c12c565737365173;hp=8a20efb049fe763496aa8d6b2a2c3dca8c925453;hpb=005a2a7642c9f43d699922799801124a77d56f5d;p=riece diff --git a/lisp/riece-message.el b/lisp/riece-message.el index 8a20efb..e32c45f 100644 --- a/lisp/riece-message.el +++ b/lisp/riece-message.el @@ -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 -;; 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: @@ -30,11 +30,16 @@ (require 'riece-misc) (defgroup riece-message nil - "Messages" + "Display messages." :tag "Message" :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." @@ -61,10 +66,10 @@ (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) @@ -73,10 +78,10 @@ (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) @@ -109,12 +114,11 @@ (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)) - (riece-channel-buffer-name target))) + (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. @@ -138,37 +142,50 @@ Normally they are *Dialogue* and/or *Others*." (list riece-dialogue-buffer riece-others-buffer) riece-dialogue-buffer))) -(defun riece-display-message (message) - "Display MESSAGE object." +(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 - (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-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-update-status-indicators)) + (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 - (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)) + (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. @@ -201,6 +218,27 @@ 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." (not (or (riece-channel-p (riece-identity-prefix @@ -216,7 +254,7 @@ Currently possible values are `action' and `notice'." (riece-with-server-buffer (riece-identity-server target) (mapcar (lambda (user) - (riece-make-identity user riece-server-name)) + (riece-make-identity (car user) riece-server-name)) (riece-channel-get-users (riece-identity-prefix target)))))))) (provide 'riece-message)