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   "Makes `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   "Makes `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   "Makes local identity for MESSAGE."
  88   (riece-identity-prefix
  89    (if (and (riece-message-private-p message)
  90             (riece-message-own-p message))
  91        (riece-message-target message)
  92      (riece-message-speaker message))))
  93
  94 (defun riece-message-make-global-name (message)
  95   "Makes global identity for MESSAGE."
  96   (if (riece-message-private-p message)
  97       (if (riece-message-own-p message)
  98           (riece-identity-prefix (riece-message-target message))
  99         (riece-identity-prefix (riece-message-speaker message)))
 100     (concat (riece-identity-prefix (riece-message-target message)) ":"
 101             (riece-identity-prefix (riece-message-speaker message)))))
 102
 103 (defun riece-message-buffer (message)
 104   "Return the buffer where MESSAGE should appear."
 105   (let* ((target (if (riece-identity-equal
 106                       (riece-message-target message)
 107                       (riece-current-nickname))
 108                      (riece-message-speaker message)
 109                    (riece-message-target message)))
 110          (entry (riece-identity-assoc target riece-channel-buffer-alist)))
 111     (unless entry
 112       (riece-join-channel target)
 113       ;; If you are not joined any channel,
 114       ;; switch to the target immediately.
 115       (unless riece-current-channel
 116         (riece-switch-to-channel target))
 117       (riece-redisplay-buffers)
 118       (setq entry (riece-identity-assoc target riece-channel-buffer-alist)))
 119     (cdr entry)))
 120
 121 (defun riece-message-parent-buffers (message buffer)
 122   "Return the parents of BUFFER where MESSAGE should appear.
 123 Normally they are *Dialogue* and/or *Others*."
 124   (if (or (and buffer (riece-frozen buffer))
 125           (and riece-current-channel
 126                (not (riece-identity-equal
 127                      (riece-message-target message)
 128                      riece-current-channel))))
 129       (list riece-dialogue-buffer riece-others-buffer)
 130     riece-dialogue-buffer))
 131
 132 (defun riece-display-message (message)
 133   "Display MESSAGE object."
 134   (let ((open-bracket
 135          (funcall riece-message-make-open-bracket-function message))
 136         (close-bracket
 137          (funcall riece-message-make-close-bracket-function message))
 138         (name
 139          (funcall riece-message-make-name-function message))
 140         (global-name
 141          (funcall riece-message-make-global-name-function message))
 142         (buffer (riece-message-buffer message))
 143         parent-buffers)
 144     (when (and buffer
 145                (riece-message-own-p message)
 146                (riece-own-frozen buffer))
 147       (with-current-buffer buffer
 148         (setq riece-freeze nil))
 149       (riece-update-status-indicators))
 150     (setq parent-buffers (riece-message-parent-buffers message buffer))
 151     (riece-insert buffer
 152                   (concat open-bracket name close-bracket
 153                           " " (riece-message-text message) "\n"))
 154     (riece-insert parent-buffers
 155                   (concat
 156                    (riece-concat-server-name
 157                     (concat open-bracket global-name close-bracket
 158                             " " (riece-message-text message)))
 159                    "\n"))
 160     (run-hook-with-args 'riece-after-display-message-functions message)))
 161
 162 (defun riece-make-message (speaker target text &optional type own-p)
 163   "Make an instance of message object.
 164 Arguments are appropriate to the sender, the receiver, and text
 165 content, respectively.
 166 Optional 4th argument TYPE specifies the type of the message.
 167 Currently possible values are `action' and `notice'.
 168 Optional 5th argument is the flag to indicate that this message is not
 169 from the network."
 170   (vector speaker target text type own-p))
 171
 172 (defun riece-message-speaker (message)
 173   "Return the sender of MESSAGE."
 174   (aref message 0))
 175
 176 (defun riece-message-target (message)
 177   "Return the receiver of MESSAGE."
 178   (aref message 1))
 179
 180 (defun riece-message-text (message)
 181   "Return the text part of MESSAGE."
 182   (aref message 2))
 183
 184 (defun riece-message-type (message)
 185   "Return the type of MESSAGE.
 186 Currently possible values are `action' and `notice'."
 187   (aref message 3))
 188
 189 (defun riece-message-own-p (message)
 190   "Return t if MESSAGE is not from the network."
 191   (aref message 4))
 192
 193 (defun riece-message-private-p (message)
 194   "Return t if MESSAGE is a private message."
 195   (if (riece-message-own-p message)
 196       (not (riece-channel-p (riece-message-target message)))
 197     (riece-identity-equal
 198      (riece-message-target message)
 199      (riece-current-nickname))))
 200
 201 (defun riece-message-external-p (message)
 202   "Return t if MESSAGE is from outside the channel."
 203   (not (riece-identity-member
 204         (riece-message-target message)
 205         (mapcar #'riece-make-identity
 206                 (riece-user-get-channels (riece-message-speaker message))))))
 207
 208 (defun riece-own-channel-message (message &optional channel type)
 209   "Display MESSAGE as you sent to CHNL."
 210   (riece-display-message
 211    (riece-make-message (riece-current-nickname)
 212                        (or channel riece-current-channel)
 213                        message type t)))
 214
 215 (provide 'riece-message)
 216
 217 ;;; riece-message.el ends here