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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, 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 (defconst riece-ignore-description
  64   "Ignore messages from some users.")
  65 (defvar riece-ignored-user-list nil)
  66
  67 (defun riece-ignore-user-rename-signal-function (signal handback)
  68   (let ((pointer (riece-identity-member (car (riece-signal-args signal))
  69                                         riece-ignored-user-list)))
  70     (if pointer
  71         (setcar pointer (nth 1 (riece-signal-args signal))))))
  72
  73 (defun riece-ignore-user (user toggle)
  74   (interactive
  75    (let ((completion-ignore-case t))
  76      (list (if current-prefix-arg
  77                (riece-completing-read-identity
  78                 "Unignore user: "
  79                 riece-ignored-user-list)
  80              (riece-completing-read-identity
  81               "Ignore user: "
  82               (riece-get-users-on-server (riece-current-server-name))
  83               (lambda (user)
  84                 (not (riece-identity-member
  85                       (riece-parse-identity (car user))
  86                       riece-ignored-user-list)))))
  87            (not current-prefix-arg))))
  88   (if toggle
  89       (progn
  90         (setq riece-ignored-user-list (cons user riece-ignored-user-list))
  91         (riece-connect-signal
  92          'user-renamed
  93          #'riece-ignore-user-rename-signal-function))
  94     (let ((pointer (riece-identity-member user riece-ignored-user-list)))
  95       (setq riece-ignored-user-list (delq (car pointer)
  96                                           riece-ignored-user-list))
  97       (riece-disconnect-signal
  98        'user-renamed
  99        #'riece-ignore-user-rename-signal-function))))
 100
 101 (eval-when-compile
 102   (autoload 'riece-dialogue-mode "riece"))
 103 (defun riece-ignore-message-filter (message)
 104   (if (and (get 'riece-ignore 'riece-addon-enabled)
 105            (riece-identity-member (riece-message-speaker message)
 106                                   riece-ignored-user-list))
 107       (if riece-ignore-discard-message
 108           (when (eq riece-ignore-discard-message 'log)
 109             (unless riece-ignore-buffer
 110               (with-current-buffer (setq riece-ignore-buffer
 111                                          (riece-get-buffer-create
 112                                           riece-ignore-buffer-name
 113                                           'riece-dialogue-mode))
 114                 (riece-dialogue-mode)))
 115             (save-excursion
 116               (set-buffer riece-ignore-buffer)
 117               (goto-char (point-max))
 118               (let ((inhibit-read-only t)
 119                     buffer-read-only)
 120                 (insert (concat (format-time-string "%H:%M") " "
 121                                 (riece-format-message message t))))))
 122         (put-text-property 0 (length (riece-message-text message))
 123                            'invisible 'riece-ignore
 124                            (riece-message-text message))
 125         message)
 126     message))
 127
 128 (defvar riece-command-mode-map)
 129 (defun riece-ignore-insinuate ()
 130   (setq riece-ignored-user-list
 131         (mapcar #'riece-parse-identity riece-startup-ignored-user-list))
 132   (add-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
 133
 134 (defun riece-ignore-uninstall ()
 135   (setq riece-ignored-user-list nil)
 136   (remove-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
 137
 138 (defun riece-ignore-enable ()
 139   (define-key riece-command-mode-map
 140     "\C-ck" 'riece-ignore-user))
 141
 142 (defun riece-ignore-disable ()
 143   (define-key riece-command-mode-map
 144     "\C-ck" nil))
 145
 146 (provide 'riece-ignore)
 147
 148 ;;; riece-ignore.el ends here