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-make-open-bracket-function
  39   #'riece-message-make-open-bracket
  40   "Function which makes `open-bracket' string for each message."
  41   :type 'function
  42   :group 'riece-message)
  43
  44 (defcustom riece-message-make-close-bracket-function
  45   #'riece-message-make-close-bracket
  46   "Function which makes `close-bracket' string for each message."
  47   :type 'function
  48   :group 'riece-message)
  49
  50 (defcustom riece-message-make-name-function
  51   #'riece-message-make-name
  52   "Function which makes local identity for each message."
  53   :type 'function
  54   :group 'riece-message)
  55
  56 (defcustom riece-message-make-global-name-function
  57   #'riece-message-make-global-name
  58   "Function which makes global identity for each message."
  59   :type 'function
  60   :group 'riece-message)
  61
  62 (defun riece-message-make-open-bracket (message)
  63   "Make `open-bracket' string for MESSAGE."
  64   (if (riece-message-own-p message)
  65       ">"
  66     (if (eq (riece-message-type message) 'notice)
  67         "{"
  68       (if (riece-message-private-p message)
  69           "="
  70         (if (riece-message-external-p message)
  71             "("
  72           "<")))))
  73
  74 (defun riece-message-make-close-bracket (message)
  75   "Make `close-bracket' string for MESSAGE."
  76   (if (riece-message-own-p message)
  77       "<"
  78     (if (eq (riece-message-type message) 'notice)
  79         "}"
  80       (if (riece-message-private-p message)
  81           "="
  82         (if (riece-message-external-p message)
  83             ")"
  84           ">")))))
  85
  86 (defun riece-message-make-name (message)
  87   "Make local identity for MESSAGE."
  88   (if (riece-message-private-p message)
  89       (if (riece-message-own-p message)
  90           (riece-format-identity (riece-message-target message) t)
  91         (riece-format-identity (riece-message-speaker message) t))
  92     (riece-format-identity (riece-message-speaker message) t)))
  93
  94 (defun riece-message-make-global-name (message)
  95   "Make global identity for MESSAGE."
  96   (if (riece-message-private-p message)
  97       (if (riece-message-own-p message)
  98           (riece-format-identity (riece-message-target message) t)
  99         (riece-format-identity (riece-message-speaker message) t))
 100     (concat (riece-format-identity (riece-message-target message) t) ":"
 101             (riece-format-identity (riece-message-speaker message) t))))
 102
 103 (defun riece-message-buffer (message)
 104   "Return the buffer where MESSAGE should appear."
 105   (let ((target (if (riece-message-private-p message)
 106                     (if (riece-message-own-p message)
 107                         (riece-message-target message)
 108                       (riece-message-speaker message))
 109                   (riece-message-target message))))
 110     (unless (riece-identity-member target riece-current-channels)
 111       (riece-join-channel target)
 112       ;; If you are not joined any channel,
 113       ;; switch to the target immediately.
 114       (unless riece-current-channel
 115         (riece-switch-to-channel target))
 116       (riece-redisplay-buffers))
 117     (riece-channel-buffer-name target)))
 118
 119 (defun riece-message-parent-buffers (message buffer)
 120   "Return the parents of BUFFER where MESSAGE should appear.
 121 Normally they are *Dialogue* and/or *Others*."
 122   (if (and buffer (riece-frozen buffer)) ;the message might not be
 123                                          ;visible in buffer's window
 124       (list riece-dialogue-buffer riece-others-buffer)
 125     (if (and riece-current-channel      ;the message is not sent to
 126                                         ;the current channel
 127              (if (riece-message-private-p message)
 128                  (if (riece-message-own-p message)
 129                      (not (riece-identity-equal
 130                            (riece-message-target message)
 131                            riece-current-channel))
 132                    (not (riece-identity-equal
 133                          (riece-message-speaker message)
 134                          riece-current-channel)))
 135                (not (riece-identity-equal
 136                      (riece-message-target message)
 137                      riece-current-channel))))
 138         (list riece-dialogue-buffer riece-others-buffer)
 139       riece-dialogue-buffer)))
 140
 141 (defun riece-display-message (message)
 142   "Display MESSAGE object."
 143   (let ((open-bracket
 144          (funcall riece-message-make-open-bracket-function message))
 145         (close-bracket
 146          (funcall riece-message-make-close-bracket-function message))
 147         (name
 148          (funcall riece-message-make-name-function message))
 149         (global-name
 150          (funcall riece-message-make-global-name-function message))
 151         (buffer (riece-message-buffer message))
 152         (server-name (riece-identity-server (riece-message-speaker message)))
 153         parent-buffers)
 154     (when (and buffer
 155                (riece-message-own-p message)
 156                (riece-own-frozen buffer))
 157       (with-current-buffer buffer
 158         (setq riece-freeze nil))
 159       (riece-update-status-indicators))
 160     (setq parent-buffers (riece-message-parent-buffers message buffer))
 161     (riece-insert buffer
 162                   (concat open-bracket name close-bracket
 163                           " " (riece-message-text message) "\n"))
 164     (riece-insert parent-buffers
 165                   (if (equal server-name "")
 166                       (concat open-bracket global-name close-bracket
 167                               " " (riece-message-text message) "\n")
 168                      (concat open-bracket global-name close-bracket
 169                              " " (riece-message-text message)
 170                              " (from " server-name ")\n")))
 171     (run-hook-with-args 'riece-after-display-message-functions message)))
 172
 173 (defun riece-make-message (speaker target text &optional type own-p)
 174   "Make an instance of message object.
 175 Arguments are appropriate to the sender, the receiver, and text
 176 content, respectively.
 177 Optional 4th argument TYPE specifies the type of the message.
 178 Currently possible values are `action' and `notice'.
 179 Optional 5th argument is the flag to indicate that this message is not
 180 from the network."
 181   (vector speaker target text type own-p))
 182
 183 (defun riece-message-speaker (message)
 184   "Return the sender of MESSAGE."
 185   (aref message 0))
 186
 187 (defun riece-message-target (message)
 188   "Return the receiver of MESSAGE."
 189   (aref message 1))
 190
 191 (defun riece-message-text (message)
 192   "Return the text part of MESSAGE."
 193   (aref message 2))
 194
 195 (defun riece-message-type (message)
 196   "Return the type of MESSAGE.
 197 Currently possible values are `action' and `notice'."
 198   (aref message 3))
 199
 200 (defun riece-message-own-p (message)
 201   "Return t if MESSAGE is not from the network."
 202   (aref message 4))
 203
 204 (defun riece-message-private-p (message)
 205   "Return t if MESSAGE is a private message."
 206   (not (or (riece-channel-p (riece-identity-prefix
 207                              (riece-message-speaker message)))
 208            (riece-channel-p (riece-identity-prefix
 209                              (riece-message-target message))))))
 210
 211 (defun riece-message-external-p (message)
 212   "Return t if MESSAGE is from outside the channel."
 213   (not (riece-identity-member
 214         (riece-message-speaker message)
 215         (let ((target (riece-message-target message)))
 216           (riece-with-server-buffer (riece-identity-server target)
 217             (mapcar
 218              (lambda (user)
 219                (riece-make-identity user riece-server-name))
 220              (riece-channel-get-users (riece-identity-prefix target))))))))
 221
 222 (provide 'riece-message)
 223
 224 ;;; riece-message.el ends here