1;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits 2 3;; Copyright (C) 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: Mario Lang <mlang@delysid.org> 6;; Keywords: comm 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs 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;; GNU Emacs 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;; This module hides quit/join messages if a netsplit occurs. 28;; To enable, add the following to your ~/.emacs: 29;; (require 'erc-netsplit) 30;; (erc-netsplit-mode 1) 31 32;;; Code: 33 34(require 'erc) 35(eval-when-compile (require 'cl)) 36 37(defgroup erc-netsplit nil 38 "Netsplit detection tries to automatically figure when a 39netsplit happens, and filters the QUIT messages. It also keeps 40track of netsplits, so that it can filter the JOIN messages on a netjoin too." 41 :group 'erc) 42 43;;;###autoload (autoload 'erc-netsplit-mode "erc-netsplit") 44(define-erc-module netsplit nil 45 "This mode hides quit/join messages if a netsplit occurs." 46 ((erc-netsplit-install-message-catalogs) 47 (add-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN) 48 (add-hook 'erc-server-MODE-functions 'erc-netsplit-MODE) 49 (add-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT) 50 (add-hook 'erc-timer-hook 'erc-netsplit-timer)) 51 ((remove-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN) 52 (remove-hook 'erc-server-MODE-functions 'erc-netsplit-MODE) 53 (remove-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT) 54 (remove-hook 'erc-timer-hook 'erc-netsplit-timer))) 55 56(defcustom erc-netsplit-show-server-mode-changes-flag nil 57 "Set to t to enable display of server mode changes." 58 :group 'erc-netsplit 59 :type 'boolean) 60 61(defcustom erc-netsplit-debug nil 62 "If non-nil, debug messages will be shown in the 63sever buffer." 64 :group 'erc-netsplit 65 :type 'boolean) 66 67(defcustom erc-netsplit-regexp 68 "^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$" 69 "This regular expression should match quit reasons produced 70by netsplits." 71 :group 'erc-netsplit 72 :type 'regexp) 73 74(defcustom erc-netsplit-hook nil 75 "Run whenever a netsplit is detected the first time. 76Args: PROC is the process the netsplit originated from and 77 SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")." 78 :group 'erc-hooks 79 :type 'hook) 80 81(defcustom erc-netjoin-hook nil 82 "Run whenever a netjoin is detected the first time. 83Args: PROC is the process the netjoin originated from and 84 SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")." 85 :group 'erc-hooks 86 :type 'hook) 87 88(defvar erc-netsplit-list nil 89 "This is a list of the form 90\((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...) 91where FIRST-JOIN is t or nil, depending on whether or not the first 92join from that split has been detected or not.") 93(make-variable-buffer-local 'erc-netsplit-list) 94 95(defun erc-netsplit-install-message-catalogs () 96 (erc-define-catalog 97 'english 98 '((netsplit . "netsplit: %s") 99 (netjoin . "netjoin: %s, %N were split") 100 (netjoin-done . "netjoin: All lost souls are back!") 101 (netsplit-none . "No netsplits in progress") 102 (netsplit-wholeft . "split: %s missing: %n %t")))) 103 104(defun erc-netsplit-JOIN (proc parsed) 105 "Show/don't show rejoins." 106 (let ((nick (erc-response.sender parsed)) 107 (no-next-hook nil)) 108 (dolist (elt erc-netsplit-list) 109 (if (member nick (nthcdr 3 elt)) 110 (progn 111 (if (not (caddr elt)) 112 (progn 113 (erc-display-message 114 parsed 'notice (process-buffer proc) 115 'netjoin ?s (car elt) ?N (length (nthcdr 3 elt))) 116 (setcar (nthcdr 2 elt) t) 117 (run-hook-with-args 'erc-netjoin-hook proc (car elt)))) 118 ;; need to remove this nick, perhaps the whole entry here. 119 ;; Note that by removing the nick now, we can't tell if further 120 ;; join messages (for other channels) should also be 121 ;; suppressed. 122 (if (null (nthcdr 4 elt)) 123 (progn 124 (erc-display-message 125 parsed 'notice (process-buffer proc) 126 'netjoin-done ?s (car elt)) 127 (setq erc-netsplit-list (delq elt erc-netsplit-list))) 128 (delete nick elt)) 129 (setq no-next-hook t)))) 130 no-next-hook)) 131 132(defun erc-netsplit-MODE (proc parsed) 133 "Hide mode changes from servers." 134 ;; regexp matches things with a . in them, and no ! or @ in them. 135 (when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed)) 136 (and erc-netsplit-debug 137 (erc-display-message 138 parsed 'notice (process-buffer proc) 139 "[debug] server mode change.")) 140 (not erc-netsplit-show-server-mode-changes-flag))) 141 142(defun erc-netsplit-QUIT (proc parsed) 143 "Detect netsplits." 144 (let ((split (erc-response.contents parsed)) 145 (nick (erc-response.sender parsed)) 146 ass) 147 (when (string-match erc-netsplit-regexp split) 148 (setq ass (assoc split erc-netsplit-list)) 149 (if ass 150 ;; element for this netsplit exists already 151 (progn 152 (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) 153 (when (caddr ass) 154 ;; There was already a netjoin for this netsplit, it 155 ;; seems like the old one didn't get finished... 156 (erc-display-message 157 parsed 'notice (process-buffer proc) 158 'netsplit ?s split) 159 (setcar (nthcdr 2 ass) t) 160 (run-hook-with-args 'erc-netsplit-hook proc split))) 161 ;; element for this netsplit does not yet exist 162 (setq erc-netsplit-list 163 (cons (list split 164 (erc-current-time) 165 nil 166 nick) 167 erc-netsplit-list)) 168 (erc-display-message 169 parsed 'notice (process-buffer proc) 170 'netsplit ?s split) 171 (run-hook-with-args 'erc-netsplit-hook proc split)) 172 t))) 173 174(defun erc-netsplit-timer (now) 175 "Clean cruft from `erc-netsplit-list' older than 10 minutes." 176 (dolist (elt erc-netsplit-list) 177 (when (> (erc-time-diff (cadr elt) now) 600) 178 (when erc-netsplit-debug 179 (erc-display-message 180 nil 'notice (current-buffer) 181 (concat "Netsplit: Removing " (car elt)))) 182 (setq erc-netsplit-list (delq elt erc-netsplit-list))))) 183 184;;;###autoload 185(defun erc-cmd-WHOLEFT () 186 "Show who's gone." 187 (erc-with-server-buffer 188 (if (null erc-netsplit-list) 189 (erc-display-message 190 nil 'notice 'active 191 'netsplit-none) 192 (dolist (elt erc-netsplit-list) 193 (erc-display-message 194 nil 'notice 'active 195 'netsplit-wholeft ?s (car elt) 196 ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") 197 ?t (if (caddr elt) 198 "(joining)" 199 ""))))) 200 t) 201 202(defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT) 203 204(provide 'erc-netsplit) 205 206;;; erc-netsplit.el ends here 207;; 208;; Local Variables: 209;; indent-tabs-mode: t 210;; tab-width: 8 211;; End: 212 213;; arch-tag: 61a85cb0-7e7b-4312-a4f6-313c7a25a6e8 214