1 ;;; riece-message.el --- generate and display message line
2 ;; Copyright (C) 1999-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; This file is part of Riece.
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
26 (require 'riece-identity)
27 (require 'riece-channel)
29 (require 'riece-display)
32 (defgroup riece-message nil
38 (defcustom riece-message-filter-functions nil
39 "Functions to filter incoming messages."
41 :group 'riece-message)
43 (defcustom riece-message-make-open-bracket-function
44 #'riece-message-make-open-bracket
45 "Function which makes `open-bracket' string for each message."
47 :group 'riece-message)
49 (defcustom riece-message-make-close-bracket-function
50 #'riece-message-make-close-bracket
51 "Function which makes `close-bracket' string for each message."
53 :group 'riece-message)
55 (defcustom riece-message-make-name-function
56 #'riece-message-make-name
57 "Function which makes local identity for each message."
59 :group 'riece-message)
61 (defcustom riece-message-make-global-name-function
62 #'riece-message-make-global-name
63 "Function which makes global identity for each message."
65 :group 'riece-message)
67 (defcustom riece-message-format-function-alist nil
68 "Alist mapping message types to format functions."
70 :group 'riece-message)
72 (defun riece-message-make-open-bracket (message)
73 "Make `open-bracket' string for MESSAGE."
74 (if (eq (riece-message-type message) 'notice)
76 (if (riece-message-own-p message)
78 (if (riece-message-private-p message)
80 (if (riece-message-external-p message)
84 (defun riece-message-make-close-bracket (message)
85 "Make `close-bracket' string for MESSAGE."
86 (if (eq (riece-message-type message) 'notice)
88 (if (riece-message-own-p message)
90 (if (riece-message-private-p message)
92 (if (riece-message-external-p message)
96 (defun riece-message-make-name (message)
97 "Make local identity for MESSAGE."
98 (if (riece-message-private-p message)
99 (if (riece-message-own-p message)
100 (riece-format-identity (riece-message-target message) t)
101 (riece-format-identity (riece-message-speaker message) t))
102 (riece-format-identity (riece-message-speaker message) t)))
104 (defun riece-message-make-global-name (message)
105 "Make global identity for MESSAGE."
106 (if (riece-message-private-p message)
107 (if (riece-message-own-p message)
108 (riece-format-identity (riece-message-target message) t)
109 (riece-format-identity (riece-message-speaker message) t))
110 (concat (riece-format-identity (riece-message-target message) t) ":"
111 (riece-format-identity (riece-message-speaker message) t))))
113 (defun riece-message-buffer (message)
114 "Return the buffer where MESSAGE should appear."
115 (let ((target (if (riece-message-private-p message)
116 (if (riece-message-own-p message)
117 (riece-message-target message)
118 (riece-message-speaker message))
119 (riece-message-target message))))
120 (unless (riece-identity-member target riece-current-channels)
121 (riece-join-channel target)
122 ;; If you are not joined to any channel,
123 ;; switch to the target immediately.
124 (unless riece-current-channel
125 (riece-switch-to-channel target)))
126 (riece-channel-buffer target)))
128 (defun riece-message-parent-buffers (message buffer)
129 "Return the parents of BUFFER where MESSAGE should appear.
130 Normally they are *Dialogue* and/or *Others*."
131 (if (and buffer (riece-frozen buffer)) ;the message might not be
132 ;visible in buffer's window
133 (list riece-dialogue-buffer riece-others-buffer)
134 (if (and riece-current-channel ;the message is not sent to
136 (if (riece-message-private-p message)
137 (if (riece-message-own-p message)
138 (not (riece-identity-equal
139 (riece-message-target message)
140 riece-current-channel))
141 (not (riece-identity-equal
142 (riece-message-speaker message)
143 riece-current-channel)))
144 (not (riece-identity-equal
145 (riece-message-target message)
146 riece-current-channel))))
147 (list riece-dialogue-buffer riece-others-buffer)
148 riece-dialogue-buffer)))
150 (defun riece-format-message-1 (message &optional global)
152 (funcall riece-message-make-open-bracket-function message))
154 (funcall riece-message-make-close-bracket-function message))
157 (funcall riece-message-make-global-name-function message)
158 (funcall riece-message-make-name-function message)))
159 (server-name (riece-identity-server (riece-message-speaker message))))
160 (riece-with-server-buffer server-name
163 (riece-concat-server-name
164 (concat open-bracket name close-bracket
165 " " (riece-message-text message)))
166 (concat open-bracket name close-bracket
167 " " (riece-message-text message)))
170 (defun riece-format-message (message &optional global)
171 (funcall (or (cdr (assq (riece-message-type message)
172 riece-message-format-function-alist))
173 #'riece-format-message-1)
176 (defun riece-display-message-1 (message)
177 (let ((buffer (riece-message-buffer message))
180 (riece-message-own-p message)
181 (riece-own-frozen buffer))
182 (with-current-buffer buffer
183 (setq riece-freeze nil))
184 (riece-emit-signal 'buffer-freeze-changed buffer nil))
185 (setq parent-buffers (riece-message-parent-buffers message buffer))
186 (riece-insert buffer (riece-format-message message))
187 (riece-insert parent-buffers (riece-format-message message t))
188 (with-current-buffer buffer
189 (run-hook-with-args 'riece-after-display-message-functions message))))
191 (defun riece-display-message (message)
192 "Display MESSAGE object."
193 (let ((functions riece-message-filter-functions))
194 (setq message (copy-sequence message))
195 (while (and functions message)
196 (setq message (funcall (car functions) message)
197 functions (cdr functions)))
199 (riece-display-message-1 message))))
201 (defun riece-make-message (speaker target text &optional type own-p)
202 "Make an instance of message object.
203 Arguments are appropriate to the sender, the receiver, and text
204 content, respectively.
205 Optional 4th argument TYPE specifies the type of the message.
206 Currently possible values are `nil' or `notice'.
207 Optional 5th argument is the flag to indicate that this message is not
209 (vector speaker target text type own-p))
211 (defun riece-message-speaker (message)
212 "Return the sender of MESSAGE."
215 (defun riece-message-target (message)
216 "Return the receiver of MESSAGE."
219 (defun riece-message-text (message)
220 "Return the text part of MESSAGE."
223 (defun riece-message-type (message)
224 "Return the type of MESSAGE.
225 Currently possible values are `action' and `notice'."
228 (defun riece-message-own-p (message)
229 "Return t if MESSAGE is not from the network."
232 (defun riece-message-set-speaker (message speaker)
233 "Set the sender of MESSAGE."
234 (aset message 0 speaker))
236 (defun riece-message-set-target (message target)
237 "Set the receiver of MESSAGE."
238 (aset message 1 target))
240 (defun riece-message-set-text (message text)
241 "Set the text part of MESSAGE."
242 (aset message 2 text))
244 (defun riece-message-set-type (message type)
245 "Set the type of MESSAGE.
246 Currently possible values are `action' and `notice'."
247 (aset message 3 type))
249 (defun riece-message-set-own-p (message own-p)
250 "Set t if MESSAGE is not from the network."
251 (aset message 4 own-p))
253 (defun riece-message-private-p (message)
254 "Return t if MESSAGE is a private message."
255 (not (or (riece-channel-p (riece-identity-prefix
256 (riece-message-speaker message)))
257 (riece-channel-p (riece-identity-prefix
258 (riece-message-target message))))))
260 (defun riece-message-external-p (message)
261 "Return t if MESSAGE is from outside the channel."
262 (not (riece-identity-member
263 (riece-message-speaker message)
264 (let ((target (riece-message-target message)))
265 (riece-with-server-buffer (riece-identity-server target)
268 (riece-make-identity (car user) riece-server-name))
269 (riece-channel-get-users (riece-identity-prefix target))))))))
271 (provide 'riece-message)
273 ;;; riece-message.el ends here