(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 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)
" " 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 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)
" (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