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., 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 (car 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