lisp/erc/erc-capab.el

   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, "*".  If
  60 ;; the value of this variable is nil or you disable this module (see
  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 "*"
  76   "The prefix used for unidentified users."
  77   :group 'erc-capab
  78   :type '(choice string (const nil)))
  79
  80 ;;; Define module:
  81
  82 (define-erc-response-handler (290)
  83   "Handle dancer-ircd CAPAB messages." nil nil)
  84
  85 ;;;###autoload (autoload 'erc-capab-identify-mode "erc-capab" nil t)
  86 (define-erc-module capab-identify nil
  87   "Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
  88   ;; append so that `erc-server-parameters' is already set by `erc-server-005'
  89   ((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t)
  90    (add-hook 'erc-server-290-functions 'erc-capab-identify-activate)
  91    (add-hook 'erc-server-PRIVMSG-functions
  92              'erc-capab-identify-remove/set-identified-flag)
  93    (add-hook 'erc-server-NOTICE-functions
  94              'erc-capab-identify-remove/set-identified-flag)
  95    (add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t)
  96    (mapc (lambda (buffer)
  97            (when buffer
  98              (with-current-buffer buffer (erc-capab-identify-setup))))
  99          (erc-buffer-list 'erc-open-server-buffer-p)))
 100   ((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup)
 101    (remove-hook 'erc-server-290-functions 'erc-capab-identify-activate)
 102    ;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks
 103    ;; because there doesn't seem to be a way to tell the server to turn it off
 104    (remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix)))
 105
 106 ;;; Variables:
 107
 108 (defvar erc-capab-identify-activated nil
 109   "CAPAB IDENTIFY-MSG has been activated.")
 110 (make-variable-buffer-local 'erc-capab-identify-activated)
 111
 112 (defvar erc-capab-identify-sent nil
 113   "CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.")
 114 (make-variable-buffer-local 'erc-capab-identify-sent)
 115
 116 ;;; Functions:
 117
 118 (defun erc-capab-identify-setup (&optional proc parsed)
 119   "Set up CAPAB IDENTIFY on the current server.
 120
 121 Optional argument PROC is the current server's process.
 122 Optional argument PARSED is the current message, a response struct.
 123
 124 These arguments are sent to this function when called as a hook in
 125 `erc-server-005-functions'."
 126   (unless erc-capab-identify-sent
 127     (erc-capab-send-identify-messages)))
 128
 129 (defun erc-capab-send-identify-messages ()
 130   "Send CAPAB IDENTIFY messages if the server supports it."
 131   (when (and (stringp erc-server-version)
 132              (string-match "^\\(dancer-ircd\\|hyperion\\)" erc-server-version)
 133              ;; could possibly check for '("IRCD" . "dancer") in
 134              ;; `erc-server-parameters' instead of looking for a specific name
 135              ;; in `erc-server-version'
 136              (assoc "CAPAB" erc-server-parameters))
 137     (erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
 138     (erc-server-send "CAPAB IDENTIFY-MSG")
 139     (erc-server-send "CAPAB IDENTIFY-CTCP")
 140     (setq erc-capab-identify-sent t)))
 141
 142
 143 (defun erc-capab-identify-activate (proc parsed)
 144   "Set `erc-capab-identify-activated' and display an activation message.
 145
 146 PROC is the current server's process.
 147 PARSED is an `erc-parsed' response struct."
 148   (when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed))
 149             (string= "IDENTIFY-CTCP" (erc-response.contents parsed)))
 150     (setq erc-capab-identify-activated t)
 151     (erc-display-message
 152      parsed 'notice 'active (format "%s activated"
 153                                     (erc-response.contents parsed)))))
 154
 155 (defun erc-capab-identify-remove/set-identified-flag (proc parsed)
 156   "Remove PARSED message's id flag and add the `erc-identified' text property.
 157
 158 PROC is the current server's process.
 159 PARSED is an `erc-parsed' response struct."
 160   (let ((msg (erc-response.contents parsed)))
 161     (when (and erc-capab-identify-activated
 162                (string-match "^\\([-\\+]\\)\\(.+\\)$" msg))
 163       (setf (erc-response.contents parsed)
 164             (if erc-capab-identify-mode
 165                 (erc-propertize (match-string 2 msg)
 166                                 'erc-identified
 167                                 (if (string= (match-string 1 msg) "+")
 168                                     1
 169                                   0))
 170               (match-string 2 msg)))
 171       nil)))
 172
 173 (defun erc-capab-identify-add-prefix ()
 174   "Add `erc-capab-identify-prefix' to nickname if user is unidentified."
 175   (when (and erc-capab-identify-prefix
 176              (erc-with-server-buffer erc-capab-identify-activated))
 177     (goto-char (or (erc-find-parsed-property) (point-min)))
 178     (let ((nickname (erc-capab-get-unidentified-nickname
 179                      (erc-get-parsed-vector (point)))))
 180       (when (and nickname
 181                  (goto-char (point-min))
 182                  ;; assuming the first use of `nickname' is the sender's nick
 183                  (re-search-forward (regexp-quote nickname) nil t))
 184         (goto-char (match-beginning 0))
 185         (insert (erc-propertize erc-capab-identify-prefix
 186                                 'face (get-char-property (- (point) 1)
 187                                                          'face)))))))
 188
 189 (defun erc-capab-get-unidentified-nickname (parsed)
 190   "Return the nickname of the user if unidentified.
 191 PARSED is an `erc-parsed' response struct."
 192   (when (and (erc-response-p parsed)
 193              (equal 0 (get-text-property 0 'erc-identified
 194                                      (erc-response.contents parsed))))
 195     (let ((nickuserhost (erc-get-parsed-vector-nick parsed)))
 196       (when nickuserhost
 197        (nth 0 (erc-parse-user nickuserhost))))))
 198
 199 (provide 'erc-capab)
 200
 201 ;; arch-tag: 27b6d668-7ee5-4e47-b9f0-27d7a4362062
 202 ;;; erc-capab.el ends here