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

   1 ;;;  zenirc-ignore.el -- ignore module for zenirc.
   2
   3 ;; Copyright (C) 1995, 1996 jason@marilyn.oit.umass.edu
   4 ;; Copyright (C) 1995, 1996, 1998 Per Persson
   5
   6 ;; Author: Jason Bastek <jason@marilyn.oit.umass.edu>
   7 ;;         Per Persson <pp@sno.pp.se>
   8 ;; Maintainer: pp@sno.pp.se
   9 ;; Keywords: zenirc, ignorance
  10 ;; Created: 96-04-11
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; if not, you can either send email to this
  24 ;; program's maintainer or write to: The Free Software Foundation,
  25 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 \f
  32
  33 ;; usage: /ignore [string] {all,message,dcc,ctcp,notice,action}
  34 ;;        /unignore [string]
  35
  36 (require 'zenirc)
  37
  38 (defun zenirc-ignore-install-message-catalogs ()
  39   (zenirc-lang-define-catalog 'english
  40    '((ignore-start-list . "[info] current ignoramuses:")
  41      (ignore-list . "[info]   %s")
  42      (ignore-end-list . "[info] (end of list)")
  43      (ignore-new-entry . "[info] now ignoring %s")
  44      (ignore-bad-command . "[info] bad ignore command.")
  45      (ignore-bad-keyword . "[info] unknown ignore keyword: %s")
  46      (ignore-usage . "[info] usage: /ignore thing {all,message,dcc,ctcp,notice,action}")
  47      )))
  48
  49 ;; this is not buffer local by default, with zenirc-ignore.el it makes
  50 ;; more sense to have it buffer local
  51 (make-variable-buffer-local 'zenirc-ignore-list)
  52
  53 (defvar zenirc-command-ignore-hook '(zenirc-process-ignore))
  54 (defvar zenirc-command-unignore-hook '(zenirc-remove-from-ignore-list))
  55
  56 (defun zenirc-process-ignore (proc parsedcmd)
  57   "Add someone to the list of ignoramuses."
  58   (let ((lst (zenirc-parse-words (cdr parsedcmd))))
  59     (cond ((> (length lst) 2)
  60            (zenirc-message proc 'ignore-bad-command))
  61           ((= (length lst) 2)
  62            (let* ((thing-to-ignore (regexp-quote (car lst)))
  63                   (ignore-keyword (car (cdr lst)))
  64                   (ignore-prefix
  65                    (zenirc-ignore-determine-prefix thing-to-ignore))
  66                   (ignore-keyword
  67                    (zenirc-ignore-determine-keyword ignore-keyword))
  68                   (ignore-string (concat ignore-prefix " " ignore-keyword)))
  69              (if (null ignore-keyword)
  70                  (zenirc-message proc 'ignore-bad-keyword
  71                                  ignore-keyword)
  72                (zenirc-message proc 'ignore-new-entry ignore-string)
  73                (setq zenirc-ignore-list
  74                      (cons ignore-string zenirc-ignore-list)))))
  75           ((= (length lst) 1)
  76            (zenirc-message proc 'ignore-usage))
  77           (t
  78            (zenirc-ignore-display-ignore-list proc)))))
  79
  80 (defun zenirc-ignore-determine-prefix (str)
  81   "Take the first thing typed by the user at an /ignore command, and
  82 figure out what it's supposed to translate to.  For now, this means
  83 that if the string doesn't look like a hostname, it's treated as a
  84 nickname.  Otherwise, it's treated as a hostname."
  85   (cond ((string-match "!" str) ;; nick!user@host, don't touch it
  86          str)
  87         ((string-match "@" str)
  88          (concat "^:.*!.*" str))
  89         (t
  90          (concat "^:" str "!.*@.*"))))
  91
  92 (defun zenirc-ignore-determine-keyword (str)
  93   "Take the second thing typed by the user at an /ignore command, and
  94 figure out what it translates to.  For now, it can be one of:
  95
  96    all message dcc ctcp notice action
  97
  98 This returns nil if the keyword was unknown."
  99   (interactive)
 100   (let ((keyword
 101          (cond ((string= str "all")     "")
 102                ((string= str "message") "PRIVMSG")
 103                ((string= str "dcc")     "PRIVMSG[^:]+:\ 1DCC")
 104                ((string= str "ctcp")    "PRIVMSG[^:]+:\ 1")
 105                ((string= str "notice")  "NOTICE")
 106                ((string= str "action")  "PRIVMSG[^:]+:\ 1ACTION")
 107                (t nil))))
 108     keyword))
 109
 110 (defun zenirc-ignore-display-ignore-list (proc)
 111   "show the current ignore list."
 112   (zenirc-message proc 'ignore-start-list)
 113   (let ((lst zenirc-ignore-list))
 114     (while lst
 115       (progn (zenirc-message proc 'ignore-list (car lst))
 116              (setq lst (cdr lst))))
 117     (zenirc-message proc 'ignore-end-list)))
 118
 119 ;; this removes string from zenirc-ignore-list in two cases
 120 ;; 1) if the string is an exact match
 121 ;; 2) if the string doesn't include any special regexp chars and it is
 122 ;;    a partial match
 123 ;; the reason to this is withheld because of two reasons
 124 ;; 1) the explanation would be to long
 125 ;; 2) it works
 126 (defun zenirc-remove-from-ignore-list (proc parsedcmd)
 127   "Remove someone from the ignore list."
 128   (let ((lst (zenirc-parse-words (cdr parsedcmd))))
 129     (while lst
 130       (let ((someone (car lst)))
 131         (zenirc-ignore-for-each
 132          zenirc-ignore-list
 133          '(lambda (x)
 134             (if (or (string-equal someone x)
 135                     (string-match (regexp-quote someone) x))
 136                 (setq zenirc-ignore-list (delq x zenirc-ignore-list)))))
 137         (setq lst (cdr lst))))
 138     (zenirc-ignore-display-ignore-list proc)))
 139
 140 (defun zenirc-ignore-for-each (lst proc)
 141   (if lst
 142     (progn (funcall proc (car lst))
 143            (zenirc-ignore-for-each (cdr lst) proc))))
 144
 145 (define-key zenirc-mode-map "\C-c\C-i" 'zenirc-ignore-last-sender)
 146
 147 ;; this code was originally written by
 148 ;; Richard Todd <rmtodd@essex.ecn.uoknor.edu>
 149 (defun zenirc-ignore-last-sender ()
 150   (interactive)
 151   (let ((ignoree (zenirc-extract-userhost zenirc-privmsg-last-seen)))
 152     (zenirc-message (current-buffer) 'ignore-new-entry ignoree)
 153     (setq zenirc-ignore-list (cons (regexp-quote ignoree) zenirc-ignore-list))))
 154
 155 (provide 'zenirc-ignore)
 156
 157 (zenirc-ignore-install-message-catalogs)
 158
 159 ;; zenirc-ignore.el ends here