60702ebf35266cf246fb087b0defac9524dad21f
[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 (riece-message-own-p message)
70       ">"
71     (if (eq (riece-message-type message) 'notice)
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 (riece-message-own-p message)
82       "<"
83     (if (eq (riece-message-type message) 'notice)
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 any channel,
118       ;; switch to the target immediately.
119       (unless riece-current-channel
120         (riece-switch-to-channel target))
121       (riece-redisplay-buffers))
122     (riece-channel-buffer target)))
123
124 (defun riece-message-parent-buffers (message buffer)
125   "Return the parents of BUFFER where MESSAGE should appear.
126 Normally they are *Dialogue* and/or *Others*."
127   (if (and buffer (riece-frozen buffer)) ;the message might not be
128                                          ;visible in buffer's window
129       (list riece-dialogue-buffer riece-others-buffer)
130     (if (and riece-current-channel      ;the message is not sent to
131                                         ;the current channel
132              (if (riece-message-private-p message)
133                  (if (riece-message-own-p message)
134                      (not (riece-identity-equal
135                            (riece-message-target message)
136                            riece-current-channel))
137                    (not (riece-identity-equal
138                          (riece-message-speaker message)
139                          riece-current-channel)))
140                (not (riece-identity-equal
141                      (riece-message-target message)
142                      riece-current-channel))))
143         (list riece-dialogue-buffer riece-others-buffer)
144       riece-dialogue-buffer)))
145
146 (defun riece-display-message-1 (message)
147   (let ((open-bracket
148          (funcall riece-message-make-open-bracket-function message))
149         (close-bracket
150          (funcall riece-message-make-close-bracket-function message))
151         (name
152          (funcall riece-message-make-name-function message))
153         (global-name
154          (funcall riece-message-make-global-name-function message))
155         (buffer (riece-message-buffer message))
156         (server-name (riece-identity-server (riece-message-speaker message)))
157         parent-buffers)
158     (when (and buffer
159                (riece-message-own-p message)
160                (riece-own-frozen buffer))
161       (with-current-buffer buffer
162         (setq riece-freeze nil))
163       (riece-update-status-indicators))
164     (setq parent-buffers (riece-message-parent-buffers message buffer))
165     (riece-insert buffer
166                   (concat open-bracket name close-bracket
167                           " " (riece-message-text message) "\n"))
168     (riece-insert parent-buffers
169                   (if (equal server-name "")
170                       (concat open-bracket global-name close-bracket
171                               " " (riece-message-text message) "\n")
172                      (concat open-bracket global-name close-bracket
173                              " " (riece-message-text message)
174                              " (from " server-name ")\n")))
175     (run-hook-with-args 'riece-after-display-message-functions message)))
176
177 (defun riece-display-message (message)
178   "Display MESSAGE object."
179   (let ((functions riece-message-filter-functions))
180     (setq message (copy-sequence message))
181     (while functions
182       (setq message (funcall (car functions) message)
183             functions (cdr functions)))
184     (if message
185         (riece-display-message-1 message))))
186
187 (defun riece-make-message (speaker target text &optional type own-p)
188   "Make an instance of message object.
189 Arguments are appropriate to the sender, the receiver, and text
190 content, respectively.
191 Optional 4th argument TYPE specifies the type of the message.
192 Currently possible values are `action' and `notice'.
193 Optional 5th argument is the flag to indicate that this message is not
194 from the network."
195   (vector speaker target text type own-p))
196
197 (defun riece-message-speaker (message)
198   "Return the sender of MESSAGE."
199   (aref message 0))
200
201 (defun riece-message-target (message)
202   "Return the receiver of MESSAGE."
203   (aref message 1))
204
205 (defun riece-message-text (message)
206   "Return the text part of MESSAGE."
207   (aref message 2))
208
209 (defun riece-message-type (message)
210   "Return the type of MESSAGE.
211 Currently possible values are `action' and `notice'."
212   (aref message 3))
213
214 (defun riece-message-own-p (message)
215   "Return t if MESSAGE is not from the network."
216   (aref message 4))
217
218 (defun riece-message-private-p (message)
219   "Return t if MESSAGE is a private message."
220   (not (or (riece-channel-p (riece-identity-prefix
221                              (riece-message-speaker message)))
222            (riece-channel-p (riece-identity-prefix
223                              (riece-message-target message))))))
224
225 (defun riece-message-external-p (message)
226   "Return t if MESSAGE is from outside the channel."
227   (not (riece-identity-member
228         (riece-message-speaker message)
229         (let ((target (riece-message-target message)))
230           (riece-with-server-buffer (riece-identity-server target)
231             (mapcar
232              (lambda (user)
233                (riece-make-identity user riece-server-name))
234              (riece-channel-get-users (riece-identity-prefix target))))))))
235
236 (provide 'riece-message)
237
238 ;;; riece-message.el ends here