* riece-message.el (riece-display-message): When filter-function
[riece] / lisp / riece-message.el
1 ;;; riece-message.el --- generate and display message line
2 ;; Copyright (C) 1999-2003 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: message
6
7 ;; This file is part of Riece.
8
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)
12 ;; any later version.
13
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.
18
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., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Code:
25
26 (require 'riece-identity)
27 (require 'riece-channel)
28 (require 'riece-user)
29 (require 'riece-display)
30 (require 'riece-misc)
31
32 (defgroup riece-message nil
33   "Messages"
34   :tag "Message"
35   :prefix "riece-"
36   :group 'riece)
37
38 (defcustom riece-message-filter-functions nil
39   "Functions to filter incoming messages."
40   :type 'function
41   :group 'riece-message)
42
43 (defcustom riece-message-make-open-bracket-function
44   #'riece-message-make-open-bracket
45   "Function which makes `open-bracket' string for each message."
46   :type 'function
47   :group 'riece-message)
48
49 (defcustom riece-message-make-close-bracket-function
50   #'riece-message-make-close-bracket
51   "Function which makes `close-bracket' string for each message."
52   :type 'function
53   :group 'riece-message)
54
55 (defcustom riece-message-make-name-function
56   #'riece-message-make-name
57   "Function which makes local identity for each message."
58   :type 'function
59   :group 'riece-message)
60
61 (defcustom riece-message-make-global-name-function
62   #'riece-message-make-global-name
63   "Function which makes global identity for each message."
64   :type 'function
65   :group 'riece-message)
66
67 (defun riece-message-make-open-bracket (message)
68   "Make `open-bracket' string for MESSAGE."
69   (if (eq (riece-message-type message) 'notice)
70       "{"
71     (if (riece-message-own-p message)
72         ">"
73       (if (riece-message-private-p message)
74           "="
75         (if (riece-message-external-p message)
76             "("
77           "<")))))
78
79 (defun riece-message-make-close-bracket (message)
80   "Make `close-bracket' string for MESSAGE."
81   (if (eq (riece-message-type message) 'notice)
82       "}"
83     (if (riece-message-own-p message)
84         "<"
85       (if (riece-message-private-p message)
86           "="
87         (if (riece-message-external-p message)
88             ")"
89           ">")))))
90
91 (defun riece-message-make-name (message)
92   "Make local identity for MESSAGE."
93   (if (riece-message-private-p message)
94       (if (riece-message-own-p message)
95           (riece-format-identity (riece-message-target message) t)
96         (riece-format-identity (riece-message-speaker message) t))
97     (riece-format-identity (riece-message-speaker message) t)))
98
99 (defun riece-message-make-global-name (message)
100   "Make global identity for MESSAGE."
101   (if (riece-message-private-p message)
102       (if (riece-message-own-p message)
103           (riece-format-identity (riece-message-target message) t)
104         (riece-format-identity (riece-message-speaker message) t))
105     (concat (riece-format-identity (riece-message-target message) t) ":"
106             (riece-format-identity (riece-message-speaker message) t))))
107
108 (defun riece-message-buffer (message)
109   "Return the buffer where MESSAGE should appear."
110   (let ((target (if (riece-message-private-p message)
111                     (if (riece-message-own-p message)
112                         (riece-message-target message)
113                       (riece-message-speaker message))
114                   (riece-message-target message))))
115     (unless (riece-identity-member target riece-current-channels)
116       (riece-join-channel target)
117       ;; If you are not joined to any channel,
118       ;; switch to the target immediately.
119       (unless riece-current-channel
120         (riece-switch-to-channel target)))
121     (riece-channel-buffer target)))
122
123 (defun riece-message-parent-buffers (message buffer)
124   "Return the parents of BUFFER where MESSAGE should appear.
125 Normally they are *Dialogue* and/or *Others*."
126   (if (and buffer (riece-frozen buffer)) ;the message might not be
127                                          ;visible in buffer's window
128       (list riece-dialogue-buffer riece-others-buffer)
129     (if (and riece-current-channel      ;the message is not sent to
130                                         ;the current channel
131              (if (riece-message-private-p message)
132                  (if (riece-message-own-p message)
133                      (not (riece-identity-equal
134                            (riece-message-target message)
135                            riece-current-channel))
136                    (not (riece-identity-equal
137                          (riece-message-speaker message)
138                          riece-current-channel)))
139                (not (riece-identity-equal
140                      (riece-message-target message)
141                      riece-current-channel))))
142         (list riece-dialogue-buffer riece-others-buffer)
143       riece-dialogue-buffer)))
144
145 (defun riece-format-message (message &optional global)
146   (let ((open-bracket
147          (funcall riece-message-make-open-bracket-function message))
148         (close-bracket
149          (funcall riece-message-make-close-bracket-function message))
150         (name
151          (if global
152              (funcall riece-message-make-global-name-function message)
153            (funcall riece-message-make-name-function message)))
154         (server-name (riece-identity-server (riece-message-speaker message))))
155     (riece-with-server-buffer server-name
156       (concat
157        (if global
158            (riece-concat-server-name
159             (concat open-bracket name close-bracket
160                     " " (riece-message-text message)))
161          (concat open-bracket name close-bracket
162                  " " (riece-message-text message)))
163        "\n"))))
164
165 (defun riece-display-message-1 (message)
166   (let ((buffer (riece-message-buffer message))
167         parent-buffers)
168     (when (and buffer
169                (riece-message-own-p message)
170                (riece-own-frozen buffer))
171       (with-current-buffer buffer
172         (setq riece-freeze nil))
173       (riece-emit-signal 'buffer-freeze-changed buffer nil))
174     (setq parent-buffers (riece-message-parent-buffers message buffer))
175     (riece-insert buffer (riece-format-message message))
176     (riece-insert parent-buffers (riece-format-message message t))
177     (with-current-buffer buffer
178       (run-hook-with-args 'riece-after-display-message-functions message))))
179
180 (defun riece-display-message (message)
181   "Display MESSAGE object."
182   (let ((functions riece-message-filter-functions))
183     (setq message (copy-sequence message))
184     (while (and functions message)
185       (setq message (funcall (car functions) message)
186             functions (cdr functions)))
187     (if message
188         (riece-display-message-1 message))))
189
190 (defun riece-make-message (speaker target text &optional type own-p)
191   "Make an instance of message object.
192 Arguments are appropriate to the sender, the receiver, and text
193 content, respectively.
194 Optional 4th argument TYPE specifies the type of the message.
195 Currently possible values are `action' and `notice'.
196 Optional 5th argument is the flag to indicate that this message is not
197 from the network."
198   (vector speaker target text type own-p))
199
200 (defun riece-message-speaker (message)
201   "Return the sender of MESSAGE."
202   (aref message 0))
203
204 (defun riece-message-target (message)
205   "Return the receiver of MESSAGE."
206   (aref message 1))
207
208 (defun riece-message-text (message)
209   "Return the text part of MESSAGE."
210   (aref message 2))
211
212 (defun riece-message-type (message)
213   "Return the type of MESSAGE.
214 Currently possible values are `action' and `notice'."
215   (aref message 3))
216
217 (defun riece-message-own-p (message)
218   "Return t if MESSAGE is not from the network."
219   (aref message 4))
220
221 (defun riece-message-set-speaker (message speaker)
222   "Set the sender of MESSAGE."
223   (aset message 0 speaker))
224
225 (defun riece-message-set-target (message target)
226   "Set the receiver of MESSAGE."
227   (aset message 1 target))
228
229 (defun riece-message-set-text (message text)
230   "Set the text part of MESSAGE."
231   (aset message 2 text))
232
233 (defun riece-message-set-type (message type)
234   "Set the type of MESSAGE.
235 Currently possible values are `action' and `notice'."
236   (aset message 3 type))
237
238 (defun riece-message-set-own-p (message own-p)
239   "Set t if MESSAGE is not from the network."
240   (aset message 4 own-p))
241
242 (defun riece-message-private-p (message)
243   "Return t if MESSAGE is a private message."
244   (not (or (riece-channel-p (riece-identity-prefix
245                              (riece-message-speaker message)))
246            (riece-channel-p (riece-identity-prefix
247                              (riece-message-target message))))))
248
249 (defun riece-message-external-p (message)
250   "Return t if MESSAGE is from outside the channel."
251   (not (riece-identity-member
252         (riece-message-speaker message)
253         (let ((target (riece-message-target message)))
254           (riece-with-server-buffer (riece-identity-server target)
255             (mapcar
256              (lambda (user)
257                (riece-make-identity (car user) riece-server-name))
258              (riece-channel-get-users (riece-identity-prefix target))))))))
259
260 (provide 'riece-message)
261
262 ;;; riece-message.el ends here