diff lisp/erc/erc-goodies.el @ 68451:fc745b05e928

Revision: [e-mail]/emacs--devo--0--patch-22 Creator: Michael Olson <[e-mail]> Install ERC.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/erc/erc-goodies.el	Sun Jan 29 13:08:58 2006 +0000
@@ -0,0 +1,522 @@
+;; erc-goodies.el --- Collection of ERC modules
+
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation
+
+;; Author: Jorgen Schaefer <[e-mail]>
+
+;; Most code is taken verbatim from erc.el, see there for the original
+;; authors.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This provides some small but still useful modes for ERC.
+
+;;; Code:
+
+(require 'erc)
+
+;; Imenu Autoload
+(add-hook 'erc-mode-hook
+          (lambda ()
+            (setq imenu-create-index-function 'erc-create-imenu-index)))
+(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
+
+;;; Automatically scroll to bottom
+(defcustom erc-input-line-position nil
+  "Specify where to position the input line when using `erc-scroll-to-bottom'.
+
+This should be an integer specifying the line of the buffer on which
+the input line should stay.  A value of \"-1\" would keep the input
+line positioned on the last line in the buffer.  This is passed as an
+argument to `recenter'."
+  :group 'erc-display
+  :type '(choice integer (const nil)))
+
+(define-erc-module scrolltobottom nil
+  "This mode causes the prompt to stay at the end of the window.
+You have to activate or deactivate it in already created windows
+separately."
+  ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom))
+  ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)))
+
+(defun erc-add-scroll-to-bottom ()
+  "A hook function for `erc-mode-hook' to recenter output at bottom of window.
+
+If you find that ERC hangs when using this function, try customizing
+the value of `erc-input-line-position'.
+
+This works whenever scrolling happens, so it's added to
+`window-scroll-functions' rather than `erc-insert-post-hook'."
+  ;;(make-local-hook 'window-scroll-functions)
+  (add-hook 'window-scroll-functions 'erc-scroll-to-bottom nil t))
+
+(defun erc-scroll-to-bottom (window display-start)
+  "Recenter WINDOW so that `point' is on the last line.
+
+This is added to `window-scroll-functions' by `erc-add-scroll-to-bottom'.
+
+You can control which line is recentered to by customizing the
+variable `erc-input-line-position'.
+
+DISPLAY-START is ignored."
+  (if (and window (window-live-p window))
+      ;; Temporarily bind resize-mini-windows to nil so that users who have it
+      ;; set to a non-nil value will not suffer from premature minibuffer
+      ;; shrinkage due to the below recenter call.  I have no idea why this
+      ;; works, but it solves the problem, and has no negative side effects.
+      ;; (Fran Litterio, 2003/01/07)
+      (let ((resize-mini-windows nil))
+        (save-selected-window
+          (select-window window)
+          (save-restriction
+            (widen)
+            (when (and erc-insert-marker
+                       ;; we're editing a line. Scroll.
+                       (> (point) erc-insert-marker))
+              (save-excursion
+                (goto-char (point-max))
+                (recenter (or erc-input-line-position -1))
+                (sit-for 0))))))))
+
+;;; Make read only
+(define-erc-module readonly nil
+  "This mode causes all inserted text to be read-only."
+  ((add-hook 'erc-insert-post-hook 'erc-make-read-only)
+   (add-hook 'erc-send-post-hook 'erc-make-read-only))
+  ((remove-hook 'erc-insert-post-hook 'erc-make-read-only)
+   (remove-hook 'erc-send-post-hook 'erc-make-read-only)))
+
+(defun erc-make-read-only ()
+  "Make all the text in the current buffer read-only.
+Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
+  (put-text-property (point-min) (point-max) 'read-only t)
+  (put-text-property (point-min) (point-max) 'front-sticky t)
+  (put-text-property (point-min) (point-max) 'rear-nonsticky t))
+
+;; Distingush non-commands
+(defvar erc-noncommands-list '(erc-cmd-ME
+                               erc-cmd-COUNTRY
+                               erc-cmd-SV
+                               erc-cmd-SM
+                               erc-cmd-SMV
+                               erc-cmd-LASTLOG)
+  "List of commands that are aliases for CTCP ACTION or for erc messages.
+
+If a command's function symbol is in this list, the typed command
+does not appear in the ERC buffer after the user presses ENTER.")
+
+(define-erc-module noncommands nil
+  "This mode distinguishies non-commands.
+Commands listed in `erc-insert-this' know how to display
+themselves."
+  ((add-hook 'erc-send-pre-hook 'erc-send-distinguish-noncommands))
+  ((remove-hook 'erc-send-pre-hook 'erc-send-distinguish-noncommands)))
+
+(defun erc-send-distinguish-noncommands (str)
+  "If STR is an ERC non-command, set `erc-insert-this' to nil."
+  (let* ((command (erc-extract-command-from-line str))
+         (cmd-fun (and command
+                       (car command))))
+    (when (and cmd-fun
+               (not (string-match "\n.+$" str))
+               (memq cmd-fun erc-noncommands-list))
+      (setq erc-insert-this nil))))
+
+;;; IRC control character processing.
+(defgroup erc-control-characters nil
+  "Dealing with control characters"
+  :group 'erc)
+
+(defcustom erc-interpret-controls-p t
+  "*If non-nil, display IRC colours and other highlighting effects.
+
+If this is set to the symbol `remove', ERC removes all IRC colors and
+highlighting effects.  When this variable is non-nil, it can cause Emacs to run
+slowly on systems lacking sufficient CPU speed.  In chatty channels, or in an
+emergency (message flood) it can be turned off to save processing time.  See
+`erc-toggle-interpret-controls'."
+  :group 'erc-control-characters
+  :type '(choice (const :tag "Highlight control characters" t)
+                 (const :tag "Remove control characters" remove)
+                 (const :tag "Display raw control characters" nil)))
+
+(defcustom erc-interpret-mirc-color nil
+  "*If non-nil, erc will interpret mIRC color codes."
+  :group 'erc-control-characters
+  :type 'boolean)
+
+(defcustom erc-beep-p nil
+  "Beep if C-g is in the server message.
+The value `erc-interpret-controls-p' must also be t for this to work."
+  :group 'erc-control-characters
+  :type 'boolean)
+
+(defface erc-bold-face '((t (:bold t)))
+  "ERC bold face."
+  :group 'erc-faces)
+(defface erc-inverse-face
+  '((t (:foreground "White" :background "Black")))
+  "ERC inverse face."
+  :group 'erc-faces)
+(defface erc-underline-face '((t (:underline t)))
+  "ERC underline face."
+  :group 'erc-faces)
+
+(defface fg:erc-color-face0 '((t (:foreground "White")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face1 '((t (:foreground "black")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face2 '((t (:foreground "blue4")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face3 '((t (:foreground "green4")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face4 '((t (:foreground "red")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face5 '((t (:foreground "brown")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face6 '((t (:foreground "purple")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face7 '((t (:foreground "orange")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face8 '((t (:foreground "yellow")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face9 '((t (:foreground "green")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face10 '((t (:foreground "lightblue1")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face11 '((t (:foreground "cyan")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face12 '((t (:foreground "blue")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face13 '((t (:foreground "deeppink")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face14 '((t (:foreground "gray50")))
+  "ERC face."
+  :group 'erc-faces)
+(defface fg:erc-color-face15 '((t (:foreground "gray90")))
+  "ERC face."
+  :group 'erc-faces)
+
+(defface bg:erc-color-face0 '((t (:background "White")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face1 '((t (:background "black")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face2 '((t (:background "blue4")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face3 '((t (:background "green4")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face4 '((t (:background "red")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face5 '((t (:background "brown")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face6 '((t (:background "purple")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face7 '((t (:background "orange")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face8 '((t (:background "yellow")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face9 '((t (:background "green")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face10 '((t (:background "lightblue1")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face11 '((t (:background "cyan")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face12 '((t (:background "blue")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face13 '((t (:background "deeppink")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face14 '((t (:background "gray50")))
+  "ERC face."
+  :group 'erc-faces)
+(defface bg:erc-color-face15 '((t (:background "gray90")))
+  "ERC face."
+  :group 'erc-faces)
+
+(defun erc-get-bg-color-face (n)
+  "Fetches the right face for background color N (0-15)."
+  (if (stringp n) (setq n (string-to-number n)))
+  (if (not (numberp n))
+      (progn
+        (message "erc-get-bg-color-face: n is NaN: %S" n)
+        (beep)
+        'default)
+    (when (> n 16)
+      (erc-log (format "   Wrong color: %s" n))
+      (setq n (mod n 16)))
+    (cond
+     ((and (>= n 0) (< n 16))
+      (intern (concat "bg:erc-color-face" (number-to-string n))))
+     (t (erc-log (format "   Wrong color: %s" n)) 'default))))
+
+(defun erc-get-fg-color-face (n)
+  "Fetches the right face for foreground color N (0-15)."
+  (if (stringp n) (setq n (string-to-number n)))
+  (if (not (numberp n))
+      (progn
+        (message "erc-get-fg-color-face: n is NaN: %S" n)
+        (beep)
+        'default)
+    (when (> n 16)
+      (erc-log (format "   Wrong color: %s" n))
+      (setq n (mod n 16)))
+    (cond
+     ((and (>= n 0) (< n 16))
+      (intern (concat "fg:erc-color-face" (number-to-string n))))
+     (t (erc-log (format "   Wrong color: %s" n)) 'default))))
+
+(define-erc-module irccontrols nil
+  "This mode enables the interpretation of IRC control chars."
+  ((add-hook 'erc-insert-modify-hook 'erc-controls-highlight)
+   (add-hook 'erc-send-modify-hook 'erc-controls-highlight))
+  ((remove-hook 'erc-insert-modify-hook 'erc-controls-highlight)
+   (remove-hook 'erc-send-modify-hook 'erc-controls-highlight)))
+
+(defun erc-controls-interpret (str)
+   "Return a copy of STR after dealing with IRC control characters.
+See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
+   (when str
+     (let ((s str))
+       (cond ((eq erc-interpret-controls-p 'remove)
+              (erc-controls-strip s))
+             (erc-interpret-controls-p
+              (let ((boldp nil)
+                    (inversep nil)
+                    (underlinep nil)
+                    (fg nil)
+                    (bg nil))
+                (while (string-match erc-controls-highlight-regexp s)
+                  (let ((control (match-string 1 s))
+                        (fg-color (match-string 2 s))
+                        (bg-color (match-string 4 s))
+                        (start (match-beginning 0))
+                        (end (+ (match-beginning 0)
+                                (length (match-string 5 s)))))
+                    (setq s (erc-replace-match-subexpression-in-string
+                             "" s control 1 start))
+                    (cond ((and erc-interpret-mirc-color (or fg-color bg-color))
+                           (setq fg fg-color)
+                           (setq bg bg-color))
+                          ((string= control "\C-b")
+                           (setq boldp (not boldp)))
+                          ((string= control "\C-v")
+                           (setq inversep (not inversep)))
+                          ((string= control "\C-_")
+                           (setq underlinep (not underlinep)))
+                          ((string= control "\C-c")
+                           (setq fg nil
+                                 bg nil))
+                          ((string= control "\C-g")
+                           (when erc-beep-p
+                             (ding)))
+                          ((string= control "\C-o")
+                           (setq boldp nil
+                                 inversep nil
+                                 underlinep nil
+                                 fg nil
+                                 bg nil))
+                          (t nil))
+                    (erc-controls-propertize
+                     start end boldp inversep underlinep fg bg s)))
+                s))
+             (t s)))))
+
+(defun erc-controls-strip (str)
+  "Return a copy of STR with all IRC control characters removed."
+  (when str
+    (let ((s str))
+      (while (string-match erc-controls-remove-regexp s)
+        (setq s (replace-match "" nil nil s)))
+      s)))
+
+(defvar erc-controls-remove-regexp
+  "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
+  "Regular expression which matches control characters to remove.")
+
+(defvar erc-controls-highlight-regexp
+  (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
+          "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
+          "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
+  "Regular expression which matches control chars and the text to highlight.")
+
+(defun erc-controls-highlight ()
+  "Highlight IRC control chars in the buffer.
+This is useful for `erc-insert-modify-hook' and
+`erc-send-modify-hook'. Also see `erc-interpret-controls-p' and
+`erc-interpret-mirc-color'."
+  (goto-char (point-min))
+  (cond ((eq erc-interpret-controls-p 'remove)
+         (while (re-search-forward erc-controls-remove-regexp nil t)
+           (replace-match "")))
+        (erc-interpret-controls-p
+         (let ((boldp nil)
+               (inversep nil)
+               (underlinep nil)
+               (fg nil)
+               (bg nil))
+           (while (re-search-forward erc-controls-highlight-regexp nil t)
+             (let ((control (match-string 1))
+                   (fg-color (match-string 2))
+                   (bg-color (match-string 4))
+                   (start (match-beginning 0))
+                   (end (+ (match-beginning 0) (length (match-string 5)))))
+               (replace-match "" nil nil nil 1)
+               (cond ((and erc-interpret-mirc-color (or fg-color bg-color))
+                      (setq fg fg-color)
+                      (setq bg bg-color))
+                     ((string= control "\C-b")
+                      (setq boldp (not boldp)))
+                     ((string= control "\C-v")
+                      (setq inversep (not inversep)))
+                     ((string= control "\C-_")
+                      (setq underlinep (not underlinep)))
+                     ((string= control "\C-c")
+                      (setq fg nil
+                            bg nil))
+                     ((string= control "\C-g")
+                      (when erc-beep-p
+                        (ding)))
+                     ((string= control "\C-o")
+                      (setq boldp nil
+                            inversep nil
+                            underlinep nil
+                            fg nil
+                            bg nil))
+                     (t nil))
+               (erc-controls-propertize start end
+                                        boldp inversep underlinep fg bg)))))
+        (t nil)))
+
+(defun erc-controls-propertize (from to boldp inversep underlinep fg bg
+                                     &optional str)
+  "Prepend properties from IRC control characters between FROM and TO.
+If optional argument STR is provided, apply to STR, otherwise prepend properties
+to a region in the current buffer."
+  (font-lock-prepend-text-property
+   from
+   to
+   'face
+   (append (if boldp
+               '(erc-bold-face)
+             nil)
+           (if inversep
+               '(erc-inverse-face)
+             nil)
+           (if underlinep
+               '(erc-underline-face)
+             nil)
+           (if fg
+               (list (erc-get-fg-color-face fg))
+             nil)
+           (if bg
+               (list (erc-get-bg-color-face bg))
+             nil))
+   str)
+  str)
+
+(defun erc-toggle-interpret-controls (&optional arg)
+  "Toggle interpretation of control sequences in messages.
+
+If ARG is positive, interpretation is turned on.
+Else interpretation is turned off."
+  (interactive "P")
+  (cond ((and (numberp arg) (> arg 0))
+         (setq erc-interpret-controls-p t))
+        (arg (setq erc-interpret-controls-p nil))
+        (t (setq erc-interpret-controls-p (not erc-interpret-controls-p))))
+  (message "ERC color interpretation %s"
+           (if erc-interpret-controls-p "ON" "OFF")))
+
+;; Smiley
+(define-erc-module smiley nil
+  "This mode translates text-smileys such as :-) into pictures.
+This requires the function `smiley-region', which is defined in
+smiley.el, which is part of Gnus."
+  ((add-hook 'erc-insert-modify-hook 'erc-smiley)
+   (add-hook 'erc-send-modify-hook 'erc-smiley))
+  ((remove-hook 'erc-insert-modify-hook 'erc-smiley)
+   (remove-hook 'erc-send-modify-hook 'erc-smiley)))
+
+(defun erc-smiley ()
+  "Smilify a region.
+This function should be used with `erc-insert-modify-hook'."
+  (when (fboundp 'smiley-region)
+    (smiley-region (point-min) (point-max))))
+
+;; Unmorse
+(define-erc-module unmorse nil
+  "This mode causes morse code in the current channel to be unmorsed."
+  ((add-hook 'erc-insert-modify-hook 'erc-unmorse))
+  ((remove-hook 'erc-insert-modify-hook 'erc-unmorse)))
+
+(defun erc-unmorse ()
+  "Unmorse some text.
+Add this to `erc-insert-modify-hook' if you happen to be on a
+channel that has weird people talking in morse to each other.
+
+See also `unmorse-region'."
+  (goto-char (point-min))
+  (when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t)
+    (unmorse-region (match-beginning 0) (match-end 0))))
+
+;;; erc-occur
+(defun erc-occur (string &optional proc)
+  "Search for STRING in all buffers related to current server.
+If called interactively and prefix argument is given, search on all connected
+servers.  If called from a program, PROC specifies the server process."
+  (interactive
+   (list (read-string "Search for: ")
+         (if current-prefix-arg
+             nil erc-server-process)))
+  (if (fboundp 'multi-occur)
+      (multi-occur (erc-buffer-list nil proc) string)
+    (error "`multi-occur' is not defined as a function")))
+
+(provide 'erc-goodies)
+
+;; arch-tag: d987ae26-9e28-4c72-9596-e617309fb582
+;;; erc-goodies.el ends here