* riece-400.el (riece-handle-read-string): Append "Quit" to prompt

[riece] / lisp / riece-ctcp.el

diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el
index dfde187..f1fd937 100644 (file)
--- a/lisp/riece-ctcp.el
+++ b/lisp/riece-ctcp.el
@@ -26,8 +26,8 @@
 
 (require 'riece-version)
 (require 'riece-misc)
-(require 'riece-display)
 (require 'riece-highlight)
+(require 'riece-display)
 
 (defface riece-ctcp-action-face
   '((((class color)
@@ -91,29 +91,29 @@
                           hook prefix (car targets) message)
                        (error
                         (if riece-debug
-                            (message "Error occurred in `%S': %S" hook error))
+                            (message "Error in `%S': %S" hook error))
                         nil))
                (if function
                    (condition-case error
                        (funcall function prefix (car targets) message)
                      (error
                       (if riece-debug
-                          (message "Error occurred in `%S': %S"
+                          (message "Error in `%S': %S"
                                    function error))))))
              (condition-case error
                  (run-hook-with-args-until-success
                   after-hook prefix (car targets) message)
                (error
                 (if riece-debug
-                    (message "Error occurred in `%S': %S"
+                    (message "Error in `%S': %S"
                              after-hook error)))))
            t)))))
 
 (defun riece-handle-ctcp-version-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)))
+  (let* ((target-identity (riece-make-identity target riece-server-name))
+        (buffer (if (riece-channel-p target)
+                    (riece-channel-buffer target-identity)))
+        (user (riece-prefix-nickname prefix)))
     (riece-send-string
      (format "NOTICE %s :\1VERSION %s\1\r\n" user (riece-extended-version)))
     (riece-insert-change buffer (format "CTCP VERSION from %s\n" user))
@@ -127,14 +127,14 @@
        (format "CTCP VERSION from %s (%s) to %s"
               user
               (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
-              target))
+              (riece-format-identity target-identity t)))
       "\n"))))
 
 (defun riece-handle-ctcp-ping-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)))
+  (let* ((target-identity (riece-make-identity target riece-server-name))
+        (buffer (if (riece-channel-p target)
+                    (riece-channel-buffer target-identity)))
+        (user (riece-prefix-nickname prefix)))
     (riece-send-string
      (if string
         (format "NOTICE %s :\1PING %s\1\r\n" user string)
@@ -150,14 +150,14 @@
        (format "CTCP PING from %s (%s) to %s"
               user
               (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
-              target))
+              (riece-format-identity target-identity t)))
       "\n"))))
 
 (defun riece-handle-ctcp-clientinfo-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)))
+  (let* ((target-identity (riece-make-identity target riece-server-name))
+        (buffer (if (riece-channel-p target)
+                    (riece-channel-buffer target-identity)))
+        (user (riece-prefix-nickname prefix)))
     (riece-send-string
      (format "NOTICE %s :\1CLIENTINFO %s\1\r\n"
             user
@@ -186,7 +186,7 @@
        (format "CTCP CLIENTINFO from %s (%s) to %s"
               user
               (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
-              target))
+              (riece-format-identity target-identity t)))
       "\n"))))
 
 (defun riece-handle-ctcp-action-request (prefix target string)
@@ -226,21 +226,21 @@
                           hook prefix (car targets) message)
                        (error
                         (if riece-debug
-                            (message "Error occurred in `%S': %S" hook error))
+                            (message "Error in `%S': %S" hook error))
                         nil))
                (if function
                    (condition-case error
                        (funcall function prefix (car targets) message)
                      (error
                       (if riece-debug
-                          (message "Error occurred in `%S': %S"
+                          (message "Error in `%S': %S"
                                    function error))))))
              (condition-case error
                  (run-hook-with-args-until-success
                   after-hook prefix (car targets) message)
                (error
                 (if riece-debug
-                    (message "Error occurred in `%S': %S"
+                    (message "Error in `%S': %S"
                              after-hook error)))))
            t)))))
 
@@ -284,10 +284,7 @@
   (interactive
    (list (riece-completing-read-identity
          "Channel/User: "
-         (apply #'nconc
-                (mapcar (lambda (entry)
-                          (riece-get-identities-on-server (car entry)))
-                        riece-server-process-alist)))))
+         (riece-get-identities-on-server (riece-current-server-name)))))
   (riece-send-string (format "PRIVMSG %s :\1VERSION\1\r\n"
                             (riece-identity-prefix target))))
 
@@ -295,10 +292,7 @@
   (interactive
    (list (riece-completing-read-identity
          "Channel/User: "
-         (apply #'nconc
-                (mapcar (lambda (entry)
-                          (riece-get-identities-on-server (car entry)))
-                        riece-server-process-alist)))))
+         (riece-get-identities-on-server (riece-current-server-name)))))
   (riece-send-string (format "PRIVMSG %s :\1PING\1\r\n"
                             (riece-identity-prefix target)))
   (setq riece-ctcp-ping-time (current-time)))
@@ -307,10 +301,7 @@
   (interactive
    (list (riece-completing-read-identity
          "Channel/User: "
-         (apply #'nconc
-                (mapcar (lambda (entry)
-                          (riece-get-identities-on-server (car entry)))
-                        riece-server-process-alist)))))
+         (riece-get-identities-on-server (riece-current-server-name)))))
   (riece-send-string (format "PRIVMSG %s :\1CLIENTINFO\1\r\n"
                             (riece-identity-prefix target))))
 
@@ -319,12 +310,17 @@
    (list (if current-prefix-arg
             (riece-completing-read-identity
              "Channel/User: "
-             (apply #'nconc
-                    (mapcar (lambda (entry)
-                              (riece-get-identities-on-server (car entry)))
-                            riece-server-process-alist)))
+             (riece-get-identities-on-server (riece-current-server-name)))
           riece-current-channel)
-        (read-string "Action: ")))
+        (let (message)
+          (beginning-of-line)
+          (setq message (buffer-substring (point)
+                                          (progn (end-of-line) (point))))
+          (if (equal message "")
+              (read-string "Action: ")
+            (prog1 (read-from-minibuffer "Action: " (cons message 0))
+              (let ((next-line-add-newlines t))
+                (next-line 1)))))))
   (if (equal action "")
       (error "No action"))
   (riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n"
@@ -341,9 +337,11 @@
         (list riece-dialogue-buffer riece-others-buffer)
        riece-dialogue-buffer)
      (concat
-      (riece-concat-server-name
-       (concat riece-ctcp-action-prefix
-              (riece-identity-prefix (riece-current-nickname)) " " action))
+      (riece-with-server-buffer (riece-identity-server target)
+       (riece-concat-server-name
+        (concat riece-ctcp-action-prefix
+                (riece-identity-prefix (riece-current-nickname)) " " action
+                " (in " (riece-format-identity target t) ")")))
       "\n"))))
 
 (provide 'riece-ctcp)