* riece-addon.el (riece-resolve-addons): Directory don't push to addon.
[riece] / lisp / riece-ctcp.el
index 8f19673..8c45869 100644 (file)
@@ -27,6 +27,8 @@
 (require 'riece-version)
 (require 'riece-misc)
 (require 'riece-highlight)
+(require 'riece-display)
+(require 'riece-debug)
 
 (defface riece-ctcp-action-face
   '((((class color)
 
 (defvar riece-dialogue-mode-map)
 
-(defun riece-ctcp-requires ()
-  (if (memq 'riece-highlight riece-addons)
-      '(riece-highlight)))
+(defvar riece-ctcp-enabled nil)
 
-(defun riece-ctcp-insinuate ()
-  (add-hook 'riece-privmsg-hook 'riece-handle-ctcp-request)
-  (add-hook 'riece-notice-hook 'riece-handle-ctcp-response)
-  (if (memq 'riece-highlight riece-addons)
-      (setq riece-dialogue-font-lock-keywords
-           (cons (list (concat "^" riece-time-prefix-regexp "\\("
-                               (regexp-quote riece-ctcp-action-prefix)
-                               ".*\\)$")
-                       1 riece-ctcp-action-face t t)
-                 riece-dialogue-font-lock-keywords)))
-  (define-key riece-dialogue-mode-map "\C-cv" 'riece-command-ctcp-version)
-  (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))
+(defconst riece-ctcp-description
+  "CTCP (Client To Client Protocol) support")
 
 (defun riece-handle-ctcp-request (prefix string)
-  (when (and prefix string
+  (when (and riece-ctcp-enabled prefix string
             (riece-prefix-nickname prefix))
     (let* ((parameters (riece-split-parameters string))
           (targets (split-string (car parameters) ","))
                  (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 occurred 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 occurred 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 occurred in `%S': %S"
-                             after-hook error)))))
+                  after-hook prefix (car targets) message))))
            t)))))
 
 (defun riece-handle-ctcp-version-request (prefix target string)
                                               " " string)) "\n"))))
 
 (defun riece-handle-ctcp-response (prefix string)
-  (when (and prefix string
+  (when (and riece-ctcp-enabled prefix string
             (riece-prefix-nickname prefix))
     (let* ((parameters (riece-split-parameters string))
           (targets (split-string (car parameters) ","))
                  (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 occurred 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 occurred 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 occurred in `%S': %S"
-                             after-hook error)))))
+                  after-hook prefix (car targets) message))))
            t)))))
 
 (defun riece-handle-ctcp-version-response (prefix target string)
                 " (in " (riece-format-identity target t) ")")))
       "\n"))))
 
+(defun riece-ctcp-requires ()
+  (if (memq 'riece-highlight riece-addons)
+      '(riece-highlight)))
+
+(defun riece-ctcp-insinuate ()
+  (add-hook 'riece-privmsg-hook 'riece-handle-ctcp-request)
+  (add-hook 'riece-notice-hook 'riece-handle-ctcp-response)
+  (if (memq 'riece-highlight riece-addons)
+      (setq riece-dialogue-font-lock-keywords
+           (cons (list (concat "^" riece-time-prefix-regexp "\\("
+                               (regexp-quote riece-ctcp-action-prefix)
+                               ".*\\)$")
+                       1 riece-ctcp-action-face t t)
+                 riece-dialogue-font-lock-keywords))))
+
+(defun riece-ctcp-enable ()
+  (define-key riece-dialogue-mode-map "\C-cv" 'riece-command-ctcp-version)
+  (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)
+  (setq riece-ctcp-enabled t))
+
+(defun riece-ctcp-disable ()
+  (define-key riece-dialogue-mode-map "\C-cv" nil)
+  (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)
+  (setq riece-ctcp-enabled nil))
+
 (provide 'riece-ctcp)
 
 ;;; riece-ctcp.el ends here