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