cgit.sxemacs.org Git - packages/blob - xemacs-packages/zenirc/src/zenirc-iwantop.el

   1 ;;; zenirc-iwantop.el --- IWANTOP ctcp for granting channel operator bits
   2
   3 ;; Copyright (C) 1995 Eric Prestemon
   4 ;; Copyright (C) 1995, 1996 Per Persson
   5
   6 ;; Author: Eric Prestemon <ecp@io.com>
   7 ;;         Noah Friedman <friedman@prep.ai.mit.edu>
   8 ;;         Per Persson <pp@sno.pp.se>
   9 ;; Maintainer: pp@sno.pp.se
  10 ;; Keywords: zenirc, extensions
  11 ;; Created: 1995-03-31
  12
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17 ;;
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22 ;;
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; if not, you can either send email to this
  25 ;; program's maintainer or write to: The Free Software Foundation,
  26 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29 ;;; Code:
  30
  31 (require 'zenirc)
  32
  33 (defvar zenirc-iwantop-alist nil
  34   "*Association list of channel names and users allowed to be channel-opped.
  35 That is, when someone sends you an IWANTOP ctcp, they are checked against
  36 this alist to see if your client should automatically op them.
  37
  38 Each channel name and user is treated as a regular expression.
  39 More than one user can be listed for each channel.
  40
  41 Here is an example:
  42
  43     (setq zenirc-iwantop-alist
  44           '((\"#twilight_zone\" \"pjg@.*.buffalo.edu\" \"trillian!.*kei.com\")
  45             (\"#bondage\"       \".*\")))
  46
  47 This will allow anyone to be opped, anywhere:
  48
  49     (setq zenirc-iwantop-alist '((\".*\" \".*\")))
  50 ")
  51
  52 ; If you want ZenIRC to see other things then just IWANTOP, do stuff like
  53 ; (setq zenirc-ctcp-query-LICKMYPENIS-hook '(zenirc-ctcp-query-IWANTOP))
  54 ; in your .emacs or wherever.
  55 (defvar zenirc-ctcp-query-IWANTOP-hook '(zenirc-ctcp-query-IWANTOP))
  56
  57 (defun zenirc-ctcp-query-IWANTOP (proc parsedctcp from to)
  58   (save-match-data
  59     (let ((case-fold-search t)
  60           (sender (zenirc-extract-nick from))
  61           (nick (zenirc-run-hook 'zenirc-format-nickuserhost-hook from))
  62           (channel (car (zenirc-parse-firstword (cdr parsedctcp))))
  63           (fmt-failed "NOTICE %s :Oink!\n")
  64           (fmt-sorry "NOTICE %s :Missing #channel argument!\n")
  65           (fmt-mode   "MODE %s +o %s\n")
  66           (alist zenirc-iwantop-alist)
  67           (list nil))
  68
  69       (and zenirc-verbose-ctcp
  70            (zenirc-message proc 'query nick to
  71                            (concat (car parsedctcp) " " (cdr parsedctcp))))
  72
  73       (cond ((or (null channel)
  74                  (not (zenirc-channel-p channel)))
  75              (process-send-string proc (format fmt-sorry sender)))
  76             (t
  77              ;; Do a zenirc-downcase-name even though case-fold-search is t
  78              ;; because extra characters are translated to conform with
  79              ;; RFC1459.
  80              (setq channel (zenirc-downcase-name channel))
  81              (while alist
  82                (and (string-match (zenirc-downcase-name (car (car alist)))
  83                                  channel)
  84                     (progn
  85                       ;; skip the first elt of the car of alist, since
  86                       ;; that's just the channel name regexp
  87                       (setq list (cdr (car alist)))
  88                       (setq alist nil)))
  89                (setq alist (cdr alist)))
  90
  91              ;; if verbose ctcp is on, tell the user we got the query
  92              (if (and list (zenirc-string-match-list from list))
  93                  (process-send-string proc (format fmt-mode channel sender))
  94                (process-send-string proc (format fmt-failed sender))))))))
  95
  96 (provide 'zenirc-iwantop)
  97
  98 ;;; zenirc-iwantop.el ends here