1 ;; erc-goodies.el --- Collection of ERC modules
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
4 ;; Free Software Foundation, Inc.
6 ;; Author: Jorgen Schaefer <forcer@forcix.cx>
8 ;; Most code is taken verbatim from erc.el, see there for the original
11 ;; This file is part of GNU Emacs.
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 3, or (at your option)
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.
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.
30 ;; This provides some small but still useful modes for ERC.
37 (add-hook 'erc-mode-hook
39 (setq imenu-create-index-function
'erc-create-imenu-index
)))
40 (autoload 'erc-create-imenu-index
"erc-imenu" "Imenu index creation function")
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'.
46 This should be an integer specifying the line of the buffer on which
47 the input line should stay. A value of \"-1\" would keep the input
48 line positioned on the last line in the buffer. This is passed as an
49 argument to `recenter'."
51 :type
'(choice integer
(const nil
)))
53 (define-erc-module scrolltobottom nil
54 "This mode causes the prompt to stay at the end of the window.
55 You have to activate or deactivate it in already created windows
57 ((add-hook 'erc-mode-hook
'erc-add-scroll-to-bottom
))
58 ((remove-hook 'erc-mode-hook
'erc-add-scroll-to-bottom
)))
60 (defun erc-add-scroll-to-bottom ()
61 "A hook function for `erc-mode-hook' to recenter output at bottom of window.
63 If you find that ERC hangs when using this function, try customizing
64 the value of `erc-input-line-position'.
66 This 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
))
71 (defun erc-scroll-to-bottom (window display-start
)
72 "Recenter WINDOW so that `point' is on the last line.
74 This is added to `window-scroll-functions' by `erc-add-scroll-to-bottom'.
76 You can control which line is recentered to by customizing the
77 variable `erc-input-line-position'.
79 DISPLAY-START is ignored."
80 (if (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 (erc-with-selected-window window
90 (when (and erc-insert-marker
91 ;; we're editing a line. Scroll.
92 (> (point) erc-insert-marker
))
94 (goto-char (point-max))
95 (recenter (or erc-input-line-position -
1))
99 (define-erc-module readonly nil
100 "This mode causes all inserted text to be read-only."
101 ((add-hook 'erc-insert-post-hook
'erc-make-read-only
)
102 (add-hook 'erc-send-post-hook
'erc-make-read-only
))
103 ((remove-hook 'erc-insert-post-hook
'erc-make-read-only
)
104 (remove-hook 'erc-send-post-hook
'erc-make-read-only
)))
106 (defun erc-make-read-only ()
107 "Make all the text in the current buffer read-only.
108 Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
109 (put-text-property (point-min) (point-max) 'read-only t
)
110 (put-text-property (point-min) (point-max) 'front-sticky t
)
111 (put-text-property (point-min) (point-max) 'rear-nonsticky t
))
113 ;; Distinguish non-commands
114 (defvar erc-noncommands-list
'(erc-cmd-ME
120 "List of commands that are aliases for CTCP ACTION or for erc messages.
122 If a command's function symbol is in this list, the typed command
123 does not appear in the ERC buffer after the user presses ENTER.")
125 (define-erc-module noncommands nil
126 "This mode distinguishies non-commands.
127 Commands listed in `erc-insert-this' know how to display
129 ((add-hook 'erc-send-pre-hook
'erc-send-distinguish-noncommands
))
130 ((remove-hook 'erc-send-pre-hook
'erc-send-distinguish-noncommands
)))
132 (defun erc-send-distinguish-noncommands (str)
133 "If STR is an ERC non-command, set `erc-insert-this' to nil."
134 (let* ((command (erc-extract-command-from-line str
))
135 (cmd-fun (and command
138 (not (string-match "\n.+$" str
))
139 (memq cmd-fun erc-noncommands-list
))
140 (setq erc-insert-this nil
))))
142 ;;; IRC control character processing.
143 (defgroup erc-control-characters nil
144 "Dealing with control characters"
147 (defcustom erc-interpret-controls-p t
148 "*If non-nil, display IRC colours and other highlighting effects.
150 If this is set to the symbol `remove', ERC removes all IRC colors and
151 highlighting effects. When this variable is non-nil, it can cause Emacs to run
152 slowly on systems lacking sufficient CPU speed. In chatty channels, or in an
153 emergency (message flood) it can be turned off to save processing time. See
154 `erc-toggle-interpret-controls'."
155 :group
'erc-control-characters
156 :type
'(choice (const :tag
"Highlight control characters" t
)
157 (const :tag
"Remove control characters" remove
)
158 (const :tag
"Display raw control characters" nil
)))
160 (defcustom erc-interpret-mirc-color nil
161 "*If non-nil, erc will interpret mIRC color codes."
162 :group
'erc-control-characters
165 (defcustom erc-beep-p nil
166 "Beep if C-g is in the server message.
167 The value `erc-interpret-controls-p' must also be t for this to work."
168 :group
'erc-control-characters
171 (defface erc-bold-face
'((t (:bold t
)))
174 (defface erc-inverse-face
175 '((t (:foreground
"White" :background
"Black")))
178 (defface erc-underline-face
'((t (:underline t
)))
179 "ERC underline face."
182 (defface fg
:erc-color-face0
'((t (:foreground
"White")))
185 (defface fg
:erc-color-face1
'((t (:foreground
"black")))
188 (defface fg
:erc-color-face2
'((t (:foreground
"blue4")))
191 (defface fg
:erc-color-face3
'((t (:foreground
"green4")))
194 (defface fg
:erc-color-face4
'((t (:foreground
"red")))
197 (defface fg
:erc-color-face5
'((t (:foreground
"brown")))
200 (defface fg
:erc-color-face6
'((t (:foreground
"purple")))
203 (defface fg
:erc-color-face7
'((t (:foreground
"orange")))
206 (defface fg
:erc-color-face8
'((t (:foreground
"yellow")))
209 (defface fg
:erc-color-face9
'((t (:foreground
"green")))
212 (defface fg
:erc-color-face10
'((t (:foreground
"lightblue1")))
215 (defface fg
:erc-color-face11
'((t (:foreground
"cyan")))
218 (defface fg
:erc-color-face12
'((t (:foreground
"blue")))
221 (defface fg
:erc-color-face13
'((t (:foreground
"deeppink")))
224 (defface fg
:erc-color-face14
'((t (:foreground
"gray50")))
227 (defface fg
:erc-color-face15
'((t (:foreground
"gray90")))
231 (defface bg
:erc-color-face0
'((t (:background
"White")))
234 (defface bg
:erc-color-face1
'((t (:background
"black")))
237 (defface bg
:erc-color-face2
'((t (:background
"blue4")))
240 (defface bg
:erc-color-face3
'((t (:background
"green4")))
243 (defface bg
:erc-color-face4
'((t (:background
"red")))
246 (defface bg
:erc-color-face5
'((t (:background
"brown")))
249 (defface bg
:erc-color-face6
'((t (:background
"purple")))
252 (defface bg
:erc-color-face7
'((t (:background
"orange")))
255 (defface bg
:erc-color-face8
'((t (:background
"yellow")))
258 (defface bg
:erc-color-face9
'((t (:background
"green")))
261 (defface bg
:erc-color-face10
'((t (:background
"lightblue1")))
264 (defface bg
:erc-color-face11
'((t (:background
"cyan")))
267 (defface bg
:erc-color-face12
'((t (:background
"blue")))
270 (defface bg
:erc-color-face13
'((t (:background
"deeppink")))
273 (defface bg
:erc-color-face14
'((t (:background
"gray50")))
276 (defface bg
:erc-color-face15
'((t (:background
"gray90")))
280 (defun erc-get-bg-color-face (n)
281 "Fetches the right face for background color N (0-15)."
282 (if (stringp n
) (setq n
(string-to-number n
)))
283 (if (not (numberp n
))
285 (erc-error "erc-get-bg-color-face: n is NaN: %S" n
))
287 (erc-log (format " Wrong color: %s" n
))
290 ((and (>= n
0) (< n
16))
291 (intern (concat "bg:erc-color-face" (number-to-string n
))))
292 (t (erc-log (format " Wrong color: %s" n
)) 'default
))))
294 (defun erc-get-fg-color-face (n)
295 "Fetches the right face for foreground color N (0-15)."
296 (if (stringp n
) (setq n
(string-to-number n
)))
297 (if (not (numberp n
))
299 (erc-error "erc-get-fg-color-face: n is NaN: %S" n
))
301 (erc-log (format " Wrong color: %s" n
))
304 ((and (>= n
0) (< n
16))
305 (intern (concat "fg:erc-color-face" (number-to-string n
))))
306 (t (erc-log (format " Wrong color: %s" n
)) 'default
))))
308 (define-erc-module irccontrols nil
309 "This mode enables the interpretation of IRC control chars."
310 ((add-hook 'erc-insert-modify-hook
'erc-controls-highlight
)
311 (add-hook 'erc-send-modify-hook
'erc-controls-highlight
))
312 ((remove-hook 'erc-insert-modify-hook
'erc-controls-highlight
)
313 (remove-hook 'erc-send-modify-hook
'erc-controls-highlight
)))
315 (defun erc-controls-interpret (str)
316 "Return a copy of STR after dealing with IRC control characters.
317 See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
320 (cond ((eq erc-interpret-controls-p
'remove
)
321 (erc-controls-strip s
))
322 (erc-interpret-controls-p
328 (while (string-match erc-controls-highlight-regexp s
)
329 (let ((control (match-string 1 s
))
330 (fg-color (match-string 2 s
))
331 (bg-color (match-string 4 s
))
332 (start (match-beginning 0))
333 (end (+ (match-beginning 0)
334 (length (match-string 5 s
)))))
335 (setq s
(erc-replace-match-subexpression-in-string
336 "" s control
1 start
))
337 (cond ((and erc-interpret-mirc-color
(or fg-color bg-color
))
340 ((string= control
"\C-b")
341 (setq boldp
(not boldp
)))
342 ((string= control
"\C-v")
343 (setq inversep
(not inversep
)))
344 ((string= control
"\C-_")
345 (setq underlinep
(not underlinep
)))
346 ((string= control
"\C-c")
349 ((string= control
"\C-g")
352 ((string= control
"\C-o")
359 (erc-controls-propertize
360 start end boldp inversep underlinep fg bg s
)))
364 (defun erc-controls-strip (str)
365 "Return a copy of STR with all IRC control characters removed."
368 (while (string-match erc-controls-remove-regexp s
)
369 (setq s
(replace-match "" nil nil s
)))
372 (defvar erc-controls-remove-regexp
373 "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
374 "Regular expression which matches control characters to remove.")
376 (defvar erc-controls-highlight-regexp
377 (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
378 "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
379 "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
380 "Regular expression which matches control chars and the text to highlight.")
382 (defun erc-controls-highlight ()
383 "Highlight IRC control chars in the buffer.
384 This is useful for `erc-insert-modify-hook' and
385 `erc-send-modify-hook'. Also see `erc-interpret-controls-p' and
386 `erc-interpret-mirc-color'."
387 (goto-char (point-min))
388 (cond ((eq erc-interpret-controls-p
'remove
)
389 (while (re-search-forward erc-controls-remove-regexp nil t
)
391 (erc-interpret-controls-p
397 (while (re-search-forward erc-controls-highlight-regexp nil t
)
398 (let ((control (match-string 1))
399 (fg-color (match-string 2))
400 (bg-color (match-string 4))
401 (start (match-beginning 0))
402 (end (+ (match-beginning 0) (length (match-string 5)))))
403 (replace-match "" nil nil nil
1)
404 (cond ((and erc-interpret-mirc-color
(or fg-color bg-color
))
407 ((string= control
"\C-b")
408 (setq boldp
(not boldp
)))
409 ((string= control
"\C-v")
410 (setq inversep
(not inversep
)))
411 ((string= control
"\C-_")
412 (setq underlinep
(not underlinep
)))
413 ((string= control
"\C-c")
416 ((string= control
"\C-g")
419 ((string= control
"\C-o")
426 (erc-controls-propertize start end
427 boldp inversep underlinep fg bg
)))))
430 (defun erc-controls-propertize (from to boldp inversep underlinep fg bg
432 "Prepend properties from IRC control characters between FROM and TO.
433 If optional argument STR is provided, apply to STR, otherwise prepend properties
434 to a region in the current buffer."
435 (font-lock-prepend-text-property
446 '(erc-underline-face)
449 (list (erc-get-fg-color-face fg
))
452 (list (erc-get-bg-color-face bg
))
457 (defun erc-toggle-interpret-controls (&optional arg
)
458 "Toggle interpretation of control sequences in messages.
460 If ARG is positive, interpretation is turned on.
461 Else interpretation is turned off."
463 (cond ((and (numberp arg
) (> arg
0))
464 (setq erc-interpret-controls-p t
))
465 (arg (setq erc-interpret-controls-p nil
))
466 (t (setq erc-interpret-controls-p
(not erc-interpret-controls-p
))))
467 (message "ERC color interpretation %s"
468 (if erc-interpret-controls-p
"ON" "OFF")))
471 (define-erc-module smiley nil
472 "This mode translates text-smileys such as :-) into pictures.
473 This requires the function `smiley-region', which is defined in
474 smiley.el, which is part of Gnus."
475 ((add-hook 'erc-insert-modify-hook
'erc-smiley
)
476 (add-hook 'erc-send-modify-hook
'erc-smiley
))
477 ((remove-hook 'erc-insert-modify-hook
'erc-smiley
)
478 (remove-hook 'erc-send-modify-hook
'erc-smiley
)))
482 This function should be used with `erc-insert-modify-hook'."
483 (when (fboundp 'smiley-region
)
484 (smiley-region (point-min) (point-max))))
487 (define-erc-module unmorse nil
488 "This mode causes morse code in the current channel to be unmorsed."
489 ((add-hook 'erc-insert-modify-hook
'erc-unmorse
))
490 ((remove-hook 'erc-insert-modify-hook
'erc-unmorse
)))
492 (defun erc-unmorse ()
494 Add this to `erc-insert-modify-hook' if you happen to be on a
495 channel that has weird people talking in morse to each other.
497 See also `unmorse-region'."
498 (goto-char (point-min))
499 (when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t
)
500 (unmorse-region (match-beginning 0) (match-end 0))))
503 (defun erc-occur (string &optional proc
)
504 "Search for STRING in all buffers related to current server.
505 If called interactively and prefix argument is given, search on all connected
506 servers. If called from a program, PROC specifies the server process."
508 (list (read-string "Search for: ")
509 (if current-prefix-arg
510 nil erc-server-process
)))
511 (if (fboundp 'multi-occur
)
512 (multi-occur (erc-buffer-list nil proc
) string
)
513 (error "`multi-occur' is not defined as a function")))
515 (provide 'erc-goodies
)
517 ;; arch-tag: d987ae26-9e28-4c72-9596-e617309fb582
518 ;;; erc-goodies.el ends here