Commit | Line | Data |
---|---|---|
597993cf MB |
1 | ;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits |
2 | ||
ae940284 | 3 | ;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
597993cf MB |
4 | |
5 | ;; Author: Mario Lang <mlang@delysid.org> | |
6 | ;; Keywords: comm | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
4ee57b2a | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
597993cf | 11 | ;; it under the terms of the GNU General Public License as published by |
4ee57b2a GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
597993cf MB |
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 | |
4ee57b2a | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
597993cf MB |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This module hides quit/join messages if a netsplit occurs. | |
26 | ;; To enable, add the following to your ~/.emacs: | |
27 | ;; (require 'erc-netsplit) | |
28 | ;; (erc-netsplit-mode 1) | |
29 | ||
30 | ;;; Code: | |
31 | ||
32 | (require 'erc) | |
33 | (eval-when-compile (require 'cl)) | |
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 | ||
21bc768b MB |
65 | (defcustom erc-netsplit-regexp |
66 | "^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$" | |
597993cf MB |
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 (caddr 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. | |
21bc768b | 133 | (when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed)) |
597993cf MB |
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 (caddr 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." | |
2131c501 MO |
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)))))) | |
597993cf MB |
182 | |
183 | ;;;###autoload | |
184 | (defun erc-cmd-WHOLEFT () | |
185 | "Show who's gone." | |
ff59d266 | 186 | (erc-with-server-buffer |
597993cf MB |
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 (caddr 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 | ||
212 | ;; arch-tag: 61a85cb0-7e7b-4312-a4f6-313c7a25a6e8 |