2003-05-23 Daiki Ueno <ueno@unixuser.org>
+ * liece-message.el: Overhaul; don't depend on dynamic binding.
+ (liece-message-brackets): Abolish.
+ (liece-message-tags): Abolish.
+ (liece-message-empty-predicate): Abolish.
+ (liece-message-make-open-bracket-function): New variable.
+ (liece-message-make-close-bracket-function): New variable.
+ (liece-message-make-name-function): New variable.
+ (liece-message-make-global-name-function): New variable.
+ (liece-message-type): Abolish; define as function.
+ (liece-message-target): Abolish; define as function.
+ (liece-message-speaker): Abolish; define as function.
+ (liece-message-direction): Abolish; use liece-message-own-p.
+ (liece-message-predicate): Abolish.
+ (liece-message-brackets-function): Abolish.
+ (liece-message-tags-function): Abolish.
+ (liece-message-buffer-function): Rename to liece-message-buffers.
+ (liece-message-parent-buffer): Rename to liece-message-parent-buffers.
+ (liece-message-make-open-bracket): New function.
+ (liece-message-make-close-bracket): New function.
+ (liece-message-make-bracket): New function.
+ (liece-message-make-name): New function.
+ (liece-message-make-global-name): New function.
+ (liece-display-message): Rewrite; remove autoload cookie.
+ (liece-make-message): New function.
+ (liece-message-private-p): New function.
+ (liece-message-external-p): New function.
+ * liece-misc.el (liece-own-channel-message): Move to liece-message.el.
+ (liece-own-private-message): Ditto.
+ * liece-commands.el (liece-command-message): Don't use
+ liece-message-empty-predicate.
+ * liece-ctcp.el (liece-ctcp-action-message): Use new API.
+ (liece-ctcp-insert): Ditto.
+ * liece-dcc.el (liece-dcc-chat-filter): Use new API.
+ * liece-handle.el (liece-handle-notice-message): Use new API.
+ (liece-handle-privmsg-message): Ditto.
+
+2003-05-23 Daiki Ueno <ueno@unixuser.org>
+
* liece-misc.el (liece-insert-timestamp): Abolish.
(liece-own-frozen): Abolish.
(liece-own-message): Abolish.
;;; liece-message.el --- generate and display message line
-;; Copyright (C) 1999 Daiki Ueno
+;; Copyright (C) 1999-2003 Daiki Ueno
;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-05-30
;; Keywords: message
;; This file is part of Liece.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-
;;; Code:
(eval-when-compile (require 'liece-misc))
:prefix "liece-"
:group 'liece)
-(defcustom liece-message-brackets
- '(((type notice)
- ("-" "-"))
- ((and (type action) (direction outgoing))
- ("]" "["))
- ((type action)
- ("[" "]"))
- ((and (range private) (direction incoming))
- ("=" "="))
- ((direction outgoing)
- (">" "<"))
- ((range external)
- ("(" ")"))
- (t
- ("<" ">")))
- "Brackets."
+(defcustom liece-message-make-open-bracket-function
+ #'liece-message-make-open-bracket
+ "Function which makes `open-bracket' string for each message."
+ :type 'function
+ :group 'liece-message)
+
+(defcustom liece-message-make-close-bracket-function
+ #'liece-message-make-close-bracket
+ "Function which makes `close-bracket' string for each message."
+ :type 'function
:group 'liece-message)
-(defcustom liece-message-tags
- '(((and (direction outgoing) (range private))
- (liece-message-target liece-message-target))
- ((range private)
- (liece-message-speaker liece-message-speaker))
- (t
- (liece-message-speaker
- (concat liece-message-target ":" liece-message-speaker))))
- "Primary tags."
+(defcustom liece-message-make-name-function
+ #'liece-message-make-name
+ "Function which makes local identity for each message."
+ :type 'function
:group 'liece-message)
-(defcustom liece-message-empty-predicate
- (function (lambda (message) (string-equal "" message)))
- "Return non-nil if message is regarded as empty string."
+(defcustom liece-message-make-global-name-function
+ #'liece-message-make-global-name
+ "Function which makes global identity for each message."
+ :type 'function
:group 'liece-message)
-
-(defvar liece-message-type nil)
-(defvar liece-message-target nil)
-(defvar liece-message-speaker nil)
-(defvar liece-message-direction nil)
-
-(defun liece-message-predicate (val)
- (cond
- ((null val)
- nil)
- ((eq val t)
- t)
- ((listp val)
- (let ((pred (pop val)))
- (cond
- ((eq pred 'or)
- (apply 'liece-or (mapcar 'liece-message-predicate val)))
- ((eq pred 'and)
- (apply 'liece-and (mapcar 'liece-message-predicate val)))
- ((eq pred 'not)
- (not (liece-message-predicate (car val))))
- ((eq pred 'type)
- (eq liece-message-type (car val)))
- ((eq pred 'direction)
- (cond
- ((eq (car val) 'outgoing)
- liece-message-direction)
- ((eq (car val) 'incoming)
- (not liece-message-direction))))
- ((eq pred 'mode)
- (eq liece-command-buffer-mode (car val)))
- ((eq pred 'range)
- (cond
- ((eq (car val) 'private)
- (not (liece-channel-p (liece-channel-real liece-message-target))))
- ((eq (car val) 'external)
- (not (liece-channel-member
- liece-message-target (liece-nick-get-joined-channels
- liece-message-speaker))))))
- ((liece-functionp pred)
- (liece-eval-form (cons pred val)))
- (t
- (liece-message-predicate pred)))))
- (t
- (liece-eval-form val))))
-
-(defun liece-message-brackets-function ()
- (let* ((specs liece-message-brackets) spec
- (brackets
- (catch 'found
- (while specs
- (setq spec (pop specs))
- (if (liece-message-predicate (car spec))
- (throw 'found (cadr spec)))))))
- brackets))
-
-(defun liece-message-tags-function ()
- (let* ((specs liece-message-tags) spec
- (tags
- (catch 'found
- (while specs
- (setq spec (pop specs))
- (if (liece-message-predicate (car spec))
- (throw 'found (cadr spec)))))))
- (list (eval (car tags)) (eval (cadr tags)))))
-
-(defun liece-message-buffer-function ()
- (let* ((target (if (liece-message-predicate
- '(and (range private) (direction incoming)))
- liece-message-speaker
- liece-message-target))
+
+(defun liece-message-make-open-bracket (message)
+ "Makes `open-bracket' string for MESSAGE."
+ (liece-message-make-bracket message t))
+
+(defun liece-message-make-close-bracket (message)
+ "Makes `close-bracket' string for MESSAGE."
+ (liece-message-make-bracket message nil))
+
+(defun liece-message-make-bracket (message open-p)
+ (if (eq open-p (liece-message-own-p message))
+ (if (eq (liece-message-type message) 'notice)
+ "}"
+ (if (eq (liece-message-type message) 'action)
+ "]"
+ (if (liece-message-private-p message)
+ "="
+ (if (liece-message-external-p message)
+ ")"
+ ">"))))
+ (if (eq (liece-message-type message) 'notice)
+ "{"
+ (if (eq (liece-message-type message) 'action)
+ "["
+ (if (liece-message-private-p message)
+ "="
+ (if (liece-message-external-p message)
+ "("
+ "<"))))))
+
+(defun liece-message-make-name (message)
+ "Makes local identity for MESSAGE."
+ (if (and (liece-message-private-p message)
+ (liece-message-own-p message))
+ (liece-message-target message)
+ (liece-message-speaker message)))
+
+(defun liece-message-make-global-name (message)
+ "Makes global identity for MESSAGE."
+ (if (liece-message-private-p message)
+ (if (liece-message-own-p message)
+ (liece-message-target message)
+ (liece-message-speaker message))
+ (concat (liece-message-target message) ":"
+ (liece-message-speaker message))))
+
+(defun liece-message-buffers (message)
+ "Returns list of buffers where MESSAGE should appear."
+ (let* ((target (if (liece-nick-equal (liece-message-target message)
+ (liece-current-nickname))
+ (liece-message-speaker message)
+ (liece-message-target message)))
(buffer (liece-pick-buffer target)))
- (cond
- ((car buffer) buffer)
- (liece-auto-join-partner
- (liece-channel-prepare-partner target)
- (liece-pick-buffer target)))))
-
-(defun liece-message-parent-buffer (cbuffer)
- (if (or (and (car cbuffer) (liece-frozen (car cbuffer)))
+ (if (car buffer)
+ buffer
+ (when liece-auto-join-partner
+ (liece-channel-prepare-partner target)
+ (liece-pick-buffer target)))))
+
+(defun liece-message-parent-buffers (message buffer)
+ "Returns the parents of BUFFER where MESSAGE should appear.
+Normally they are *Dialogue* and/or *Others*."
+ (if (or (and (car buffer) (liece-frozen (car buffer)))
(and (eq liece-command-buffer-mode 'channel)
- liece-current-channel
- (not (liece-channel-equal liece-message-target
- liece-current-channel)))
+ (liece-current-channel)
+ (not (liece-channel-equal
+ (liece-message-target message)
+ (liece-current-channel))))
(and (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- (not (eq liece-message-direction 'outgoing))
- (or
- (not (liece-nick-equal liece-message-speaker
- liece-current-chat-partner))
- (not (liece-nick-equal liece-message-target
- (liece-current-nickname))))))
+ (liece-current-chat-partner)
+ (not (liece-message-own-p message))
+ (or (not (liece-nick-equal (liece-message-speaker message)
+ (liece-current-chat-partner)))
+ (not (liece-nick-equal (liece-message-target message)
+ (liece-current-nickname))))))
(append liece-D-buffer liece-O-buffer)
liece-D-buffer))
-;;;###liece-autoload
-(defun liece-display-message (temp)
- (let* ((brackets (liece-message-brackets-function))
- (tags (liece-message-tags-function))
- (buffer (liece-message-buffer-function))
- (parent (liece-message-parent-buffer buffer)))
- (liece-insert buffer
- (concat (car brackets) (car tags) (cadr brackets)
- " " temp "\n"))
- (liece-insert parent
- (concat (car brackets) (cadr tags) (cadr brackets)
- " " temp "\n"))
- (run-hook-with-args 'liece-display-message-hook temp)))
-
+(defun liece-display-message (message)
+ "Display MESSAGE object."
+ (let* ((open-bracket
+ (funcall liece-message-make-open-bracket-function message))
+ (close-bracket
+ (funcall liece-message-make-close-bracket-function message))
+ (name
+ (funcall liece-message-make-name-function message))
+ (global-name
+ (funcall liece-message-make-global-name-function message))
+ (buffers (liece-message-buffers message))
+ (parent-buffers (liece-message-parent-buffers message buffer)))
+ (liece-insert buffers
+ (concat open-bracket name close-bracket
+ " " (liece-message-text message) "\n"))
+ (liece-insert parent-buffers
+ (concat open-bracket global-name close-bracket
+ " " (liece-message-text message) "\n"))
+ (run-hook-with-args 'liece-display-message-hook message)))
+
+(defun liece-make-message (speaker target text &optional type own-p)
+ "Makes an instance of message object.
+Arguments are apropriate to the sender, the receiver, and text
+content, respectively.
+Optional 4th argument TYPE specifies the type of message.
+Currently possible values are `action' and `notice'.
+Optional 5th argument is a flag to indicate that this message is not
+from the network."
+ (vector speaker target text type own-p))
+
+(defun liece-message-speaker (message)
+ "Returns the sender of MESSAGE."
+ (aref message 0))
+
+(defun liece-message-target (message)
+ "Returns the receiver of MESSAGE."
+ (aref message 1))
+
+(defun liece-message-text (message)
+ "Returns the text part of MESSAGE."
+ (aref message 2))
+
+(defun liece-message-type (message)
+ "Returns the type of MESSAGE.
+Currently possible values are `action' and `notice'."
+ (aref message 3))
+
+(defun liece-message-own-p (message)
+ "Returns t if MESSAGE is not from the network."
+ (aref message 4))
+
+(defun liece-message-private-p (message)
+ "Returns t if MESSAGE is a private message."
+ (liece-nick-equal (liece-message-target message)
+ (liece-current-nickname)))
+
+(defun liece-message-external-p (message)
+ "Returns t if MESSAGE is from outside the channel."
+ (not (liece-channel-member (liece-message-target message)
+ (liece-nick-get-joined-channels
+ (liece-message-speaker message)))))
+
+(defun liece-own-channel-message (message &optional chnl type)
+ "Display MESSAGE as you sent to CHNL."
+ (liece-display-message
+ (liece-make-message (liece-current-nickname)
+ (or chnl (liece-current-channel))
+ message type t)))
+
+(defun liece-own-private-message (message &optional partner type)
+ "Display MESSAGE as you sent to PARTNER."
+ (liece-display-message
+ (liece-make-message (liece-current-nickname)
+ (or partner (liece-current-chat-partner))
+ message type t)))
+
(provide 'liece-message)
;;; liece-message.el ends here
projects / elisp / liece.git / commitdiff