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

   1 ;;; riece-ignore.el --- ignore messages from some users
   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 ;; NOTE: This is an add-on module for Riece.
  28
  29 ;;; Code:
  30
  31 (require 'riece-signal)
  32 (require 'riece-identity)
  33 (require 'riece-message)
  34
  35 (defgroup riece-ignore nil
  36   "Ignore messages from some users."
  37   :prefix "riece-"
  38   :group 'riece)
  39
  40 (defcustom riece-ignore-discard-message 'log
  41   "If t, messages from ignored user are completely discarded.
  42 If 'log, messages are removed from IRC buffers, but they are saved in
  43 `riece-ignore-buffer'.
  44 Otherwise, they are not removed from IRC buffers, but are hidden with
  45 'invisible text-property."
  46   :group 'riece-ignore
  47   :type '(choice (const :tag "Discard completely" t)
  48                  (const :tag "Discard but save logs" log)
  49                  (const :tag "Make messages invisible" nil)))
  50
  51 (defcustom riece-ignore-buffer-name "*Ignore*"
  52   "The name of buffer where ignored messages are stored."
  53   :group 'riece-ignore
  54   :type 'string)
  55
  56 (defcustom riece-startup-ignored-user-list nil
  57   "List of user names whose messages are ignored."
  58   :group 'riece-ignore
  59   :type '(repeat string))
  60
  61 (defvar riece-ignore-buffer nil)
  62
  63 (defvar riece-ignore-enabled nil)
  64
  65 (defconst riece-ignore-description
  66   "Ignore messages from some users.")
  67 (defvar riece-ignored-user-list nil)
  68
  69 (defun riece-ignore-user-rename-signal-function (signal handback)
  70   (let ((pointer (riece-identity-member (car (riece-signal-args signal))
  71                                         riece-ignored-user-list)))
  72     (if pointer
  73         (setcar pointer (nth 1 (riece-signal-args signal))))))
  74
  75 (defun riece-ignore-user (user toggle)
  76   (interactive
  77    (let ((completion-ignore-case t))
  78      (list (if current-prefix-arg
  79                (riece-completing-read-identity
  80                 "Unignore user: "
  81                 riece-ignored-user-list)
  82              (riece-completing-read-identity
  83               "Ignore user: "
  84               (riece-get-users-on-server (riece-current-server-name))
  85               (lambda (user)
  86                 (not (riece-identity-member
  87                       (riece-parse-identity (car user))
  88                       riece-ignored-user-list)))))
  89            (not current-prefix-arg))))
  90   (if toggle
  91       (progn
  92         (setq riece-ignored-user-list (cons user riece-ignored-user-list))
  93         (riece-connect-signal
  94          'user-renamed
  95          #'riece-ignore-user-rename-signal-function))
  96     (let ((pointer (riece-identity-member user riece-ignored-user-list)))
  97       (setq riece-ignored-user-list (delq (car pointer)
  98                                           riece-ignored-user-list))
  99       (riece-disconnect-signal
 100        'user-renamed
 101        #'riece-ignore-user-rename-signal-function))))
 102
 103 (eval-when-compile
 104   (autoload 'riece-dialogue-mode "riece"))
 105 (defun riece-ignore-message-filter (message)
 106   (if (and riece-ignore-enabled
 107            (riece-identity-member (riece-message-speaker message)
 108                                   riece-ignored-user-list))
 109       (if riece-ignore-discard-message
 110           (when (eq riece-ignore-discard-message 'log)
 111             (unless riece-ignore-buffer
 112               (with-current-buffer (setq riece-ignore-buffer
 113                                          (riece-get-buffer-create
 114                                           riece-ignore-buffer-name
 115                                           'riece-dialogue-mode))
 116                 (riece-dialogue-mode)))
 117             (save-excursion
 118               (set-buffer riece-ignore-buffer)
 119               (goto-char (point-max))
 120               (let ((inhibit-read-only t)
 121                     buffer-read-only)
 122                 (insert (concat (format-time-string "%H:%M") " "
 123                                 (riece-format-message message t))))))
 124         (put-text-property 0 (length (riece-message-text message))
 125                            'invisible 'riece-ignore
 126                            (riece-message-text message))
 127         message)
 128     message))
 129
 130 (defvar riece-command-mode-map)
 131 (defun riece-ignore-insinuate ()
 132   (setq riece-ignored-user-list
 133         (mapcar #'riece-parse-identity riece-startup-ignored-user-list))
 134   (add-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
 135
 136 (defun riece-ignore-uninstall ()
 137   (setq riece-ignored-user-list nil)
 138   (remove-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
 139
 140 (defun riece-ignore-enable ()
 141   (define-key riece-command-mode-map
 142     "\C-ck" 'riece-ignore-user)
 143   (setq riece-ignore-enabled t))
 144
 145 (defun riece-ignore-disable ()
 146   (define-key riece-command-mode-map
 147     "\C-ck" nil)
 148   (setq riece-ignore-enabled nil))
 149
 150 (provide 'riece-ignore)
 151
 152 ;;; riece-ignore.el ends here