1;; erc-goodies.el --- Collection of ERC modules
2
3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
4;;   Free Software Foundation, Inc.
5
6;; Author: Jorgen Schaefer <forcer@forcix.cx>
7
8;; Most code is taken verbatim from erc.el, see there for the original
9;; authors.
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;; This provides some small but still useful modes for ERC.
31
32;;; Code:
33
34(require 'erc)
35
36;; Imenu Autoload
37(add-hook 'erc-mode-hook
38          (lambda ()
39            (setq imenu-create-index-function 'erc-create-imenu-index)))
40(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
41
42;;; Automatically scroll to bottom
43(defcustom erc-input-line-position nil
44  "Specify where to position the input line when using `erc-scroll-to-bottom'.
45
46This should be an integer specifying the line of the buffer on which
47the input line should stay.  A value of \"-1\" would keep the input
48line positioned on the last line in the buffer.  This is passed as an
49argument to `recenter'."
50  :group 'erc-display
51  :type '(choice integer (const nil)))
52
53(define-erc-module scrolltobottom nil
54  "This mode causes the prompt to stay at the end of the window.
55You have to activate or deactivate it in already created windows
56separately."
57  ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom))
58  ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)))
59
60(defun erc-add-scroll-to-bottom ()
61  "A hook function for `erc-mode-hook' to recenter output at bottom of window.
62
63If you find that ERC hangs when using this function, try customizing
64the value of `erc-input-line-position'.
65
66This works whenever scrolling happens, so it's added to
67`window-scroll-functions' rather than `erc-insert-post-hook'."
68  ;;(make-local-hook 'window-scroll-functions)
69  (add-hook 'window-scroll-functions 'erc-scroll-to-bottom nil t))
70
71(defun erc-scroll-to-bottom (window display-start)
72  "Recenter WINDOW so that `point' is on the last line.
73
74This is added to `window-scroll-functions' by `erc-add-scroll-to-bottom'.
75
76You can control which line is recentered to by customizing the
77variable `erc-input-line-position'.
78
79DISPLAY-START is ignored."
80  (if (and window (window-live-p window))
81      ;; Temporarily bind resize-mini-windows to nil so that users who have it
82      ;; set to a non-nil value will not suffer from premature minibuffer
83      ;; shrinkage due to the below recenter call.  I have no idea why this
84      ;; works, but it solves the problem, and has no negative side effects.
85      ;; (Fran Litterio, 2003/01/07)
86      (let ((resize-mini-windows nil))
87        (save-selected-window
88          (select-window window)
89          (save-restriction
90            (widen)
91            (when (and erc-insert-marker
92                       ;; we're editing a line. Scroll.
93                       (> (point) erc-insert-marker))
94              (save-excursion
95                (goto-char (point-max))
96                (recenter (or erc-input-line-position -1))
97                (sit-for 0))))))))
98
99;;; Make read only
100(define-erc-module readonly nil
101  "This mode causes all inserted text to be read-only."
102  ((add-hook 'erc-insert-post-hook 'erc-make-read-only)
103   (add-hook 'erc-send-post-hook 'erc-make-read-only))
104  ((remove-hook 'erc-insert-post-hook 'erc-make-read-only)
105   (remove-hook 'erc-send-post-hook 'erc-make-read-only)))
106
107(defun erc-make-read-only ()
108  "Make all the text in the current buffer read-only.
109Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
110  (put-text-property (point-min) (point-max) 'read-only t)
111  (put-text-property (point-min) (point-max) 'front-sticky t)
112  (put-text-property (point-min) (point-max) 'rear-nonsticky t))
113
114;; Distinguish non-commands
115(defvar erc-noncommands-list '(erc-cmd-ME
116                               erc-cmd-COUNTRY
117                               erc-cmd-SV
118                               erc-cmd-SM
119                               erc-cmd-SMV
120                               erc-cmd-LASTLOG)
121  "List of commands that are aliases for CTCP ACTION or for erc messages.
122
123If a command's function symbol is in this list, the typed command
124does not appear in the ERC buffer after the user presses ENTER.")
125
126(define-erc-module noncommands nil
127  "This mode distinguishies non-commands.
128Commands listed in `erc-insert-this' know how to display
129themselves."
130  ((add-hook 'erc-send-pre-hook 'erc-send-distinguish-noncommands))
131  ((remove-hook 'erc-send-pre-hook 'erc-send-distinguish-noncommands)))
132
133(defun erc-send-distinguish-noncommands (str)
134  "If STR is an ERC non-command, set `erc-insert-this' to nil."
135  (let* ((command (erc-extract-command-from-line str))
136         (cmd-fun (and command
137                       (car command))))
138    (when (and cmd-fun
139               (not (string-match "\n.+$" str))
140               (memq cmd-fun erc-noncommands-list))
141      (setq erc-insert-this nil))))
142
143;;; IRC control character processing.
144(defgroup erc-control-characters nil
145  "Dealing with control characters"
146  :group 'erc)
147
148(defcustom erc-interpret-controls-p t
149  "*If non-nil, display IRC colours and other highlighting effects.
150
151If this is set to the symbol `remove', ERC removes all IRC colors and
152highlighting effects.  When this variable is non-nil, it can cause Emacs to run
153slowly on systems lacking sufficient CPU speed.  In chatty channels, or in an
154emergency (message flood) it can be turned off to save processing time.  See
155`erc-toggle-interpret-controls'."
156  :group 'erc-control-characters
157  :type '(choice (const :tag "Highlight control characters" t)
158                 (const :tag "Remove control characters" remove)
159                 (const :tag "Display raw control characters" nil)))
160
161(defcustom erc-interpret-mirc-color nil
162  "*If non-nil, erc will interpret mIRC color codes."
163  :group 'erc-control-characters
164  :type 'boolean)
165
166(defcustom erc-beep-p nil
167  "Beep if C-g is in the server message.
168The value `erc-interpret-controls-p' must also be t for this to work."
169  :group 'erc-control-characters
170  :type 'boolean)
171
172(defface erc-bold-face '((t (:bold t)))
173  "ERC bold face."
174  :group 'erc-faces)
175(defface erc-inverse-face
176  '((t (:foreground "White" :background "Black")))
177  "ERC inverse face."
178  :group 'erc-faces)
179(defface erc-underline-face '((t (:underline t)))
180  "ERC underline face."
181  :group 'erc-faces)
182
183(defface fg:erc-color-face0 '((t (:foreground "White")))
184  "ERC face."
185  :group 'erc-faces)
186(defface fg:erc-color-face1 '((t (:foreground "black")))
187  "ERC face."
188  :group 'erc-faces)
189(defface fg:erc-color-face2 '((t (:foreground "blue4")))
190  "ERC face."
191  :group 'erc-faces)
192(defface fg:erc-color-face3 '((t (:foreground "green4")))
193  "ERC face."
194  :group 'erc-faces)
195(defface fg:erc-color-face4 '((t (:foreground "red")))
196  "ERC face."
197  :group 'erc-faces)
198(defface fg:erc-color-face5 '((t (:foreground "brown")))
199  "ERC face."
200  :group 'erc-faces)
201(defface fg:erc-color-face6 '((t (:foreground "purple")))
202  "ERC face."
203  :group 'erc-faces)
204(defface fg:erc-color-face7 '((t (:foreground "orange")))
205  "ERC face."
206  :group 'erc-faces)
207(defface fg:erc-color-face8 '((t (:foreground "yellow")))
208  "ERC face."
209  :group 'erc-faces)
210(defface fg:erc-color-face9 '((t (:foreground "green")))
211  "ERC face."
212  :group 'erc-faces)
213(defface fg:erc-color-face10 '((t (:foreground "lightblue1")))
214  "ERC face."
215  :group 'erc-faces)
216(defface fg:erc-color-face11 '((t (:foreground "cyan")))
217  "ERC face."
218  :group 'erc-faces)
219(defface fg:erc-color-face12 '((t (:foreground "blue")))
220  "ERC face."
221  :group 'erc-faces)
222(defface fg:erc-color-face13 '((t (:foreground "deeppink")))
223  "ERC face."
224  :group 'erc-faces)
225(defface fg:erc-color-face14 '((t (:foreground "gray50")))
226  "ERC face."
227  :group 'erc-faces)
228(defface fg:erc-color-face15 '((t (:foreground "gray90")))
229  "ERC face."
230  :group 'erc-faces)
231
232(defface bg:erc-color-face0 '((t (:background "White")))
233  "ERC face."
234  :group 'erc-faces)
235(defface bg:erc-color-face1 '((t (:background "black")))
236  "ERC face."
237  :group 'erc-faces)
238(defface bg:erc-color-face2 '((t (:background "blue4")))
239  "ERC face."
240  :group 'erc-faces)
241(defface bg:erc-color-face3 '((t (:background "green4")))
242  "ERC face."
243  :group 'erc-faces)
244(defface bg:erc-color-face4 '((t (:background "red")))
245  "ERC face."
246  :group 'erc-faces)
247(defface bg:erc-color-face5 '((t (:background "brown")))
248  "ERC face."
249  :group 'erc-faces)
250(defface bg:erc-color-face6 '((t (:background "purple")))
251  "ERC face."
252  :group 'erc-faces)
253(defface bg:erc-color-face7 '((t (:background "orange")))
254  "ERC face."
255  :group 'erc-faces)
256(defface bg:erc-color-face8 '((t (:background "yellow")))
257  "ERC face."
258  :group 'erc-faces)
259(defface bg:erc-color-face9 '((t (:background "green")))
260  "ERC face."
261  :group 'erc-faces)
262(defface bg:erc-color-face10 '((t (:background "lightblue1")))
263  "ERC face."
264  :group 'erc-faces)
265(defface bg:erc-color-face11 '((t (:background "cyan")))
266  "ERC face."
267  :group 'erc-faces)
268(defface bg:erc-color-face12 '((t (:background "blue")))
269  "ERC face."
270  :group 'erc-faces)
271(defface bg:erc-color-face13 '((t (:background "deeppink")))
272  "ERC face."
273  :group 'erc-faces)
274(defface bg:erc-color-face14 '((t (:background "gray50")))
275  "ERC face."
276  :group 'erc-faces)
277(defface bg:erc-color-face15 '((t (:background "gray90")))
278  "ERC face."
279  :group 'erc-faces)
280
281(defun erc-get-bg-color-face (n)
282  "Fetches the right face for background color N (0-15)."
283  (if (stringp n) (setq n (string-to-number n)))
284  (if (not (numberp n))
285      (progn
286        (message "erc-get-bg-color-face: n is NaN: %S" n)
287        (beep)
288        'default)
289    (when (> n 16)
290      (erc-log (format "   Wrong color: %s" n))
291      (setq n (mod n 16)))
292    (cond
293     ((and (>= n 0) (< n 16))
294      (intern (concat "bg:erc-color-face" (number-to-string n))))
295     (t (erc-log (format "   Wrong color: %s" n)) 'default))))
296
297(defun erc-get-fg-color-face (n)
298  "Fetches the right face for foreground color N (0-15)."
299  (if (stringp n) (setq n (string-to-number n)))
300  (if (not (numberp n))
301      (progn
302        (message "erc-get-fg-color-face: n is NaN: %S" n)
303        (beep)
304        'default)
305    (when (> n 16)
306      (erc-log (format "   Wrong color: %s" n))
307      (setq n (mod n 16)))
308    (cond
309     ((and (>= n 0) (< n 16))
310      (intern (concat "fg:erc-color-face" (number-to-string n))))
311     (t (erc-log (format "   Wrong color: %s" n)) 'default))))
312
313(define-erc-module irccontrols nil
314  "This mode enables the interpretation of IRC control chars."
315  ((add-hook 'erc-insert-modify-hook 'erc-controls-highlight)
316   (add-hook 'erc-send-modify-hook 'erc-controls-highlight))
317  ((remove-hook 'erc-insert-modify-hook 'erc-controls-highlight)
318   (remove-hook 'erc-send-modify-hook 'erc-controls-highlight)))
319
320(defun erc-controls-interpret (str)
321   "Return a copy of STR after dealing with IRC control characters.
322See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
323   (when str
324     (let ((s str))
325       (cond ((eq erc-interpret-controls-p 'remove)
326              (erc-controls-strip s))
327             (erc-interpret-controls-p
328              (let ((boldp nil)
329                    (inversep nil)
330                    (underlinep nil)
331                    (fg nil)
332                    (bg nil))
333                (while (string-match erc-controls-highlight-regexp s)
334                  (let ((control (match-string 1 s))
335                        (fg-color (match-string 2 s))
336                        (bg-color (match-string 4 s))
337                        (start (match-beginning 0))
338                        (end (+ (match-beginning 0)
339                                (length (match-string 5 s)))))
340                    (setq s (erc-replace-match-subexpression-in-string
341                             "" s control 1 start))
342                    (cond ((and erc-interpret-mirc-color (or fg-color bg-color))
343                           (setq fg fg-color)
344                           (setq bg bg-color))
345                          ((string= control "\C-b")
346                           (setq boldp (not boldp)))
347                          ((string= control "\C-v")
348                           (setq inversep (not inversep)))
349                          ((string= control "\C-_")
350                           (setq underlinep (not underlinep)))
351                          ((string= control "\C-c")
352                           (setq fg nil
353                                 bg nil))
354                          ((string= control "\C-g")
355                           (when erc-beep-p
356                             (ding)))
357                          ((string= control "\C-o")
358                           (setq boldp nil
359                                 inversep nil
360                                 underlinep nil
361                                 fg nil
362                                 bg nil))
363                          (t nil))
364                    (erc-controls-propertize
365                     start end boldp inversep underlinep fg bg s)))
366                s))
367             (t s)))))
368
369(defun erc-controls-strip (str)
370  "Return a copy of STR with all IRC control characters removed."
371  (when str
372    (let ((s str))
373      (while (string-match erc-controls-remove-regexp s)
374        (setq s (replace-match "" nil nil s)))
375      s)))
376
377(defvar erc-controls-remove-regexp
378  "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
379  "Regular expression which matches control characters to remove.")
380
381(defvar erc-controls-highlight-regexp
382  (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
383          "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
384          "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
385  "Regular expression which matches control chars and the text to highlight.")
386
387(defun erc-controls-highlight ()
388  "Highlight IRC control chars in the buffer.
389This is useful for `erc-insert-modify-hook' and
390`erc-send-modify-hook'. Also see `erc-interpret-controls-p' and
391`erc-interpret-mirc-color'."
392  (goto-char (point-min))
393  (cond ((eq erc-interpret-controls-p 'remove)
394         (while (re-search-forward erc-controls-remove-regexp nil t)
395           (replace-match "")))
396        (erc-interpret-controls-p
397         (let ((boldp nil)
398               (inversep nil)
399               (underlinep nil)
400               (fg nil)
401               (bg nil))
402           (while (re-search-forward erc-controls-highlight-regexp nil t)
403             (let ((control (match-string 1))
404                   (fg-color (match-string 2))
405                   (bg-color (match-string 4))
406                   (start (match-beginning 0))
407                   (end (+ (match-beginning 0) (length (match-string 5)))))
408               (replace-match "" nil nil nil 1)
409               (cond ((and erc-interpret-mirc-color (or fg-color bg-color))
410                      (setq fg fg-color)
411                      (setq bg bg-color))
412                     ((string= control "\C-b")
413                      (setq boldp (not boldp)))
414                     ((string= control "\C-v")
415                      (setq inversep (not inversep)))
416                     ((string= control "\C-_")
417                      (setq underlinep (not underlinep)))
418                     ((string= control "\C-c")
419                      (setq fg nil
420                            bg nil))
421                     ((string= control "\C-g")
422                      (when erc-beep-p
423                        (ding)))
424                     ((string= control "\C-o")
425                      (setq boldp nil
426                            inversep nil
427                            underlinep nil
428                            fg nil
429                            bg nil))
430                     (t nil))
431               (erc-controls-propertize start end
432                                        boldp inversep underlinep fg bg)))))
433        (t nil)))
434
435(defun erc-controls-propertize (from to boldp inversep underlinep fg bg
436                                     &optional str)
437  "Prepend properties from IRC control characters between FROM and TO.
438If optional argument STR is provided, apply to STR, otherwise prepend properties
439to a region in the current buffer."
440  (font-lock-prepend-text-property
441   from
442   to
443   'face
444   (append (if boldp
445               '(erc-bold-face)
446             nil)
447           (if inversep
448               '(erc-inverse-face)
449             nil)
450           (if underlinep
451               '(erc-underline-face)
452             nil)
453           (if fg
454               (list (erc-get-fg-color-face fg))
455             nil)
456           (if bg
457               (list (erc-get-bg-color-face bg))
458             nil))
459   str)
460  str)
461
462(defun erc-toggle-interpret-controls (&optional arg)
463  "Toggle interpretation of control sequences in messages.
464
465If ARG is positive, interpretation is turned on.
466Else interpretation is turned off."
467  (interactive "P")
468  (cond ((and (numberp arg) (> arg 0))
469         (setq erc-interpret-controls-p t))
470        (arg (setq erc-interpret-controls-p nil))
471        (t (setq erc-interpret-controls-p (not erc-interpret-controls-p))))
472  (message "ERC color interpretation %s"
473           (if erc-interpret-controls-p "ON" "OFF")))
474
475;; Smiley
476(define-erc-module smiley nil
477  "This mode translates text-smileys such as :-) into pictures.
478This requires the function `smiley-region', which is defined in
479smiley.el, which is part of Gnus."
480  ((add-hook 'erc-insert-modify-hook 'erc-smiley)
481   (add-hook 'erc-send-modify-hook 'erc-smiley))
482  ((remove-hook 'erc-insert-modify-hook 'erc-smiley)
483   (remove-hook 'erc-send-modify-hook 'erc-smiley)))
484
485(defun erc-smiley ()
486  "Smilify a region.
487This function should be used with `erc-insert-modify-hook'."
488  (when (fboundp 'smiley-region)
489    (smiley-region (point-min) (point-max))))
490
491;; Unmorse
492(define-erc-module unmorse nil
493  "This mode causes morse code in the current channel to be unmorsed."
494  ((add-hook 'erc-insert-modify-hook 'erc-unmorse))
495  ((remove-hook 'erc-insert-modify-hook 'erc-unmorse)))
496
497(defun erc-unmorse ()
498  "Unmorse some text.
499Add this to `erc-insert-modify-hook' if you happen to be on a
500channel that has weird people talking in morse to each other.
501
502See also `unmorse-region'."
503  (goto-char (point-min))
504  (when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t)
505    (unmorse-region (match-beginning 0) (match-end 0))))
506
507;;; erc-occur
508(defun erc-occur (string &optional proc)
509  "Search for STRING in all buffers related to current server.
510If called interactively and prefix argument is given, search on all connected
511servers.  If called from a program, PROC specifies the server process."
512  (interactive
513   (list (read-string "Search for: ")
514         (if current-prefix-arg
515             nil erc-server-process)))
516  (if (fboundp 'multi-occur)
517      (multi-occur (erc-buffer-list nil proc) string)
518    (error "`multi-occur' is not defined as a function")))
519
520(provide 'erc-goodies)
521
522;; arch-tag: d987ae26-9e28-4c72-9596-e617309fb582
523;;; erc-goodies.el ends here
524