2005-02-18 Steve Youngs <steve@sxemacs.org>

[riece] / lisp / riece-ctcp.el

diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el
index b3bec43..d7ffe6b 100644 (file)
--- a/lisp/riece-ctcp.el
+++ b/lisp/riece-ctcp.el
@@ -28,6 +28,7 @@
 (require 'riece-misc)
 (require 'riece-highlight)
 (require 'riece-display)
+(require 'riece-debug)
 
 (defface riece-ctcp-action-face
   '((((class color)
@@ -51,6 +52,9 @@
 
 (defvar riece-ctcp-enabled nil)
 
+(defconst riece-ctcp-description
+  "CTCP (Client To Client Protocol) support")
+
 (defun riece-handle-ctcp-request (prefix string)
   (when (and riece-ctcp-enabled prefix string
             (riece-prefix-nickname prefix))
@@ -69,27 +73,15 @@
                  (after-hook
                   (intern (concat "riece-ctcp-after-" request
                                   "-request-hook"))))
-             (unless (condition-case error
-                         (run-hook-with-args-until-success
-                          hook prefix (car targets) message)
-                       (error
-                        (if riece-debug
-                            (message "Error in `%S': %S" hook error))
-                        nil))
+             (unless (riece-ignore-errors (symbol-name hook)
+                       (run-hook-with-args-until-success
+                        hook prefix (car targets) message))
                (if function
-                   (condition-case error
-                       (funcall function prefix (car targets) message)
-                     (error
-                      (if riece-debug
-                          (message "Error in `%S': %S"
-                                   function error))))))
-             (condition-case error
+                   (riece-ignore-errors (symbol-name function)
+                     (funcall function prefix (car targets) message)))
+               (riece-ignore-errors (symbol-name after-hook)
                  (run-hook-with-args-until-success
-                  after-hook prefix (car targets) message)
-               (error
-                (if riece-debug
-                    (message "Error in `%S': %S"
-                             after-hook error)))))
+                  after-hook prefix (car targets) message))))
            t)))))
 
 (defun riece-handle-ctcp-version-request (prefix target string)
@@ -187,6 +179,28 @@
      (concat (riece-concat-server-name (concat riece-ctcp-action-prefix user
                                               " " string)) "\n"))))
 
+(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)))
+        (user (riece-prefix-nickname prefix))
+        (time (format-time-string "%c")))
+    (riece-send-string
+     (format "NOTICE %s :\1TIME %s\1\r\n" user time))
+    (riece-insert-change buffer (format "CTCP TIME from %s\n" user))
+    (riece-insert-change
+     (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
+       (format "CTCP TIME from %s (%s) to %s"
+              user
+              (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
+              (riece-format-identity target-identity t)))
+      "\n"))))
+
 (defun riece-handle-ctcp-response (prefix string)
   (when (and riece-ctcp-enabled prefix string
             (riece-prefix-nickname prefix))
@@ -204,27 +218,15 @@
                  (after-hook
                   (intern (concat "riece-ctcp-after-" response
                                   "-response-hook"))))
-             (unless (condition-case error
-                         (run-hook-with-args-until-success
-                          hook prefix (car targets) message)
-                       (error
-                        (if riece-debug
-                            (message "Error in `%S': %S" hook error))
-                        nil))
+             (unless (riece-ignore-errors (symbol-name hook)
+                       (run-hook-with-args-until-success
+                        hook prefix (car targets) message))
                (if function
-                   (condition-case error
-                       (funcall function prefix (car targets) message)
-                     (error
-                      (if riece-debug
-                          (message "Error in `%S': %S"
-                                   function error))))))
-             (condition-case error
+                   (riece-ignore-errors (symbol-name function)
+                     (funcall function prefix (car targets) message)))
+               (riece-ignore-errors (symbol-name after-hook)
                  (run-hook-with-args-until-success
-                  after-hook prefix (car targets) message)
-               (error
-                (if riece-debug
-                    (message "Error in `%S': %S"
-                             after-hook error)))))
+                  after-hook prefix (car targets) message))))
            t)))))
 
 (defun riece-handle-ctcp-version-response (prefix target string)
@@ -263,6 +265,17 @@
             string))
     "\n")))
 
+(defun riece-handle-ctcp-time-response (prefix target string)
+  (riece-insert-change
+   (list riece-dialogue-buffer riece-others-buffer)
+   (concat
+    (riece-concat-server-name
+     (format "CTCP TIME for %s (%s) = %s"
+            (riece-prefix-nickname prefix)
+            (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
+            string))
+    "\n")))
+
 (defun riece-command-ctcp-version (target)
   (interactive
    (list (riece-completing-read-identity
@@ -327,6 +340,14 @@
                 " (in " (riece-format-identity target t) ")")))
       "\n"))))
 
+(defun riece-command-ctcp-time (target)
+  (interactive
+   (list (riece-completing-read-identity
+         "Channel/User: "
+         (riece-get-identities-on-server (riece-current-server-name)))))
+  (riece-send-string (format "PRIVMSG %s :\1TIME\1\r\n"
+                            (riece-identity-prefix target))))
+
 (defun riece-ctcp-requires ()
   (if (memq 'riece-highlight riece-addons)
       '(riece-highlight)))
@@ -347,6 +368,7 @@
   (define-key riece-dialogue-mode-map "\C-cp" 'riece-command-ctcp-ping)
   (define-key riece-dialogue-mode-map "\C-ca" 'riece-command-ctcp-action)
   (define-key riece-dialogue-mode-map "\C-cc" 'riece-command-ctcp-clientinfo)
+  (define-key riece-dialogue-mode-map "\C-ct" 'riece-command-ctcp-time)
   (setq riece-ctcp-enabled t))
 
 (defun riece-ctcp-disable ()
@@ -354,6 +376,7 @@
   (define-key riece-dialogue-mode-map "\C-cp" nil)
   (define-key riece-dialogue-mode-map "\C-ca" nil)
   (define-key riece-dialogue-mode-map "\C-cc" nil)
+  (define-key riece-dialogue-mode-map "\C-ct" nil)
   (setq riece-ctcp-enabled nil))
 
 (provide 'riece-ctcp)