cgit.sxemacs.org Git - riece/blob - 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., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, 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   "Display 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 (defcustom riece-message-format-function-alist nil
  68   "Alist mapping message types to format functions."
  69   :type 'list
  70   :group 'riece-message)
  71
  72 (defun riece-message-make-open-bracket (message)
  73   "Make `open-bracket' string for MESSAGE."
  74   (if (eq (riece-message-type message) 'notice)
  75       "{"
  76     (if (riece-message-own-p message)
  77         ">"
  78       (if (riece-message-private-p message)
  79           "="
  80         (if (riece-message-external-p message)
  81             "("
  82           "<")))))
  83
  84 (defun riece-message-make-close-bracket (message)
  85   "Make `close-bracket' string for MESSAGE."
  86   (if (eq (riece-message-type message) 'notice)
  87       "}"
  88     (if (riece-message-own-p message)
  89         "<"
  90       (if (riece-message-private-p message)
  91           "="
  92         (if (riece-message-external-p message)
  93             ")"
  94           ">")))))
  95
  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)))
 103
 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))))
 112
 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)))
 127
 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
 135                                         ;the current channel
 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)))
 149
 150 (defun riece-format-message-1 (message &optional global)
 151   (let ((open-bracket
 152          (funcall riece-message-make-open-bracket-function message))
 153         (close-bracket
 154          (funcall riece-message-make-close-bracket-function message))
 155         (name
 156          (if global
 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
 161       (concat
 162        (if global
 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)))
 168        "\n"))))
 169
 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)
 174            message global))
 175
 176 (defun riece-display-message-1 (message)
 177   (let ((buffer (riece-message-buffer message))
 178         parent-buffers)
 179     (when (and buffer
 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))))
 190
 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)))
 198     (if message
 199         (riece-display-message-1 message))))
 200
 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
 208 from the network."
 209   (vector speaker target text type own-p))
 210
 211 (defun riece-message-speaker (message)
 212   "Return the sender of MESSAGE."
 213   (aref message 0))
 214
 215 (defun riece-message-target (message)
 216   "Return the receiver of MESSAGE."
 217   (aref message 1))
 218
 219 (defun riece-message-text (message)
 220   "Return the text part of MESSAGE."
 221   (aref message 2))
 222
 223 (defun riece-message-type (message)
 224   "Return the type of MESSAGE.
 225 Currently possible values are `action' and `notice'."
 226   (aref message 3))
 227
 228 (defun riece-message-own-p (message)
 229   "Return t if MESSAGE is not from the network."
 230   (aref message 4))
 231
 232 (defun riece-message-set-speaker (message speaker)
 233   "Set the sender of MESSAGE."
 234   (aset message 0 speaker))
 235
 236 (defun riece-message-set-target (message target)
 237   "Set the receiver of MESSAGE."
 238   (aset message 1 target))
 239
 240 (defun riece-message-set-text (message text)
 241   "Set the text part of MESSAGE."
 242   (aset message 2 text))
 243
 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))
 248
 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))
 252
 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))))))
 259
 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)
 266             (mapcar
 267              (lambda (user)
 268                (riece-make-identity (car user) riece-server-name))
 269              (riece-channel-get-users (riece-identity-prefix target))))))))
 270
 271 (provide 'riece-message)
 272
 273 ;;; riece-message.el ends here