Prevent an args-out-of-range error during login/out

[riece] / lisp / riece-ctcp.el

diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el
index 8e47be0..234a1fe 100644 (file)
--- a/lisp/riece-ctcp.el
+++ b/lisp/riece-ctcp.el
@@ -1,4 +1,4 @@
-;;; riece-ctcp.el --- CTCP (Client To Client Protocol) support
+;;; riece-ctcp.el --- CTCP (Client To Client Protocol) support -*- lexical-binding: t -*-
 ;; Copyright (C) 1998-2003 Daiki Ueno
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
@@ -34,6 +34,7 @@
 (require 'riece-display)
 (require 'riece-debug)
 (require 'riece-mcat)
+(require 'riece-message)
 
 (defface riece-ctcp-action-face
   '((((class color)
@@ -90,7 +91,7 @@
                                             message)))
            t)))))
 
-(defun riece-handle-ctcp-version-request (prefix target string)
+(defun riece-handle-ctcp-version-request (prefix target _string)
   (let* ((target-identity (riece-make-identity target riece-server-name))
         (buffer (if (riece-channel-p target)
                     (riece-channel-buffer target-identity)))
@@ -134,7 +135,7 @@
               (riece-format-identity target-identity t)))
       "\n"))))
 
-(defun riece-handle-ctcp-clientinfo-request (prefix target string)
+(defun riece-handle-ctcp-clientinfo-request (prefix target _string)
   (let* ((target-identity (riece-make-identity target riece-server-name))
         (buffer (if (riece-channel-p target)
                     (riece-channel-buffer target-identity)))
@@ -170,34 +171,34 @@
               (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"))))
-
-(defun riece-handle-ctcp-time-request (prefix target string)
+  (let ((user (riece-prefix-nickname prefix)))
+    (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))
         (buffer (if (riece-channel-p target)
                     (riece-channel-buffer target-identity)))
@@ -251,7 +252,7 @@
                                             message)))
            t)))))
 
-(defun riece-handle-ctcp-version-response (prefix target string)
+(defun riece-handle-ctcp-version-response (prefix _target string)
   (riece-insert-change
    (list riece-dialogue-buffer riece-others-buffer)
    (concat
@@ -262,7 +263,7 @@
             string))
     "\n")))
 
-(defun riece-handle-ctcp-ping-response (prefix target string)
+(defun riece-handle-ctcp-ping-response (prefix _target _string)
   (let* ((now (current-time))
         (elapsed (+ (* 65536 (- (car now) (car riece-ctcp-ping-time)))
                     (- (nth 1 now) (nth 1 riece-ctcp-ping-time)))))
@@ -276,7 +277,7 @@
               elapsed))
       "\n"))))
 
-(defun riece-handle-ctcp-clientinfo-response (prefix target string)
+(defun riece-handle-ctcp-clientinfo-response (prefix _target string)
   (riece-insert-change
    (list riece-dialogue-buffer riece-others-buffer)
    (concat
@@ -287,7 +288,7 @@
             string))
     "\n")))
 
-(defun riece-handle-ctcp-time-response (prefix target string)
+(defun riece-handle-ctcp-time-response (prefix _target string)
   (riece-insert-change
    (list riece-dialogue-buffer riece-others-buffer)
    (concat
@@ -338,30 +339,15 @@
               (read-string (riece-mcat "Action: "))
             (prog1 (read-from-minibuffer (riece-mcat "Action: ")
                                          (cons message 0))
-              (let ((next-line-add-newlines t))
-                (next-line 1)))))))
+              (if (> (forward-line) 0)
+                  (insert "\n")))))))
   (if (equal action "")
       (error "No action"))
   (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 +373,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)