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