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