From: ueno <ueno>
Date: Fri, 23 May 2003 04:55:31 +0000 (+0000)
Subject: * liece-message.el: Overhaul; don't depend on dynamic binding.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2ff0d62894f46962fb62d5b56dd5169991dcd786;p=elisp%2Fliece.git

* 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.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dc1834c..822ff5d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,43 @@
 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.
diff --git a/lisp/liece-commands.el b/lisp/liece-commands.el
index 9cd576d..1650a4b 100644
--- a/lisp/liece-commands.el
+++ b/lisp/liece-commands.el
@@ -541,8 +541,8 @@ Argument CHANGE ."
 	    (format
 	     (_ "Private message to %s: ")
 	     address)))))
-  (if (funcall liece-message-empty-predicate message)
-      (progn (liece-message (_ "No text to send")) nil)
+  (if (equal message "")
+      (liece-message (_ "No text to send"))
     (let ((chnl (liece-channel-real address)))
       (liece-send "PRIVMSG %s :%s" chnl message)
       (if (liece-channel-p chnl)
diff --git a/lisp/liece-ctcp.el b/lisp/liece-ctcp.el
index 1f0d730..7972e3f 100644
--- a/lisp/liece-ctcp.el
+++ b/lisp/liece-ctcp.el
@@ -156,10 +156,8 @@
 
 (defun liece-ctcp-action-message (from chnl rest)
   "CTCP ACTION handler."
-  (let ((liece-message-target (liece-channel-virtual chnl))
-	(liece-message-speaker from)
-	(liece-message-type 'action))
-    (liece-display-message rest)))
+  (liece-display-message  
+   (liece-make-message from (liece-channel-virtual chnl) rest 'action)))
 
 (defun liece-ctcp-insert (message from &optional chnl rest)
   (if (or (null chnl)
@@ -520,7 +518,6 @@
    (if current-prefix-arg
        (list current-prefix-arg)))
   (let ((completion-ignore-case t)
-	(liece-message-type 'action)
 	message)
     (if arg
 	(setq liece-privmsg-partner 
@@ -540,8 +537,8 @@
 		   (liece-channel-real liece-current-channel))
 		 message)
     (if arg
-	(liece-own-private-message message)
-      (liece-own-channel-message message))))
+	(liece-own-private-message message 'action)
+      (liece-own-channel-message message 'action))))
 
 (define-obsolete-function-alias 'liece-command-send-action
   'liece-command-ctcp-action)
diff --git a/lisp/liece-dcc.el b/lisp/liece-dcc.el
index fabcda7..6845ed5 100644
--- a/lisp/liece-dcc.el
+++ b/lisp/liece-dcc.el
@@ -319,9 +319,8 @@
 		    line (liece-coding-decode-charset-string
 			  (buffer-substring st (1- nd))))
 	      (delete-region st nd)
-	      (let ((liece-message-target (liece-current-nickname))
-		    (liece-message-speaker nick))
-		(liece-display-message line)))))))))
+	      (liece-display-message
+	       (liece-make-message nick (liece-current-nickname) line)))))))))
 
 (defun liece-dcc-chat-nick-to-process (nick)
   "Convert NICK to process symbol."
diff --git a/lisp/liece-handle.el b/lisp/liece-handle.el
index 165ef77..2358e0c 100644
--- a/lisp/liece-handle.el
+++ b/lisp/liece-handle.el
@@ -124,13 +124,9 @@
 	(setq temp (liece-ctcp-notice prefix temp)))
     (if (liece-handle-message-check-empty temp)
 	(return-from liece-handle-notice-message))
-
     ;; Normal message via notice.
-    (setq chnl (liece-channel-virtual chnl))
-    (let ((liece-message-target chnl)
-	  (liece-message-speaker prefix)
-	  (liece-message-type 'notice))
-      (liece-display-message temp))))
+    (liece-display-message
+     (liece-make-message prefix (liece-channel-virtual chnl) temp 'notice))))
 
 (defun* liece-handle-privmsg-message (prefix rest)
   (if (liece-handle-message-check-ignored prefix rest)
@@ -161,7 +157,8 @@
 	    (liece-beep))))
 
     ;; Append timestamp if we are being away.
-    (if (and (string-equal "A" liece-away-indicator)
+    (if (and (not liece-display-time)
+	     (string-equal "A" liece-away-indicator)
 	     (liece-nick-equal chnl liece-real-nickname))
 	(setq temp
 	      (concat temp " ("
@@ -169,10 +166,7 @@
 		      ")")))
 
     ;; Normal message.
-    (let ((liece-message-target chnl)
-	  (liece-message-speaker prefix)
-	  (liece-message-type 'privmsg))
-      (liece-display-message temp))
+    (liece-display-message (liece-make-message prefix chnl temp))
 
     ;; Append to the unread list.
     (let ((item (if (eq liece-command-buffer-mode 'chat)
diff --git a/lisp/liece-message.el b/lisp/liece-message.el
index 88501a9..f85b47a 100644
--- a/lisp/liece-message.el
+++ b/lisp/liece-message.el
@@ -1,8 +1,7 @@
 ;;; 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.
@@ -22,10 +21,6 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-
-;;; Commentary:
-;; 
-
 ;;; Code:
 
 (eval-when-compile (require 'liece-misc))
@@ -36,148 +31,183 @@
   :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
diff --git a/lisp/liece-misc.el b/lisp/liece-misc.el
index 96c86ee..e6526cd 100644
--- a/lisp/liece-misc.el
+++ b/lisp/liece-misc.el
@@ -223,20 +223,6 @@
 	    (product-name (product-find 'liece-version))
 	    (format ,@message)))
 
-(defmacro liece-own-channel-message (message &optional chnl)
-  `(let* ((chnl (or ,chnl (liece-current-channel)))
-	  (liece-message-target chnl)
-	  (liece-message-speaker (liece-current-nickname))
-	  (liece-message-direction 'outgoing))
-     (liece-display-message ,message)))
-
-(defmacro liece-own-private-message (message &optional partner)
-  `(let* ((partner (or ,partner liece-current-chat-partner))
-	  (liece-message-target partner)
-	  (liece-message-speaker (liece-current-nickname))
-	  (liece-message-direction 'outgoing))
-     (liece-display-message ,message)))
-
 (defvar liece-idle-point nil "Timestamp of last idle reset.")
 
 (defmacro liece-reset-idle ()