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