[bpt/emacs.git] / lisp / erc / erc-capab.el

;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB

;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file defines the ERC module `erc-capab-identify', which allows
;; flagging of unidentified users on servers running dancer-ircd or
;; hyperion.  freenode.net supports this capability, for example.

;; With CAPAB IDENTIFY-MSG and IDENTIFY-CTCP enabled, messages from
;; users who have identified themselves to NickServ will have a plus
;; sign and messages from unidentified users will have a minus sign
;; added as a prefix.  Note that it is not necessary for your nickname
;; to be identified in order to receive these marked messages.

;; The plus or minus sign is removed from the message, and a prefix,
;; `erc-capab-identify-prefix', is inserted in the front of the user's
;; nickname if the nickname is not identified.

;; Please note that once this has been enabled on a server, there is no
;; way to tell the server to stop sending marked messages.  If you
;; disable this module, it will continue removing message flags, but the
;; unidentified nickname prefix will not be added to messages.

;; Visit <http://freenode.net/faq.shtml#spoofing> and
;; <http://freenode.net/faq.shtml#registering> to find further
;; explanations of this capability.

;; From freenode.net's web site (not there anymore) on how to mark
;; unidentified users:
;; "We recommend that you add an asterisk before the nick, and
;;  optionally either highlight or colorize the line in some
;;  appropriate fashion, if the user is not identified."

;;; Usage:

;; Put the following in your ~/.emacs file.

