(require 'riece-version)
(require 'riece-misc)
+(require 'riece-display)
+(require 'riece-highlight)
+
+(defface riece-ctcp-action-face
+ '((((class color)
+ (background dark))
+ (:foreground "PaleGreen" :italic t))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen" :italic t))
+ (t
+ (:bold t)))
+ "Face used for displaying \"*** Action:\" line"
+ :group 'riece-highlight-faces)
+(defvar riece-ctcp-action-face 'riece-ctcp-action-face)
+
+(defconst riece-ctcp-action-prefix "*** Action: ")
(defvar riece-ctcp-ping-time nil)
(defvar riece-ctcp-additional-clientinfo nil)
(defvar riece-dialogue-mode-map)
+(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)))
(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)
(defun riece-handle-ctcp-version-request (prefix target string)
(let ((buffer (if (riece-channel-p target)
- (cdr (riece-identity-assoc-no-server
- (riece-make-identity target)
- riece-channel-buffer-alist))))
+ (riece-channel-buffer (riece-make-identity
+ target riece-server-name))))
(user (riece-prefix-nickname prefix)))
(riece-send-string
(format "NOTICE %s :\1VERSION %s\1\r\n" user (riece-extended-version)))
(defun riece-handle-ctcp-ping-request (prefix target string)
(let ((buffer (if (riece-channel-p target)
- (cdr (riece-identity-assoc-no-server
- (riece-make-identity target)
- riece-channel-buffer-alist))))
+ (riece-channel-buffer (riece-make-identity
+ target riece-server-name))))
(user (riece-prefix-nickname prefix)))
(riece-send-string
(if string
(defun riece-handle-ctcp-clientinfo-request (prefix target string)
(let ((buffer (if (riece-channel-p target)
- (cdr (riece-identity-assoc-no-server
- (riece-make-identity target)
- riece-channel-buffer-alist))))
+ (riece-channel-buffer (riece-make-identity
+ target riece-server-name))))
(user (riece-prefix-nickname prefix)))
(riece-send-string
(format "NOTICE %s :\1CLIENTINFO %s\1\r\n"
(defun riece-handle-ctcp-action-request (prefix target string)
(let ((buffer (if (riece-channel-p target)
- (cdr (riece-identity-assoc-no-server
- (riece-make-identity target)
- riece-channel-buffer-alist))))
+ (riece-channel-buffer (riece-make-identity
+ target riece-server-name))))
(user (riece-prefix-nickname prefix)))
- (riece-insert-change buffer (concat user " " string "\n"))
- (riece-insert-change
+ (riece-insert buffer (concat riece-ctcp-action-prefix user " " 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 user " " string)) "\n"))))
+ (concat (riece-concat-server-name (concat riece-ctcp-action-prefix user
+ " " string)) "\n"))))
(defun riece-handle-ctcp-response (prefix string)
(when (and prefix string
string))
"\n")))
-(defun riece-command-ctcp-version (user)
+(defun riece-command-ctcp-version (target)
(interactive
- (let ((completion-ignore-case t))
- (list (completing-read
- "Channel/User: "
- (mapcar #'list (riece-get-users-on-server))))))
- (riece-send-string (format "PRIVMSG %s :\1VERSION\1\r\n" user)))
+ (list (riece-completing-read-identity
+ "Channel/User: "
+ (apply #'nconc
+ (mapcar (lambda (entry)
+ (riece-get-identities-on-server (car entry)))
+ riece-server-process-alist)))))
+ (riece-send-string (format "PRIVMSG %s :\1VERSION\1\r\n"
+ (riece-identity-prefix target))))
-(defun riece-command-ctcp-ping (user)
+(defun riece-command-ctcp-ping (target)
(interactive
- (let ((completion-ignore-case t))
- (list (completing-read
- "Channel/User: "
- (mapcar #'list (riece-get-users-on-server))))))
- (riece-send-string (format "PRIVMSG %s :\1PING\1\r\n" user))
+ (list (riece-completing-read-identity
+ "Channel/User: "
+ (apply #'nconc
+ (mapcar (lambda (entry)
+ (riece-get-identities-on-server (car entry)))
+ riece-server-process-alist)))))
+ (riece-send-string (format "PRIVMSG %s :\1PING\1\r\n"
+ (riece-identity-prefix target)))
(setq riece-ctcp-ping-time (current-time)))
-(defun riece-command-ctcp-clientinfo (user)
+(defun riece-command-ctcp-clientinfo (target)
(interactive
- (let ((completion-ignore-case t))
- (list (completing-read
- "Channel/User: "
- (mapcar #'list (riece-get-users-on-server))))))
- (riece-send-string (format "PRIVMSG %s :\1CLIENTINFO\1\r\n" user)))
+ (list (riece-completing-read-identity
+ "Channel/User: "
+ (apply #'nconc
+ (mapcar (lambda (entry)
+ (riece-get-identities-on-server (car entry)))
+ riece-server-process-alist)))))
+ (riece-send-string (format "PRIVMSG %s :\1CLIENTINFO\1\r\n"
+ (riece-identity-prefix target))))
-(defun riece-command-ctcp-action (channel action)
+(defun riece-command-ctcp-action (target action)
(interactive
(list (if current-prefix-arg
- (completing-read
+ (riece-completing-read-identity
"Channel/User: "
- (mapcar #'list riece-current-channels))
+ (apply #'nconc
+ (mapcar (lambda (entry)
+ (riece-get-identities-on-server (car entry)))
+ riece-server-process-alist)))
riece-current-channel)
(read-string "Action: ")))
(if (equal action "")
(error "No action"))
(riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n"
- (riece-identity-prefix channel)
+ (riece-identity-prefix target)
action))
- (let ((buffer (cdr (riece-identity-assoc-no-server
- (riece-make-identity channel)
- riece-channel-buffer-alist))))
- (riece-insert-change
+ (let ((buffer (riece-channel-buffer target)))
+ (riece-insert
buffer
- (concat (riece-identity-prefix (riece-current-nickname)) " " action "\n"))
- (riece-insert-change
+ (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-concat-server-name
- (concat (riece-identity-prefix (riece-current-nickname)) " " action))
+ (concat riece-ctcp-action-prefix
+ (riece-identity-prefix (riece-current-nickname)) " " action))
"\n"))))
(provide 'riece-ctcp)