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