;; (require 'erc-capab)
;; (erc-capab-identify-mode 1)

;; `erc-capab-identify-prefix' will now be added to the beginning of
;; unidentified users' nicknames.  The default is an asterisk, "*".
;; You can customize the prefix and the face used to display it,
;; `erc-capab-identify-unidentified'.  If the value of
;; `erc-capab-identify-prefix' is nil or you disable this module (see
;; `erc-capab-identify-disable'), no prefix will be inserted, but the
;; flag sent by the server will still be stripped.

;;; Code:

(require 'erc)
(eval-when-compile (require 'cl))

;;; Customization:

(defgroup erc-capab nil
  "Support for dancer-ircd's CAPAB settings."
  :group 'erc)

(defcustom erc-capab-identify-prefix "*"
  "The prefix used for unidentified users.

If you change this from the default \"*\", be sure to use a
character not found in IRC nicknames to avoid confusion."
  :group 'erc-capab
  :type '(choice string (const nil)))

(defface erc-capab-identify-unidentified '((t)) ; same as `erc-default-face'
  "Face to use for `erc-capab-identify-prefix'."
  :group 'erc-capab
  :group 'erc-faces)

;;; Define module:

;;;###autoload (autoload 'erc-capab-identify-mode "erc-capab" nil t)
(define-erc-module capab-identify nil
  "Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
  ;; append so that `erc-server-parameters' is already set by `erc-server-005'
  ((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t)
   (add-hook 'erc-server-290-functions 'erc-capab-identify-activate)
   (add-hook 'erc-server-PRIVMSG-functions
             'erc-capab-identify-remove/set-identified-flag)
   (add-hook 'erc-server-NOTICE-functions
             'erc-capab-identify-remove/set-identified-flag)
   (add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t)
   (mapc (lambda (buffer)
           (when buffer
             (with-current-buffer buffer (erc-capab-identify-setup))))
         (erc-buffer-list 'erc-open-server-buffer-p)))
  ((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup)
   (remove-hook 'erc-server-290-functions 'erc-capab-identify-activate)
   ;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks
   ;; because there doesn't seem to be a way to tell the server to turn it off
   (remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix)))

;;; Variables:

(defvar erc-capab-identify-activated nil
  "CAPAB IDENTIFY-MSG has been activated.")
(make-variable-buffer-local 'erc-capab-identify-activated)

(defvar erc-capab-identify-sent nil
  "CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.")
(make-variable-buffer-local 'erc-capab-identify-sent)

;;; Functions:

(defun erc-capab-identify-setup (&optional proc parsed)
  "Set up CAPAB IDENTIFY on the current server.

Optional argument PROC is the current server's process.
Optional argument PARSED is the current message, a response struct.

These arguments are sent to this function when called as a hook in
`erc-server-005-functions'."
  (unless erc-capab-identify-sent
    (erc-capab-identify-send-messages)))

(defun erc-capab-identify-send-messages ()
  "Send CAPAB IDENTIFY messages if the server supports it."
  (when (and (stringp erc-server-version)
             (string-match "^\\(dancer-ircd\\|hyperion\\)" erc-server-version)
             ;; could possibly check for '("IRCD" . "dancer") in
             ;; `erc-server-parameters' instead of looking for a specific name
             ;; in `erc-server-version'
             (assoc "CAPAB" erc-server-parameters))
    (erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
    (erc-server-send "CAPAB IDENTIFY-MSG")
    (erc-server-send "CAPAB IDENTIFY-CTCP")
    (setq erc-capab-identify-sent t)))


(defun erc-capab-identify-activate (proc parsed)
  "Set `erc-capab-identify-activated' and display an activation message.

PROC is the current server's process.
PARSED is an `erc-parsed' response struct."
  (when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed))
            (string= "IDENTIFY-CTCP" (erc-response.contents parsed)))
    (setq erc-capab-identify-activated t)
    (erc-display-message
     parsed 'notice 'active (format "%s activated"
                                    (erc-response.contents parsed)))))

(defun erc-capab-identify-remove/set-identified-flag (proc parsed)
  "Remove PARSED message's id flag and add the `erc-identified' text property.

PROC is the current server's process.
PARSED is an `erc-parsed' response struct."
  (let ((msg (erc-response.contents parsed)))
    (when (and erc-capab-identify-activated
               (string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
      (setf (erc-response.contents parsed)
            (if erc-capab-identify-mode
                (erc-propertize (match-string 2 msg)
                                'erc-identified
                                (if (string= (match-string 1 msg) "+")
                                    1
                                  0))
              (match-string 2 msg)))
      nil)))

(defun erc-capab-identify-add-prefix ()
  "Add `erc-capab-identify-prefix' to nickname if user is unidentified."
  (when (and erc-capab-identify-prefix
             (erc-with-server-buffer erc-capab-identify-activated))
    (goto-char (or (erc-find-parsed-property) (point-min)))
    (let ((nickname (erc-capab-identify-get-unidentified-nickname
                     (erc-get-parsed-vector (point)))))
      (when (and nickname
                 (goto-char (point-min))
                 ;; assuming the first use of `nickname' is the sender's nick
                 (re-search-forward (regexp-quote nickname) nil t))
        (goto-char (match-beginning 0))
        (insert (erc-propertize erc-capab-identify-prefix
                                'face 'erc-capab-identify-unidentified))))))

(defun erc-capab-identify-get-unidentified-nickname (parsed)
  "Return the nickname of the user if unidentified.
PARSED is an `erc-parsed' response struct."
  (when (and (erc-response-p parsed)
             (equal 0 (get-text-property 0 'erc-identified
                                     (erc-response.contents parsed))))
    (let ((nickuserhost (erc-get-parsed-vector-nick parsed)))
      (when nickuserhost
       (nth 0 (erc-parse-user nickuserhost))))))

(provide 'erc-capab)

;; arch-tag: 27b6d668-7ee5-4e47-b9f0-27d7a4362062
;;; erc-capab.el ends here
Commit	Line	Data
6904f7fe MB	1	;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
6904f7fe MB	2
5df4f04c	3	;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
6904f7fe	4
4ee57b2a	5	;; GNU Emacs is free software: you can redistribute it and/or modify
6904f7fe	6	;; it under the terms of the GNU General Public License as published by
4ee57b2a GM	7	;; the Free Software Foundation, either version 3 of the License, or
4ee57b2a GM	8	;; (at your option) any later version.
6904f7fe MB	9
	10	;; GNU Emacs is distributed in the hope that it will be useful,
	11	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	;; GNU General Public License for more details.
	14
	15	;; You should have received a copy of the GNU General Public License
4ee57b2a	16	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
6904f7fe MB	17
	18	;;; Commentary:
	19
	20	;; This file defines the ERC module `erc-capab-identify', which allows
	21	;; flagging of unidentified users on servers running dancer-ircd or
	22	;; hyperion. freenode.net supports this capability, for example.
	23
	24	;; With CAPAB IDENTIFY-MSG and IDENTIFY-CTCP enabled, messages from
	25	;; users who have identified themselves to NickServ will have a plus
	26	;; sign and messages from unidentified users will have a minus sign
	27	;; added as a prefix. Note that it is not necessary for your nickname
	28	;; to be identified in order to receive these marked messages.
	29
	30	;; The plus or minus sign is removed from the message, and a prefix,
	31	;; `erc-capab-identify-prefix', is inserted in the front of the user's
	32	;; nickname if the nickname is not identified.
	33
	34	;; Please note that once this has been enabled on a server, there is no
	35	;; way to tell the server to stop sending marked messages. If you
	36	;; disable this module, it will continue removing message flags, but the
	37	;; unidentified nickname prefix will not be added to messages.
	38
	39	;; Visit <http://freenode.net/faq.shtml#spoofing> and
	40	;; <http://freenode.net/faq.shtml#registering> to find further
	41	;; explanations of this capability.
	42
	43	;; From freenode.net's web site (not there anymore) on how to mark
	44	;; unidentified users:
	45	;; "We recommend that you add an asterisk before the nick, and
6772c8e1	46	;; optionally either highlight or colorize the line in some
6904f7fe MB	47	;; appropriate fashion, if the user is not identified."
	48
	49	;;; Usage:
	50
	51	;; Put the following in your ~/.emacs file.
	52
	53	;; (require 'erc-capab)
	54	;; (erc-capab-identify-mode 1)
	55
	56	;; `erc-capab-identify-prefix' will now be added to the beginning of
ff59d266 MB	57	;; unidentified users' nicknames. The default is an asterisk, "*".
	58	;; You can customize the prefix and the face used to display it,
	59	;; `erc-capab-identify-unidentified'. If the value of
	60	;; `erc-capab-identify-prefix' is nil or you disable this module (see
6904f7fe MB	61	;; `erc-capab-identify-disable'), no prefix will be inserted, but the
	62	;; flag sent by the server will still be stripped.
	63
	64	;;; Code:
	65
	66	(require 'erc)
	67	(eval-when-compile (require 'cl))
	68
	69	;;; Customization:
	70
	71	(defgroup erc-capab nil
	72	"Support for dancer-ircd's CAPAB settings."
	73	:group 'erc)
	74
	75	(defcustom erc-capab-identify-prefix "*"
ff59d266 MB	76	"The prefix used for unidentified users.
	77
	78	If you change this from the default \"*\", be sure to use a
	79	character not found in IRC nicknames to avoid confusion."
6904f7fe MB	80	:group 'erc-capab
	81	:type '(choice string (const nil)))
	82
ff59d266 MB	83	(defface erc-capab-identify-unidentified '((t)) ; same as `erc-default-face'
	84	"Face to use for `erc-capab-identify-prefix'."
	85	:group 'erc-capab
	86	:group 'erc-faces)
6904f7fe	87
ff59d266	88	;;; Define module:
6904f7fe MB	89
	90	;;;###autoload (autoload 'erc-capab-identify-mode "erc-capab" nil t)
	91	(define-erc-module capab-identify nil
	92	"Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
	93	;; append so that `erc-server-parameters' is already set by `erc-server-005'
	94	((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t)
	95	(add-hook 'erc-server-290-functions 'erc-capab-identify-activate)
	96	(add-hook 'erc-server-PRIVMSG-functions
	97	'erc-capab-identify-remove/set-identified-flag)
	98	(add-hook 'erc-server-NOTICE-functions
	99	'erc-capab-identify-remove/set-identified-flag)
	100	(add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t)
	101	(mapc (lambda (buffer)
	102	(when buffer
	103	(with-current-buffer buffer (erc-capab-identify-setup))))
	104	(erc-buffer-list 'erc-open-server-buffer-p)))
	105	((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup)
	106	(remove-hook 'erc-server-290-functions 'erc-capab-identify-activate)
	107	;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks
	108	;; because there doesn't seem to be a way to tell the server to turn it off
	109	(remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix)))
	110
	111	;;; Variables:
	112
	113	(defvar erc-capab-identify-activated nil
	114	"CAPAB IDENTIFY-MSG has been activated.")
	115	(make-variable-buffer-local 'erc-capab-identify-activated)
	116
	117	(defvar erc-capab-identify-sent nil
	118	"CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.")
	119	(make-variable-buffer-local 'erc-capab-identify-sent)
	120
	121	;;; Functions:
	122
	123	(defun erc-capab-identify-setup (&optional proc parsed)
	124	"Set up CAPAB IDENTIFY on the current server.
	125
	126	Optional argument PROC is the current server's process.
	127	Optional argument PARSED is the current message, a response struct.
	128
	129	These arguments are sent to this function when called as a hook in
	130	`erc-server-005-functions'."
	131	(unless erc-capab-identify-sent
ff59d266	132	(erc-capab-identify-send-messages)))
6904f7fe	133
ff59d266	134	(defun erc-capab-identify-send-messages ()
6904f7fe MB	135	"Send CAPAB IDENTIFY messages if the server supports it."
	136	(when (and (stringp erc-server-version)
	137	(string-match "^\\(dancer-ircd\\\|hyperion\\)" erc-server-version)
	138	;; could possibly check for '("IRCD" . "dancer") in
	139	;; `erc-server-parameters' instead of looking for a specific name
	140	;; in `erc-server-version'
	141	(assoc "CAPAB" erc-server-parameters))
	142	(erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
	143	(erc-server-send "CAPAB IDENTIFY-MSG")
	144	(erc-server-send "CAPAB IDENTIFY-CTCP")
	145	(setq erc-capab-identify-sent t)))
	146
	147
	148	(defun erc-capab-identify-activate (proc parsed)
	149	"Set `erc-capab-identify-activated' and display an activation message.
	150
	151	PROC is the current server's process.
	152	PARSED is an `erc-parsed' response struct."
	153	(when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed))
	154	(string= "IDENTIFY-CTCP" (erc-response.contents parsed)))
	155	(setq erc-capab-identify-activated t)
	156	(erc-display-message
	157	parsed 'notice 'active (format "%s activated"
	158	(erc-response.contents parsed)))))
	159
	160	(defun erc-capab-identify-remove/set-identified-flag (proc parsed)
	161	"Remove PARSED message's id flag and add the `erc-identified' text property.
	162
	163	PROC is the current server's process.
	164	PARSED is an `erc-parsed' response struct."
	165	(let ((msg (erc-response.contents parsed)))
	166	(when (and erc-capab-identify-activated
	167	(string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
	168	(setf (erc-response.contents parsed)
	169	(if erc-capab-identify-mode
	170	(erc-propertize (match-string 2 msg)
	171	'erc-identified
	172	(if (string= (match-string 1 msg) "+")
	173	1
	174	0))
	175	(match-string 2 msg)))
	176	nil)))
	177
	178	(defun erc-capab-identify-add-prefix ()
	179	"Add `erc-capab-identify-prefix' to nickname if user is unidentified."
	180	(when (and erc-capab-identify-prefix
	181	(erc-with-server-buffer erc-capab-identify-activated))
	182	(goto-char (or (erc-find-parsed-property) (point-min)))
ff59d266	183	(let ((nickname (erc-capab-identify-get-unidentified-nickname
6904f7fe MB	184	(erc-get-parsed-vector (point)))))
	185	(when (and nickname
	186	(goto-char (point-min))
	187	;; assuming the first use of `nickname' is the sender's nick
	188	(re-search-forward (regexp-quote nickname) nil t))
	189	(goto-char (match-beginning 0))
	190	(insert (erc-propertize erc-capab-identify-prefix
ff59d266	191	'face 'erc-capab-identify-unidentified))))))
6904f7fe	192
ff59d266	193	(defun erc-capab-identify-get-unidentified-nickname (parsed)
6904f7fe MB	194	"Return the nickname of the user if unidentified.
	195	PARSED is an `erc-parsed' response struct."
	196	(when (and (erc-response-p parsed)
	197	(equal 0 (get-text-property 0 'erc-identified
	198	(erc-response.contents parsed))))
	199	(let ((nickuserhost (erc-get-parsed-vector-nick parsed)))
	200	(when nickuserhost
	201	(nth 0 (erc-parse-user nickuserhost))))))
	202
	203	(provide 'erc-capab)
	204
	205	;; arch-tag: 27b6d668-7ee5-4e47-b9f0-27d7a4362062
	206	;;; erc-capab.el ends here