From: ueno Date: Wed, 18 Apr 2007 04:43:19 +0000 (+0000) Subject: * riece-ctcp.el (riece-ctcp-action-format-message): New function. X-Git-Tag: riece-4_0_0~14 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e0605a35e116f968c19c3ffa8c1e4d8b9409b1e1;p=elisp%2Friece.git * riece-ctcp.el (riece-ctcp-action-format-message): New function. (riece-handle-ctcp-action-request): Use it. (riece-command-ctcp-action): Use it. * riece-message.el (riece-message-format-function-alist): New user option. (riece-display-message-1): Pick a format function from riece-message-format-function-alist. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e094a27..850dfca 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2007-04-18 Daiki Ueno + + * riece-ctcp.el (riece-ctcp-action-format-message): New function. + (riece-handle-ctcp-action-request): Use it. + (riece-command-ctcp-action): Use it. + + * riece-message.el (riece-message-format-function-alist): New user + option. + (riece-display-message-1): Pick a format function from + riece-message-format-function-alist. + 2007-04-16 Daiki Ueno * riece-rdcc.el (riece-rdcc-server-port): New user option. diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el index 8e47be0..854e416 100644 --- a/lisp/riece-ctcp.el +++ b/lisp/riece-ctcp.el @@ -170,32 +170,35 @@ (riece-format-identity target-identity t))) "\n")))) +(defun riece-ctcp-action-format-message (message &optional global) + (riece-with-server-buffer (riece-identity-server + (riece-message-speaker message)) + (concat + (if global + (riece-concat-server-name + (concat riece-ctcp-action-prefix + (riece-format-identity (riece-message-target message) t) ": " + (riece-identity-prefix (riece-message-speaker message)) " " + (riece-message-text message))) + (concat riece-ctcp-action-prefix + (riece-identity-prefix (riece-message-speaker message)) " " + (riece-message-text message))) + "\n"))) + (defun riece-handle-ctcp-action-request (prefix target string) (let ((buffer (if (riece-channel-p target) (riece-channel-buffer (riece-make-identity target riece-server-name)))) (user (riece-prefix-nickname prefix))) - (riece-insert buffer (concat riece-ctcp-action-prefix - (riece-format-identity - (riece-make-identity user riece-server-name) - t) - " " string - "\n")) - (riece-insert - (if (and riece-channel-buffer-mode - (not (eq buffer riece-channel-buffer))) - (list riece-dialogue-buffer riece-others-buffer) - riece-dialogue-buffer) - (concat (riece-concat-server-name - (concat riece-ctcp-action-prefix - (riece-format-identity - (riece-make-identity target riece-server-name) - t) - ": " - (riece-format-identity - (riece-make-identity user riece-server-name) - t) - " " string)) "\n")))) + (riece-display-message + (riece-make-message (riece-make-identity user + riece-server-name) + (riece-make-identity target + riece-server-name) + string + 'action + (riece-identity-equal-no-server + user riece-real-nickname))))) (defun riece-handle-ctcp-time-request (prefix target string) (let* ((target-identity (riece-make-identity target riece-server-name)) @@ -345,23 +348,8 @@ (riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n" (riece-identity-prefix target) action)) - (let ((buffer (riece-channel-buffer target))) - (riece-insert - buffer - (concat riece-ctcp-action-prefix - (riece-identity-prefix (riece-current-nickname)) " " action "\n")) - (riece-insert - (if (and riece-channel-buffer-mode - (not (eq buffer riece-channel-buffer))) - (list riece-dialogue-buffer riece-others-buffer) - riece-dialogue-buffer) - (concat - (riece-with-server-buffer (riece-identity-server target) - (riece-concat-server-name - (concat riece-ctcp-action-prefix - (riece-format-identity target t) ": " - (riece-identity-prefix (riece-current-nickname)) " " action))) - "\n")))) + (riece-display-message + (riece-make-message (riece-current-nickname) target action 'action t))) (defun riece-command-ctcp-time (target) (interactive @@ -387,7 +375,11 @@ (if (memq 'riece-highlight riece-addons) (setq riece-dialogue-font-lock-keywords (cons riece-ctcp-dialogue-font-lock-keywords - riece-dialogue-font-lock-keywords)))) + riece-dialogue-font-lock-keywords))) + (unless (assq 'action riece-message-format-function-alist) + (setq riece-message-format-function-alist + (cons (cons 'action #'riece-ctcp-action-format-message) + riece-message-format-function-alist)))) (defun riece-ctcp-uninstall () (remove-hook 'riece-privmsg-hook 'riece-handle-ctcp-request) diff --git a/lisp/riece-message.el b/lisp/riece-message.el index e32c45f..df388f1 100644 --- a/lisp/riece-message.el +++ b/lisp/riece-message.el @@ -64,6 +64,11 @@ :type 'function :group 'riece-message) +(defcustom riece-message-format-function-alist nil + "Alist mapping message types to format functions." + :type 'list + :group 'riece-message) + (defun riece-message-make-open-bracket (message) "Make `open-bracket' string for MESSAGE." (if (eq (riece-message-type message) 'notice) @@ -164,6 +169,10 @@ Normally they are *Dialogue* and/or *Others*." (defun riece-display-message-1 (message) (let ((buffer (riece-message-buffer message)) + (format-message-function + (or (cdr (assq (riece-message-type message) + riece-message-format-function-alist)) + #'riece-format-message)) parent-buffers) (when (and buffer (riece-message-own-p message) @@ -172,8 +181,8 @@ Normally they are *Dialogue* and/or *Others*." (setq riece-freeze nil)) (riece-emit-signal 'buffer-freeze-changed buffer nil)) (setq parent-buffers (riece-message-parent-buffers message buffer)) - (riece-insert buffer (riece-format-message message)) - (riece-insert parent-buffers (riece-format-message message t)) + (riece-insert buffer (funcall format-message-function message)) + (riece-insert parent-buffers (funcall format-message-function message t)) (with-current-buffer buffer (run-hook-with-args 'riece-after-display-message-functions message)))) @@ -192,7 +201,7 @@ Normally they are *Dialogue* and/or *Others*." Arguments are appropriate to the sender, the receiver, and text content, respectively. Optional 4th argument TYPE specifies the type of the message. -Currently possible values are `action' and `notice'. +Currently possible values are `nil' or `notice'. Optional 5th argument is the flag to indicate that this message is not from the network." (vector speaker target text type own-p))