cgit.sxemacs.org Git - riece/blob - lisp/riece-ignore.el

   1 ;;; riece-ignore.el --- ignore user
   2 ;; Copyright (C) 1998-2004 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; To use, add the following line to your ~/.riece/init.el:
  28 ;; (add-to-list 'riece-addons 'riece-ignore)
  29
  30 ;;; Code:
  31
  32 (require 'riece-signal)
  33 (require 'riece-identity)
  34 (require 'riece-message)
  35
  36 (defgroup riece-ignore nil
  37   "Ignore messages in IRC buffers."
  38   :prefix "riece-"
  39   :group 'riece)
  40
  41 (defcustom riece-ignore-discard-message 'log
  42   "If t, messages from ignored user are completely discarded.
  43 If 'log, messages are removed from IRC buffers, but they are saved in
  44 `riece-ignore-buffer'.
  45 Otherwise, they are not removed from IRC buffers, but are hidden with
  46 'invisible text-property."
  47   :group 'riece-ignore
  48   :type '(choice (const :tag "Discard completely" t)
  49                  (const :tag "Discard but save logs" log)
  50                  (const :tag "Make messages invisible" nil)))
  51
  52 (defcustom riece-ignore-buffer-name "*Ignore*"
  53   "The name of buffer where ignored messages are stored."
  54   :group 'riece-ignore
  55   :type 'string)
  56
  57 (defcustom riece-startup-ignored-user-list nil
  58   "List of user names whose messages are ignored."
  59   :group 'riece-ignore
  60   :type '(repeat string))
  61
  62 (defvar riece-ignore-buffer nil)
  63
  64 (defvar riece-ignore-enabled nil)
  65
  66 (defconst riece-ignore-description
  67   "Ignore users")
  68 (defvar riece-ignored-user-list nil)
  69
  70 (defun riece-ignore-user-rename-signal-function (signal handback)
  71   (let ((pointer (riece-identity-member (car (riece-signal-args signal))
  72                                         riece-ignored-user-list)))
  73     (if pointer
  74         (setcar pointer (nth 1 (riece-signal-args signal))))))
  75
  76 (defun riece-ignore-user (user toggle)
  77   (interactive
  78    (let ((completion-ignore-case t))
  79      (list (if current-prefix-arg
  80                (riece-completing-read-identity
  81                 "Unignore user: "
  82                 riece-ignored-user-list)
  83              (riece-completing-read-identity
  84               "Ignore user: "
  85               (riece-get-users-on-server (riece-current-server-name))
  86               (lambda (user)
  87                 (not (riece-identity-member
  88                       (riece-parse-identity (car user))
  89                       riece-ignored-user-list)))))
  90            (not current-prefix-arg))))
  91   (if toggle
  92       (progn
  93         (setq riece-ignored-user-list (cons user riece-ignored-user-list))
  94         (riece-connect-signal
  95          'user-renamed
  96          #'riece-ignore-user-rename-signal-function))
  97     (let ((pointer (riece-identity-member user riece-ignored-user-list)))
  98       (setq riece-ignored-user-list (delq (car pointer)
  99                                           riece-ignored-user-list))
 100       (riece-disconnect-signal
 101        'user-renamed
 102        #'riece-ignore-user-rename-signal-function))))
 103
 104 (eval-when-compile
 105   (autoload 'riece-dialogue-mode "riece"))
 106 (defun riece-ignore-message-filter (message)
 107   (if (and riece-ignore-enabled
 108            (riece-identity-member (riece-message-speaker message)
 109                                   riece-ignored-user-list))
 110       (if riece-ignore-discard-message
 111           (when (eq riece-ignore-discard-message 'log)
 112             (unless riece-ignore-buffer
 113               (with-current-buffer (setq riece-ignore-buffer
 114                                          (riece-get-buffer-create
 115                                           riece-ignore-buffer-name
 116                                           'riece-dialogue-mode))
 117                 (riece-dialogue-mode)))
 118             (save-excursion
 119               (set-buffer riece-ignore-buffer)
 120               (goto-char (point-max))
 121               (let ((inhibit-read-only t)
 122                     buffer-read-only)
 123                 (insert (concat (format-time-string "%H:%M") " "
 124                                 (riece-format-message message t))))))
 125         (put-text-property 0 (length (riece-message-text message))
 126                            'invisible 'riece-ignore
 127                            (riece-message-text message))
 128         message)
 129     message))
 130
 131 (defvar riece-command-mode-map)
 132 (defun riece-ignore-insinuate ()
 133   (setq riece-ignored-user-list
 134         (mapcar #'riece-parse-identity riece-startup-ignored-user-list))
 135   (add-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
 136
 137 (defun riece-ignore-enable ()
 138   (define-key riece-command-mode-map
 139     "\C-ck" 'riece-ignore-user)
 140   (setq riece-ignore-enabled t))
 141
 142 (defun riece-ignore-disable ()
 143   (define-key riece-command-mode-map
 144     "\C-ck" nil)
 145   (setq riece-ignore-enabled nil))
 146
 147 (provide 'riece-ignore)
 148
 149 ;;; riece-ignore.el ends here