Mercurial > emacs
comparison lisp/erc/erc-netsplit.el @ 68451:fc745b05e928
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-22
Creator: Michael Olson <mwolson@gnu.org>
Install ERC.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 29 Jan 2006 13:08:58 +0000 |
parents | |
children | 7010bb070445 |
comparison
equal
deleted
inserted
replaced
68450:a3ba4ef5d590 | 68451:fc745b05e928 |
---|---|
1 ;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits | |
2 | |
3 ;; Copyright (C) 2002, 2003, 2004 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 | |
39 netsplit happens, and filters the QUIT messages. It also keeps | |
40 track 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 | |
63 sever buffer." | |
64 :group 'erc-netsplit | |
65 :type 'boolean) | |
66 | |
67 (defcustom erc-netsplit-regexp "^[^ @!\"]+\\.[^ @!]+ [^ @!]+\\.[^ @!\"]+$" | |
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. | |
134 (when (string-match "^[^@!]+\\.[^@!]+$" (erc-response.sender parsed)) | |
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." | |
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 (with-current-buffer (erc-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 (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 |