From e2813fbd7b174b2ca31938660f89082ecaf43522 Mon Sep 17 00:00:00 2001 From: Carolyn Knight-Serrano Date: Tue, 17 Dec 2019 10:26:11 -0800 Subject: [PATCH] Added new lisp files --- .last-package-update-day | 2 +- afew/config | 5 + diary | 3 + init.el | 316 +- lisp/erc-auto.el | 555 ++++ lisp/erc-autoaway.el | 290 ++ lisp/erc-backend.el | 1967 ++++++++++++ lisp/erc-bbdb.el | 269 ++ lisp/erc-button.el | 537 ++++ lisp/erc-capab.el | 208 ++ lisp/erc-chess.el | 181 ++ lisp/erc-compat.el | 446 +++ lisp/erc-dcc.el | 1186 +++++++ lisp/erc-ezbounce.el | 180 ++ lisp/erc-fill.el | 198 ++ lisp/erc-goodies.el | 576 ++++ lisp/erc-hecomplete.el | 225 ++ lisp/erc-ibuffer.el | 195 ++ lisp/erc-identd.el | 127 + lisp/erc-imenu.el | 138 + lisp/erc-join.el | 139 + lisp/erc-lang.el | 213 ++ lisp/erc-list-old.el | 416 +++ lisp/erc-list.el | 229 ++ lisp/erc-log.el | 456 +++ lisp/erc-maint.el | 3 + lisp/erc-match.el | 640 ++++ lisp/erc-menu.el | 154 + lisp/erc-netsplit.el | 214 ++ lisp/erc-networks.el | 870 +++++ lisp/erc-nick-notify.el | 222 ++ lisp/erc-nicklist.el | 416 +++ lisp/erc-notify.el | 254 ++ lisp/erc-page.el | 114 + lisp/erc-pcomplete.el | 284 ++ lisp/erc-replace.el | 99 + lisp/erc-ring.el | 149 + lisp/erc-sasl.el | 95 + lisp/erc-services.el | 445 +++ lisp/erc-sound.el | 152 + lisp/erc-speak.el | 230 ++ lisp/erc-speedbar.el | 371 +++ lisp/erc-spelling.el | 112 + lisp/erc-stamp.el | 427 +++ lisp/erc-track.el | 1074 +++++++ lisp/erc-truncate.el | 121 + lisp/erc-viper.el | 74 + lisp/erc-xdcc.el | 141 + lisp/erc.el | 6520 ++++++++++++++++++++++++++++++++++++++ lisp/org-notmuch.el | 135 + lisp/sr-speedbar.el | 651 ++++ org-journal.cache | 2 + request/curl-cookie-jar | 6 + 53 files changed, 22991 insertions(+), 41 deletions(-) create mode 100644 afew/config create mode 100644 diary create mode 100644 lisp/erc-auto.el create mode 100644 lisp/erc-autoaway.el create mode 100644 lisp/erc-backend.el create mode 100644 lisp/erc-bbdb.el create mode 100644 lisp/erc-button.el create mode 100644 lisp/erc-capab.el create mode 100644 lisp/erc-chess.el create mode 100644 lisp/erc-compat.el create mode 100644 lisp/erc-dcc.el create mode 100644 lisp/erc-ezbounce.el create mode 100644 lisp/erc-fill.el create mode 100644 lisp/erc-goodies.el create mode 100644 lisp/erc-hecomplete.el create mode 100644 lisp/erc-ibuffer.el create mode 100644 lisp/erc-identd.el create mode 100644 lisp/erc-imenu.el create mode 100644 lisp/erc-join.el create mode 100644 lisp/erc-lang.el create mode 100644 lisp/erc-list-old.el create mode 100644 lisp/erc-list.el create mode 100644 lisp/erc-log.el create mode 100644 lisp/erc-maint.el create mode 100644 lisp/erc-match.el create mode 100644 lisp/erc-menu.el create mode 100644 lisp/erc-netsplit.el create mode 100644 lisp/erc-networks.el create mode 100644 lisp/erc-nick-notify.el create mode 100644 lisp/erc-nicklist.el create mode 100644 lisp/erc-notify.el create mode 100644 lisp/erc-page.el create mode 100644 lisp/erc-pcomplete.el create mode 100644 lisp/erc-replace.el create mode 100644 lisp/erc-ring.el create mode 100644 lisp/erc-sasl.el create mode 100644 lisp/erc-services.el create mode 100644 lisp/erc-sound.el create mode 100644 lisp/erc-speak.el create mode 100644 lisp/erc-speedbar.el create mode 100644 lisp/erc-spelling.el create mode 100644 lisp/erc-stamp.el create mode 100644 lisp/erc-track.el create mode 100644 lisp/erc-truncate.el create mode 100644 lisp/erc-viper.el create mode 100644 lisp/erc-xdcc.el create mode 100644 lisp/erc.el create mode 100644 lisp/org-notmuch.el create mode 100644 lisp/sr-speedbar.el create mode 100644 org-journal.cache create mode 100644 request/curl-cookie-jar diff --git a/.last-package-update-day b/.last-package-update-day index b7e49d0..fd70ce6 100644 --- a/.last-package-update-day +++ b/.last-package-update-day @@ -1 +1 @@ -737385 \ No newline at end of file +737408 \ No newline at end of file diff --git a/afew/config b/afew/config new file mode 100644 index 0000000..e7549be --- /dev/null +++ b/afew/config @@ -0,0 +1,5 @@ +[MailMover] +folders = Defunct/INBOX + +# rules +Defunct/INBOX = 'tag:archive':Defunct/Archiv 'tag:cforum':Defunct/Lists.cforum 'tag:deleted':Defunct/Trash \ No newline at end of file diff --git a/diary b/diary new file mode 100644 index 0000000..ae57369 --- /dev/null +++ b/diary @@ -0,0 +1,3 @@ +Dec 16, 2019 + +Drove home with Mom. Pretty good/uneventful. Looked at clojure and emacs stuff. \ No newline at end of file diff --git a/init.el b/init.el index deaea6c..2607e62 100644 --- a/init.el +++ b/init.el @@ -1,8 +1,8 @@ -; __ __ __ __ ______ ______ __ -; /\ \ /\ "-.\ \ /\ \ /\__ _\ /\ ___\ /\ \ -; \ \ \ \ \ \-. \ \ \ \ \/_/\ \/ \ \ __\ \ \ \____ -; \ \_\ \ \_\\"\_\ \ \_\ \ \_\ \ \_____\ \ \_____\ -; \/_/ \/_/ \/_/ \/_/ \/_/ \/_____/ \/_____/ +;; __ __ __ __ ______ ______ __ +;; /\ \ /\ "-.\ \ /\ \ /\__ _\ /\ ___\ /\ \ +;; \ \ \ \ \ \-. \ \ \ \ \/_/\ \/ \ \ __\ \ \ \____ +;; \ \_\ \ \_\\"\_\ \ \_\ \ \_\ \ \_____\ \ \_____\ +;; \/_/ \/_/ \/_/ \/_/ \/_/ \/_____/ \/_____/ ;;; Bad stuff @@ -17,7 +17,10 @@ (scroll-bar-mode -1) (fringe-mode 0) + + ;;; Sane defaults ;;; +(add-to-list 'load-path "~/.emacs.d/lisp/") (when (version<= "26.0.50" emacs-version) (setq display-line-numbers-type 'relative) (global-display-line-numbers-mode)) @@ -144,6 +147,23 @@ ;;; Editing Packages +(use-package powerthesaurus) + +(use-package lsp-mode + :commands lsp) +(use-package lsp-ui :commands lsp-ui-mode) +(use-package company-lsp :commands company-lsp) +(use-package helm-lsp :commands helm-lsp-workspace-symbol) +;; optionally if you want to use debugger +(use-package dap-mode) + +(use-package evil-snipe + :config + (evil-snipe-mode +1) + (evil-snipe-override-mode +1)) + + + ;parinfer (use-package parinfer :general @@ -221,8 +241,8 @@ :config (add-hook 'lsp-mode-hook 'lsp-ui-mode)) (use-package company-lsp :commands company-lsp) - ;(use-package helm-lsp :commands helm-lsp-workspace-symbol) - ;(use-package lsp-treemacs :commands lsp-treemacs-errors-list) +(use-package helm-lsp :commands helm-lsp-workspace-symbol) +(use-package lsp-treemacs :commands lsp-treemacs-errors-list) ;;; Evil!! @@ -273,10 +293,20 @@ ;;; Interface - ;theme +;;theme (add-to-list 'custom-theme-load-path "~/.emacs.d/themes") (load-theme 'xresources t) +(use-package multi-term + :config + (setq term-term-name "xterm") + (defun j/configure-term () + (setq truncate-lines 1) + (define-key term-raw-map (kbd "C-y") 'term-paste) + (add-hook 'term-mode-hook 'j/configure-term t))) + +(use-package helm-mt) + ; fix those pesky highligts (set-face-attribute 'region nil :background "brightblack") @@ -319,53 +349,124 @@ (set-face-attribute 'mode-line nil :box '(:line-width 3)) -;; ivy +;; helm - ;flx -(use-package flx) - ;ivy -(use-package ivy +(autoload 'dired-async-mode "dired-async.el" nil t) +(dired-async-mode 1) + +(use-package helm :config - (setq ivy-initial-inputs-alist nil) - ;; (setq ivy-re-builders-alist - ;; '((ivy-switch-buffer . ivy--regex-plus - ;; (t . ivy--regex-fuzzy)))) - (ivy-mode 1)) + (global-set-key (kbd "C-x C-f") #'helm-find-files) + (require 'helm-config) + (setq helm-mode-fuzzy-match t) + (setq helm-completion-in-region-fuzzy-match t) + (helm-mode 1)) - ;swiper -(use-package swiper - :after ivy) - - ;counsel -(use-package counsel - :after ivy +(use-package smex + :config + (smex-initialize) :general (general-nmap - ":" 'counsel-M-x)) + ":" 'smex)) + + ; Parens (show-paren-mode 1) -(set-face-background 'show-paren-match "brightblack" - (set-face-attribute 'show-paren-match nil :weight 'bold)) +(set-face-background 'show-paren-match (face-background 'default)) +(set-face-foreground 'show-paren-match "#def") +(set-face-attribute 'show-paren-match nil :weight 'extra-bold :underline t) +(use-package highlight-parentheses + :init + (add-hook 'highlight-parentheses-mode-hook) + '(lambda () + (setq autopair-handle-action-fns + (append))) + (if autopair-handle-action-fns + autopair-handle-action-fns + '(autopair-default-handle-action)) + '((lambda (action pair pos-before)) + (hl-paren-color-update))) + +(define-globalized-minor-mode global-highlight-parentheses-mode + highlight-parentheses-mode + (lambda () + (highlight-parentheses-mode t))) +(global-highlight-parentheses-mode t) + + + (use-package smartparens :config (require 'smartparens-config) (smartparens-global-mode 1)) +;;; Elm +(use-package elm-mode + :mode ("\\.elm\\'" . elm-mode) + :interpreter ("elm" . elm-mode)) + + +;;; Elixir +(use-package elixir-mode + :mode ("\\.ex*\\'" . elixir-mode) + :interpreter ("ex*" . elixir-mode)) + +(use-package alchemist + :after elixir-mode) + + ;;; Org Mode ; org (use-package org :mode ("\\.org\\'" . org-mode) :interpreter ("org" . org-mode) + :general + (general-nmap + "oa" 'org-agenda) :config + (setq org-agenda-files '("~/org/")) + (setq org-agenda-include-diary t) + (setq org-todo-keywords + '((sequence "TODO" "IN-PROGRESS" "WAITING" "|" "DONE" "CANCELED"))) (define-key global-map "\C-cl" 'org-store-link) (custom-set-variables) '(org-directory "~/.org") '(org-agenda-files (list org-directory))) +(use-package calfw) +(use-package calfw-cal) +(use-package calfw-org) + +(setq org-agenda-window-setup (quote current-window)) +;;warn me of any deadlines in next 7 days +(setq org-deadline-warning-days 7) +;;show me tasks scheduled or due in next fortnight +(setq org-agenda-span (quote fortnight)) +;;don't show tasks as scheduled if they are already shown as a deadline +(setq org-agenda-skip-scheduled-if-deadline-is-shown t) +;;don't give awarning colour to tasks with impending deadlines +;;if they are scheduled to be done +(setq org-agenda-skip-deadline-prewarning-if-scheduled (quote pre-scheduled)) +;;don't show tasks that are scheduled or have deadlines in the +;;normal todo list +(setq org-agenda-todo-ignore-deadlines (quote all)) +(setq org-agenda-todo-ignore-scheduled (quote all)) +;;sort tasks in order of when they are due and then by priority +(setq org-agenda-sorting-strategy + (quote + ((agenda deadline-up priority-down) + (todo priority-down category-keep) + (tags priority-down category-keep) + (search category-keep)))) + +(use-package org-bullets + :config + (add-hook 'org-mode-hook (lambda () (org-bullets-mode 1)))) + ; evil-org (use-package evil-org :after org @@ -383,6 +484,19 @@ (org-journal-dir "~/org/journal/") (org-journal-date-format "%A, %d %B %Y")) +(use-package toc-org) +(add-to-list 'load-path "~/.emacs.d/toc-org") +(if (require 'toc-org nil t) + (add-hook 'org-mode-hook 'toc-org-mode) + + ;; enable in markdown, too + (add-hook 'markdown-mode-hook 'toc-org-mode) + (define-key markdown-mode-map (kbd "\C-c\C-o") 'toc-org-markdown-follow-thing-at-point) + (warn "toc-org not found")) + +;;; Emacs-lisp +(use-package suggest) + ;;; LaTeX (use-package tex @@ -440,7 +554,7 @@ ; magit ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; (use-package magit) -(use-package smerge) +(use-package forge) (use-package git-gutter :config @@ -452,6 +566,41 @@ ;;; Misc +(use-package gopher + :commands gopher) + + +(require 'tls) +(use-package erc) +(require 'erc-nicklist) +(setq erc-autojoin-channels-alist + '(("freenode.net" "#emacs" "#erc" "##crawl" "#iww" "#clojure" "#rust" "#haskell" "#NetBSD" "#pkgsrc" "#go-nuts"))) +;; (erc-ssl :server "irc.freenode.net" :port 6697 :nick "gigavinyl") +;; (erc-ssl :server "irc.oftc.net" :port 6697 :nick "gigavinyl") +(erc :server "irc.indymedia.org" :port 6667 :nick "gigavinyl") + +(use-package erc-colorize) +(use-package ercn) +(use-package erc-status-sidebar) +(use-package erc-youtube) +(use-package erc-yt) +(use-package erc-social-graph) +(require 'erc-sasl) +(add-to-list 'erc-sasl-server-regexp-list "irc.freenode.net") + + + + +(use-package deadgrep + :config + (global-set-key (kbd "") #'deadgrep)) + + +(use-package elfeed + :general + (general-nmap + "f" 'elfeed)) + (use-package tramp) @@ -460,21 +609,67 @@ ;notmuch (require 'notmuch) -(load "~/.emacs.d/lisp/org-notmuch.el") +(defun message-recipients () + "Return a list of all recipients in the message, looking at TO, CC and BCC. + +Each recipient is in the format of `mail-extract-address-components'." + (mapcan (lambda (header) + (let ((header-value (message-fetch-field header))) + (and + header-value + (mail-extract-address-components header-value t)))) + '("To" "Cc" "Bcc"))) + +(defun message-all-epg-keys-available-p () + "Return non-nil if the pgp keyring has a public key for each recipient." + (require 'epa) + (let ((context (epg-make-context epa-protocol))) + (catch 'break + (dolist (recipient (message-recipients)) + (let ((recipient-email (cadr recipient))) + (when (and recipient-email (not (epg-list-keys context recipient-email))) + (throw 'break nil)))) + t))) + +(defun message-sign-encrypt-if-all-keys-available () + "Add MML tag to encrypt message when there is a key for each recipient. + +Consider adding this function to `message-send-hook' to +systematically send encrypted emails when possible." + (when (message-all-epg-keys-available-p) + (mml-secure-message-sign-encrypt))) + +(add-hook 'message-send-hook #'message-sign-encrypt-if-all-keys-available) (require 'org-notmuch) +(use-package helm-notmuch + :general + (general-nmap + "nm" 'helm-notmuch)) (setq notmuch-saved-searches '((:name "unread" :query "tag:inbox and tag:unread" - :count-query "tag:unread" + :count-query "tag:unread and tag:inbox" :sort-order newest-first) (:name "inbox" :query "tag:inbox" :count-query "tag:inbox" + :sort-order newest-first) + (:name "sent" + :query "tag:sent" + :count-query "tag:sent" :sort-order newest-first))) (setq mail-specify-envelope-from t) -(setq message-sendmail-envelope-from header) -(setq mail-envelope-from header) +(setq message-sendmail-envelope-from 'header) +(setq mail-envelope-from 'header) +(setq sendmail-program "/usr/pkg/bin/msmtp") +(require 'notmuch-address) +(setq notmuch-address-command "/usr/local/bin/nottoomuch-addresses.sh") +(notmuch-address-message-insinuate) + +(setq notmuch-address-selection-function + (lambda (prompt collection initial-input) + (completing-read prompt (cons initial-input collection) nil t nil 'notmuch-address-history))) (add-hook 'message-setup-hook 'mml-secure-sign-pgpmime) (setq notmuch-crypto-process-mime t) @@ -547,7 +742,13 @@ (use-package w3m) +(require 'sr-speedbar) + (use-package weechat) +(require 'weechat-notifications) +(require 'weechat-latex) +(require 'weechat-speedbar) + (use-package exec-path-from-shell @@ -571,9 +772,9 @@ ;(require 'sclang) ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; Rust -(use-package rust-mode - :mode ("\\.rs\\'" . rust-mode) - :interpreter ("rust" . rust-mode)) +(use-package rustic + :mode ("\\.rs\\'" . rustic) + :interpreter ("rust" . rustic)) (use-package flycheck-rust :after rust-mode) @@ -581,8 +782,8 @@ (use-package racer :after rust-mode :config - (add-hook 'rust-mode-hook #'racer-mode) - (add-hook 'racer-mode-hook #'eldoc-mode) + (add-hook 'rustic-hook #'racer-mode) + (add-hook 'rustic-hook #'eldoc-mode) (add-hook 'racer-mode-hook #'company-mode) (define-key rust-mode-map (kbd "TAB") #'company-indent-or-complete-common) (setq company-tooltip-align-annotations t)) @@ -591,6 +792,23 @@ :mode ("\\.toml\\'" . toml-mode) :interpreter ("rust" . toml-mode)) + +;;; Go +(use-package go-mode + :mode ("\\.go\\'" . go-mode) + :interpreter ("go" . go-mode) + :config + (add-hook 'go-mode-hook 'lsp-deferred)) +(use-package go-flycheck + :after go-mode) +(use-package gorepl-mode + :after go-mode + :config + (add-hook 'go-mode-hook #'gorepl-mode)) +(use-package gotest + :after go-mode) + + ;;; Haskell (use-package haskell-mode :mode ("\\.hs\\'" . haskell-mode) @@ -646,8 +864,20 @@ :states 'normal "rl" 'load-file "~/emacs.d/init.el") +;; byte-compile +(defun byte-compile-current-buffer () + "`byte-compile' current buffer if it's emacs-lisp-mode and compiled file exists." + (interactive) + (when (and (eq major-mode 'emacs-lisp-mode) + (file-exists-p (byte-compile-dest-file buffer-file-name))) + (byte-compile-file buffer-file-name))) + +(add-hook 'after-save-hook #'byte-compile-current-buffer) + + + (defun goto-match-paren (arg) - "Go to the matching parenthesis if on parenthesis, otherwise insert %.) + "Go to the matching parenthesis if on parenthesis, otherwise insert %. vi style of % jumping to matching brace." (interactive "p") (cond ((looking-at "\\s\(\") (forward-list 1) (backward-char 1) @@ -658,9 +888,14 @@ ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. + '(browse-url-browser-function (quote browse-url-firefox)) '(custom-safe-themes (quote ("c74e83f8aa4c78a121b52146eadb792c9facc5b1f02c917e3dbb454fca931223" "e4c8810d9ab925567a69c11d5c95d198a4e7d05871453b2c92c020712559c4c1" default))) + '(elfeed-feeds + (quote + ("https://therealnews.com/feed" "https://blog.netbsd.org/tnf/feed/entries/atom" "http://libcom.org/library-latest/feed" "https://itsgoingdown.org/feed/podcast/" "https://crimethinc.com/feed" "https://www.indybay.org/syn/generate_rss.php?page_id=60&include_posts=1&include_blurbs=1" "https://www.indybay.org/syn/generate_rss.php?page_id=12&include_posts=1&include_blurbs=1" "https://unicornriot.ninja/feed/" "https://blackrosefed.org/feed/" "http://news.infoshop.org/feed/" "https://antifascistnews.net/feed/" "https://en.squat.net/feed/" "https://enoughisenough14.org/feed/" "https://thefreeonline.wordpress.com/feed/" "https://www.redpepper.org.uk/feed" "https://anarchistnews.org/rss.xml" "https://waronsociety.noblogs.org/?feed=rss2" "https://en-contrainfo.espiv.net/feed/" "https://earthfirstjournal.org/newswire/feed/" "https://anarchistwithoutcontent.wordpress.com/feed/" "https://countervortex.org/node/feed" "http://ideasandaction.info/feed/" "https://industrialworker.iww.org/?feed=rss2" "https://www.iww.org/node/feed" "https://transfelinism.wordpress.com/feed/" "https://yogthos.net/feed.xml"))) + '(helm-completion-style (quote emacs)) '(lui-buttons-list (quote (("\\(?:id\\|mid\\|thread\\):[0-9A-Za-z][0-9A-Za-z.@-]*" 0 notmuch-show 0) @@ -672,11 +907,12 @@ ("\\\" message to NickServ. +When called interactively, read the password using `read-passwd'. + +\(fn PASSWORD)" t nil) + +;;;*** + +;;;### (autoloads nil "erc-sound" "erc-sound.el" (18331 42201)) +;;; Generated autoloads from erc-sound.el + (autoload 'erc-sound-mode "erc-sound") + +;;;*** + +;;;### (autoloads (erc-speedbar-browser) "erc-speedbar" "erc-speedbar.el" +;;;;;; (18331 42202)) +;;; Generated autoloads from erc-speedbar.el + +(autoload 'erc-speedbar-browser "erc-speedbar" "\ +Initialize speedbar to display an ERC browser. +This will add a speedbar major display mode. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "erc-spelling" "erc-spelling.el" (18331 42201)) +;;; Generated autoloads from erc-spelling.el + (autoload 'erc-spelling-mode "erc-spelling" nil t) + +;;;*** + +;;;### (autoloads nil "erc-stamp" "erc-stamp.el" (18331 42202)) +;;; Generated autoloads from erc-stamp.el + (autoload 'erc-timestamp-mode "erc-stamp" nil t) + +;;;*** + +;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc-track.el" +;;;;;; (18331 42201)) +;;; Generated autoloads from erc-track.el + +(defvar erc-track-minor-mode nil "\ +Non-nil if Erc-Track minor mode is enabled. +See the command `erc-track-minor-mode' for a description of this minor mode.") + +(custom-autoload 'erc-track-minor-mode "erc-track" nil) + +(autoload 'erc-track-minor-mode "erc-track" "\ +Global minor mode for tracking ERC buffers and showing activity in the +mode line. + +This exists for the sole purpose of providing the C-c C-SPC and +C-c C-@ keybindings. Make sure that you have enabled the track +module, otherwise the keybindings will not do anything useful. + +\(fn &optional ARG)" t nil) + (autoload 'erc-track-mode "erc-track" nil t) + +;;;*** + +;;;### (autoloads (erc-truncate-buffer erc-truncate-buffer-to-size) +;;;;;; "erc-truncate" "erc-truncate.el" (18331 42201)) +;;; Generated autoloads from erc-truncate.el + (autoload 'erc-truncate-mode "erc-truncate" nil t) + +(autoload 'erc-truncate-buffer-to-size "erc-truncate" "\ +Truncates the buffer to the size SIZE. +If BUFFER is not provided, the current buffer is assumed. The deleted +region is logged if `erc-logging-enabled' returns non-nil. + +\(fn SIZE &optional BUFFER)" nil nil) + +(autoload 'erc-truncate-buffer "erc-truncate" "\ +Truncates the current buffer to `erc-max-buffer-size'. +Meant to be used in hooks, like `erc-insert-post-hook'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (erc-xdcc-add-file) "erc-xdcc" "erc-xdcc.el" (18331 +;;;;;; 42202)) +;;; Generated autoloads from erc-xdcc.el + (autoload 'erc-xdcc-mode "erc-xdcc") + +(autoload 'erc-xdcc-add-file "erc-xdcc" "\ +Add a file to `erc-xdcc-files'. + +\(fn FILE)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("erc-backend.el" "erc-goodies.el" "erc-ibuffer.el" +;;;;;; "erc-lang.el" "erc-maint.el" "erc-nicklist.el" "erc-pkg.el" +;;;;;; "erc-speak.el" "erc-viper.el") (18331 43828 427117)) + +;;;*** + +;;;### (autoloads nil "erc-autoaway" "erc-autoaway.el" (18331 42201)) +;;; Generated autoloads from erc-autoaway.el + (autoload 'erc-autoaway-mode "erc-autoaway") + +;;;*** diff --git a/lisp/erc-autoaway.el b/lisp/erc-autoaway.el new file mode 100644 index 0000000..d777b4e --- /dev/null +++ b/lisp/erc-autoaway.el @@ -0,0 +1,290 @@ +;;; erc-autoaway.el --- Provides autoaway for ERC + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoAway + +;; 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 3, 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: + +;; TODO: +;; - Legacy names: erc-auto-discard-away, erc-auto-set-away + +;;; Code: + +(require 'erc) + +(defgroup erc-autoaway nil + "Set yourself automatically away after some idletime and set +yourself back when you type something." + :group 'erc) + +(defvar erc-autoaway-idletimer nil + "The Emacs idletimer. +This is only used when `erc-autoaway-idle-method' is set to 'emacs.") + +(defvar erc-autoaway-last-sent-time (erc-current-time) + "The last time the user sent something.") + +(defvar erc-autoaway-caused-away nil + "Indicates whether this module was responsible for setting the +user's away status.") + +(eval-when-compile (defvar erc-autoaway-idle-seconds)) + +(defun erc-autoaway-reestablish-idletimer () + "Reestablish the Emacs idletimer. +If `erc-autoaway-idle-method' is 'emacs, you must call this +function each time you change `erc-autoaway-idle-seconds'." + (interactive) + (when erc-autoaway-idletimer + (erc-cancel-timer erc-autoaway-idletimer)) + (setq erc-autoaway-idletimer + (run-with-idle-timer erc-autoaway-idle-seconds + t + 'erc-autoaway-set-away + erc-autoaway-idle-seconds))) + +(defun erc-autoaway-some-server-buffer () + "Return some ERC server buffer if its connection is alive. +If none is found, return nil." + (car (erc-buffer-list #'erc-open-server-buffer-p))) + +(defun erc-autoaway-insinuate-maybe (&optional server &rest ignored) + "Add autoaway reset function to `post-command-hook' if at least one +ERC process is alive. + +This is used when `erc-autoaway-idle-method' is 'user." + (when (or server (erc-autoaway-some-server-buffer)) + (add-hook 'post-command-hook 'erc-autoaway-reset-idle-user))) + +(defun erc-autoaway-remove-maybe (&rest ignored) + "Remove the autoaway reset function from `post-command-hook' if +no ERC process is alive. + +This is used when `erc-autoaway-idle-method' is 'user." + (unless (erc-autoaway-some-server-buffer) + (remove-hook 'post-command-hook 'erc-autoaway-reset-idle-user))) + +;;;###autoload (autoload 'erc-autoaway-mode "erc-autoaway") +(define-erc-module autoaway nil + "In ERC autoaway mode, you can be set away automatically. +If `erc-auto-set-away' is set, then you will be set away after +the number of seconds specified in `erc-autoaway-idle-seconds'. + +There are several kinds of being idle: + +User idle time measures how long you have not been sending any +commands to Emacs. This is the default. + +Emacs idle time measures how long Emacs has been idle. This is +currently not useful, since Emacs is non-idle when it handles +ping-pong with IRC servers. See `erc-autoaway-idle-method' +for more information. + +IRC idle time measures how long since you last sent something (see +`erc-autoaway-last-sent-time'). + +If `erc-auto-discard-away' is set, then typing anything, will +set you no longer away. + +Related variables: `erc-public-away-p' and `erc-away-nickname'." + ;; Enable: + ((when (boundp 'erc-autoaway-idle-method) + (add-hook 'erc-connect-pre-hook 'erc-autoaway-reset-indicators) + (setq erc-autoaway-last-sent-time (erc-current-time)) + (cond + ((eq erc-autoaway-idle-method 'irc) + (add-hook 'erc-send-completed-hook 'erc-autoaway-reset-idle-irc) + (add-hook 'erc-server-001-functions 'erc-autoaway-reset-idle-irc)) + ((eq erc-autoaway-idle-method 'user) + (add-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe) + (add-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe) + (erc-autoaway-insinuate-maybe)) + ((eq erc-autoaway-idle-method 'emacs) + (erc-autoaway-reestablish-idletimer))) + (add-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away) + (add-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators))) + ;; Disable: + ((when (boundp 'erc-autoaway-idle-method) + (remove-hook 'erc-connect-pre-hook 'erc-autoaway-reset-indicators) + (cond + ((eq erc-autoaway-idle-method 'irc) + (remove-hook 'erc-send-completed-hook 'erc-autoaway-reset-idle-irc) + (remove-hook 'erc-server-001-functions 'erc-autoaway-reset-idle-irc)) + ((eq erc-autoaway-idle-method 'user) + (remove-hook 'post-command-hook 'erc-autoaway-reset-idle-user) + (remove-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe) + (remove-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe)) + ((eq erc-autoaway-idle-method 'emacs) + (erc-cancel-timer erc-autoaway-idletimer) + (setq erc-autoaway-idletimer nil))) + (remove-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away) + (remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators)))) + +(defcustom erc-autoaway-idle-method 'user + "*The method used to determine how long you have been idle. +If 'user, the time of the last command sent to Emacs is used. +If 'emacs, the idle time in Emacs is used. +If 'irc, the time of the last IRC command is used. + +The time itself is specified by `erc-autoaway-idle-seconds'. + +See `erc-autoaway-mode' for more information on the various +definitions of being idle." + :group 'erc-autoaway + :type '(choice (const :tag "User idle time" user) + (const :tag "Emacs idle time" emacs) + (const :tag "Last IRC action" irc)) + :set (lambda (sym val) + (if erc-autoaway-mode + (progn + (erc-autoaway-disable) + (set sym val) + (erc-autoaway-enable)) + (set sym val)))) + +(defcustom erc-auto-set-away t + "*If non-nil, set away after `erc-autoaway-idle-seconds' seconds of idling. +ERC autoaway mode can set you away when you idle, and set you no +longer away when you type something. This variable controls whether +you will be set away when you idle. See `erc-auto-discard-away' for +the other half." + :group 'erc-autoaway + :type 'boolean) + +(defcustom erc-auto-discard-away t + "*If non-nil, sending anything when away automatically discards away state. +ERC autoaway mode can set you away when you idle, and set you no +longer away when you type something. This variable controls whether +you will be set no longer away when you type something. See +`erc-auto-set-away' for the other half. +See also `erc-autoaway-no-auto-discard-regexp'." + :group 'erc-autoaway + :type 'boolean) + +(defcustom erc-autoaway-no-auto-discard-regexp "^/g?away.*$" + "*Input that matches this will not automatically discard away status. +See `erc-auto-discard-away'." + :group 'erc-autoaway + :type 'regexp) + +(defcustom erc-autoaway-idle-seconds 1800 + "*Number of seconds after which ERC will set you automatically away. +If you are changing this variable using lisp instead of customizing it, +you have to run `erc-autoaway-reestablish-idletimer' afterwards." + :group 'erc-autoaway + :set (lambda (sym val) + (set-default sym val) + (when (eq erc-autoaway-idle-method 'emacs) + (erc-autoaway-reestablish-idletimer))) + :type 'number) + +(defcustom erc-autoaway-message + "I'm gone (autoaway after %i seconds of idletime)" + "*Message ERC will use when setting you automatically away. +It is used as a `format' string with the argument of the idletime +in seconds." + :group 'erc-autoaway + :type 'string) + +(defun erc-autoaway-reset-idle-user (&rest stuff) + "Reset the stored user idle time. +This is one global variable since a user talking on one net can +talk on another net too." + (when erc-auto-discard-away + (erc-autoaway-set-back #'erc-autoaway-remove-maybe)) + (setq erc-autoaway-last-sent-time (erc-current-time))) + +(defun erc-autoaway-reset-idle-irc (line &rest stuff) + "Reset the stored IRC idle time. +This is one global variable since a user talking on one net can +talk on another net too." + (when (and erc-auto-discard-away + (stringp line) + (not (string-match erc-autoaway-no-auto-discard-regexp line))) + (erc-autoaway-set-back)) + (setq erc-autoaway-last-sent-time (erc-current-time))) + +(defun erc-autoaway-set-back (&optional none-alive-func) + "Discard the away state globally. + +NONE-ALIVE-FUNC is the function to call if no ERC processes are alive." + (let ((server-buffer (erc-autoaway-some-server-buffer))) + (if (and erc-autoaway-caused-away + (buffer-live-p server-buffer) + (with-current-buffer server-buffer erc-away)) + (erc-cmd-GAWAY "") + (when none-alive-func (funcall none-alive-func))))) + +(defun erc-autoaway-some-open-server-buffer () + "Return some ERC server buffer if its connection is alive and the +user is not away. +If none is found, return nil." + (car (erc-buffer-list (lambda () + (and (erc-open-server-buffer-p) + (not erc-away)))))) + +(defun erc-autoaway-possibly-set-away (current-time) + "Set autoaway when `erc-auto-set-away' is true and the idletime is +exceeds `erc-autoaway-idle-seconds'." + ;; A test for (erc-server-process-alive) is not necessary, because + ;; this function is called from `erc-timer-hook', which is called + ;; whenever the server sends something to the client. + (when (and erc-server-connected + erc-auto-set-away + (not erc-autoaway-caused-away) + (erc-autoaway-some-open-server-buffer)) + (let ((idle-time (erc-time-diff erc-autoaway-last-sent-time + current-time))) + (when (>= idle-time erc-autoaway-idle-seconds) + (erc-display-message + nil 'notice nil + (format "Setting automatically away after %i seconds of idle-time" + idle-time)) + (erc-autoaway-set-away idle-time t))))) + +(defun erc-autoaway-set-away (idle-time &optional notest) + "Set the away state globally. + +If NOTEST is specified, do not check to see whether there is an +activer server buffer available." + ;; Note that the idle timer runs, even when Emacs is inactive. In + ;; order to prevent flooding when we connect, we test for an + ;; existing process. + (when (or notest (erc-autoaway-some-open-server-buffer)) + (setq erc-autoaway-caused-away t) + (erc-cmd-GAWAY (format erc-autoaway-message idle-time)))) + +(defun erc-autoaway-reset-indicators (&rest stuff) + "Reset indicators used by the erc-autoaway module." + (setq erc-autoaway-last-sent-time (erc-current-time)) + (setq erc-autoaway-caused-away nil)) + +(provide 'erc-autoaway) + +;;; erc-autoaway.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 16fc241e-8358-4b56-9fe2-116bdd0ba3bc diff --git a/lisp/erc-backend.el b/lisp/erc-backend.el new file mode 100644 index 0000000..1bb3e4a --- /dev/null +++ b/lisp/erc-backend.el @@ -0,0 +1,1967 @@ +;;; erc-backend.el --- Backend network communication for ERC + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Filename: erc-backend.el +;; Author: Lawrence Mitchell +;; Created: 2004-05-7 +;; Keywords: IRC chat client internet + +;; 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 3, 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 file defines backend network communication handlers for ERC. +;; +;; How things work: +;; +;; You define a new handler with `define-erc-response-handler'. This +;; defines a function, a corresponding hook variable, and populates a +;; global hash table `erc-server-responses' with a map from response +;; to hook variable. See the function documentation for more +;; information. +;; +;; Upon receiving a line from the server, `erc-parse-server-response' +;; is called on it. +;; +;; A line generally looks like: +;; +;; LINE := ':' SENDER ' ' COMMAND ' ' (COMMAND-ARGS ' ')* ':' CONTENTS +;; SENDER := Not ':' | ' ' +;; COMMAND := Not ':' | ' ' +;; COMMAND-ARGS := Not ':' | ' ' +;; +;; This gets parsed and stuffed into an `erc-response' struct. You +;; can access the fields of the struct with: +;; +;; COMMAND --- `erc-response.command' +;; COMMAND-ARGS --- `erc-response.command-args' +;; CONTENTS --- `erc-response.contents' +;; SENDER --- `erc-response.sender' +;; LINE --- `erc-response.unparsed' +;; +;; WARNING, WARNING!! +;; It's probably not a good idea to destructively modify the list +;; of command-args in your handlers, since other functions down the +;; line may well need to access the arguments too. +;; +;; That is, unless you're /absolutely/ sure that your handler doesn't +;; invoke some other function that needs to use COMMAND-ARGS, don't do +;; something like +;; +;; (while (erc-response.command-args parsed) +;; (let ((a (pop (erc-response.command-args parsed)))) +;; ...)) +;; +;; The parsed response is handed over to +;; `erc-handle-parsed-server-response', which checks whether it should +;; carry out duplicate suppression, and then runs `erc-call-hooks'. +;; `erc-call-hooks' retrieves the relevant hook variable from +;; `erc-server-responses' and runs it. +;; +;; Most handlers then destructure the parsed response in some way +;; (depending on what the handler is, the arguments have different +;; meanings), and generally display something, usually using +;; `erc-display-message'. + +;;; TODO: + +;; o Generalise the display-line code so that we can use it to +;; display the stuff we send, as well as the stuff we receive. +;; Then, move all display-related code into another backend-like +;; file, erc-display.el, say. +;; +;; o Clean up the handlers using new display code (has to be written +;; first). + +;;; History: + +;; 2004/05/10 -- Handler bodies taken out of erc.el and ported to new +;; interface. + +;; 2005-08-13 -- Moved sending commands from erc.el. + +;;; Code: + +(require 'erc-compat) +(eval-when-compile (require 'cl)) +(autoload 'erc-with-buffer "erc" nil nil 'macro) +(autoload 'erc-log "erc" nil nil 'macro) + +;;;; Variables and options + +(defvar erc-server-responses (make-hash-table :test #'equal) + "Hashtable mapping server responses to their handler hooks.") + +(defstruct (erc-response (:conc-name erc-response.)) + (unparsed "" :type string) + (sender "" :type string) + (command "" :type string) + (command-args '() :type list) + (contents "" :type string)) + +;;; User data + +(defvar erc-server-current-nick nil + "Nickname on the current server. +Use `erc-current-nick' to access this.") +(make-variable-buffer-local 'erc-server-current-nick) + +;;; Server attributes + +(defvar erc-server-process nil + "The process object of the corresponding server connection.") +(make-variable-buffer-local 'erc-server-process) + +(defvar erc-session-server nil + "The server name used to connect to for this session.") +(make-variable-buffer-local 'erc-session-server) + +(defvar erc-session-port nil + "The port used to connect to.") +(make-variable-buffer-local 'erc-session-port) + +(defvar erc-server-announced-name nil + "The name the server announced to use.") +(make-variable-buffer-local 'erc-server-announced-name) + +(defvar erc-server-version nil + "The name and version of the server's ircd.") +(make-variable-buffer-local 'erc-server-version) + +(defvar erc-server-parameters nil + "Alist listing the supported server parameters. + +This is only set if the server sends 005 messages saying what is +supported on the server. + +Entries are of the form: + (PARAMETER . VALUE) +or + (PARAMETER) if no value is provided. + +Some examples of possible parameters sent by servers: +CHANMODES=b,k,l,imnpst - list of supported channel modes +CHANNELLEN=50 - maximum length of channel names +CHANTYPES=#&!+ - supported channel prefixes +CHARMAPPING=rfc1459 - character mapping used for nickname and channels +KICKLEN=160 - maximum allowed kick message length +MAXBANS=30 - maximum number of bans per channel +MAXCHANNELS=10 - maximum number of channels allowed to join +NETWORK=EFnet - the network identifier +NICKLEN=9 - maximum allowed length of nicknames +PREFIX=(ov)@+ - list of channel modes and the user prefixes if user has mode +RFC2812 - server supports RFC 2812 features +SILENCE=10 - supports the SILENCE command, maximum allowed number of entries +TOPICLEN=160 - maximum allowed topic length +WALLCHOPS - supports sending messages to all operators in a channel") +(make-variable-buffer-local 'erc-server-parameters) + +;;; Server and connection state + +(defvar erc-server-ping-timer-alist nil + "Mapping of server buffers to their specific ping timer.") + +(defvar erc-server-connected nil + "Non-nil if the current buffer has been used by ERC to establish +an IRC connection. + +If you wish to determine whether an IRC connection is currently +active, use the `erc-server-process-alive' function instead.") +(make-variable-buffer-local 'erc-server-connected) + +(defvar erc-server-reconnect-count 0 + "Number of times we have failed to reconnect to the current server.") +(make-variable-buffer-local 'erc-server-reconnect-count) + +(defvar erc-server-quitting nil + "Non-nil if the user requests a quit.") +(make-variable-buffer-local 'erc-server-quitting) + +(defvar erc-server-reconnecting nil + "Non-nil if the user requests an explicit reconnect, and the +current IRC process is still alive.") +(make-variable-buffer-local 'erc-server-reconnecting) + +(defvar erc-server-timed-out nil + "Non-nil if the IRC server failed to respond to a ping.") +(make-variable-buffer-local 'erc-server-timed-out) + +(defvar erc-server-banned nil + "Non-nil if the user is denied access because of a server ban.") +(make-variable-buffer-local 'erc-server-banned) + +(defvar erc-server-error-occurred nil + "Non-nil if the user triggers some server error.") +(make-variable-buffer-local 'erc-server-error-occurred) + +(defvar erc-server-lines-sent nil + "Line counter.") +(make-variable-buffer-local 'erc-server-lines-sent) + +(defvar erc-server-last-peers '(nil . nil) + "Last peers used, both sender and receiver. +Those are used for /MSG destination shortcuts.") +(make-variable-buffer-local 'erc-server-last-peers) + +(defvar erc-server-last-sent-time nil + "Time the message was sent. +This is useful for flood protection.") +(make-variable-buffer-local 'erc-server-last-sent-time) + +(defvar erc-server-last-ping-time nil + "Time the last ping was sent. +This is useful for flood protection.") +(make-variable-buffer-local 'erc-server-last-ping-time) + +(defvar erc-server-last-received-time nil + "Time the last message was received from the server. +This is useful for detecting hung connections.") +(make-variable-buffer-local 'erc-server-last-received-time) + +(defvar erc-server-lag nil + "Calculated server lag time in seconds. +This variable is only set in a server buffer.") +(make-variable-buffer-local 'erc-server-lag) + +(defvar erc-server-filter-data nil + "The data that arrived from the server +but has not been processed yet.") +(make-variable-buffer-local 'erc-server-filter-data) + +(defvar erc-server-duplicates (make-hash-table :test 'equal) + "Internal variable used to track duplicate messages.") +(make-variable-buffer-local 'erc-server-duplicates) + +;; From Circe +(defvar erc-server-processing-p nil + "Non-nil when we're currently processing a message. + +When ERC receives a private message, it sets up a new buffer for +this query. These in turn, though, do start flyspell. This +involves starting an external process, in which case Emacs will +wait - and when it waits, it does accept other stuff from, say, +network exceptions. So, if someone sends you two messages +quickly after each other, ispell is started for the first, but +might take long enough for the second message to be processed +first.") +(make-variable-buffer-local 'erc-server-processing-p) + +(defvar erc-server-flood-last-message 0 + "When we sent the last message. +See `erc-server-flood-margin' for an explanation of the flood +protection algorithm.") +(make-variable-buffer-local 'erc-server-flood-last-message) + +(defvar erc-server-flood-queue nil + "The queue of messages waiting to be sent to the server. +See `erc-server-flood-margin' for an explanation of the flood +protection algorithm.") +(make-variable-buffer-local 'erc-server-flood-queue) + +(defvar erc-server-flood-timer nil + "The timer to resume sending.") +(make-variable-buffer-local 'erc-server-flood-timer) + +;;; IRC protocol and misc options + +(defgroup erc-server nil + "Parameters for dealing with IRC servers." + :group 'erc) + +(defcustom erc-server-auto-reconnect t + "Non-nil means that ERC will attempt to reestablish broken connections. + +Reconnection will happen automatically for any unexpected disconnection." + :group 'erc-server + :type 'boolean) + +(defcustom erc-server-reconnect-attempts 2 + "The number of times that ERC will attempt to reestablish a +broken connection, or t to always attempt to reconnect. + +This only has an effect if `erc-server-auto-reconnect' is non-nil." + :group 'erc-server + :type '(choice (const :tag "Always reconnect" t) + integer)) + +(defcustom erc-server-reconnect-timeout 1 + "The amount of time, in seconds, that ERC will wait between +successive reconnect attempts. + +If a key is pressed while ERC is waiting, it will stop waiting." + :group 'erc-server + :type 'number) + +(defcustom erc-split-line-length 440 + "*The maximum length of a single message. +If a message exceeds this size, it is broken into multiple ones. + +IRC allows for lines up to 512 bytes. Two of them are CR LF. +And a typical message looks like this: + + :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello! + +You can limit here the maximum length of the \"Hello!\" part. +Good luck." + :type 'integer + :group 'erc-server) + +(defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p) + (coding-system-p 'undecided) + (coding-system-p 'utf-8)) + '(utf-8 . undecided) + nil) + "The default coding system for incoming and outgoing text. +This is either a coding system, a cons, a function, or nil. + +If a cons, the encoding system for outgoing text is in the car +and the decoding system for incoming text is in the cdr. The most +interesting use for this is to put `undecided' in the cdr. + +If a function, it is called with the argument `target' and should +return a coding system or a cons as described above. + +If you need to send non-ASCII text to people not using a client that +does decoding on its own, you must tell ERC what encoding to use. +Emacs cannot guess it, since it does not know what the people on the +other end of the line are using." + :group 'erc-server + :type '(choice (const :tag "None" nil) + coding-system + (cons (coding-system :tag "encoding" :value utf-8) + (coding-system :tag "decoding" :value undecided)) + function)) + +(defcustom erc-encoding-coding-alist nil + "Alist of target regexp and coding-system pairs to use. +This overrides `erc-server-coding-system' depending on the +current target as returned by `erc-default-target'. + +Example: If you know that the channel #linux-ru uses the coding-system +`cyrillic-koi8', then add '(\"#linux-ru\" . cyrillic-koi8) to the +alist." + :group 'erc-server + :type '(repeat (cons (string :tag "Target") + coding-system))) + +(defcustom erc-server-connect-function 'open-network-stream + "Function used to initiate a connection. +It should take same arguments as `open-network-stream' does." + :group 'erc-server + :type 'function) + +(defcustom erc-server-prevent-duplicates '("301") + "*Either nil or a list of strings. +Each string is a IRC message type, like PRIVMSG or NOTICE. +All Message types in that list of subjected to duplicate prevention." + :type '(choice (const nil) (list string)) + :group 'erc-server) + +(defcustom erc-server-duplicate-timeout 60 + "*The time allowed in seconds between duplicate messages. + +If two identical messages arrive within this value of one another, the second +isn't displayed." + :type 'integer + :group 'erc-server) + +;;; Flood-related + +;; Most of this is courtesy of Jorgen Schaefer and Circe +;; (http://www.nongnu.org/circe) + +(defcustom erc-server-flood-margin 10 + "*A margin on how much excess data we send. +The flood protection algorithm of ERC works like the one +detailed in RFC 2813, section 5.8 \"Flood control of clients\". + + * If `erc-server-flood-last-message' is less than the current + time, set it equal. + * While `erc-server-flood-last-message' is less than + `erc-server-flood-margin' seconds ahead of the current + time, send a message, and increase + `erc-server-flood-last-message' by + `erc-server-flood-penalty' for each message." + :type 'integer + :group 'erc-server) + +(defcustom erc-server-flood-penalty 3 + "How much we penalize a message. +See `erc-server-flood-margin' for an explanation of the flood +protection algorithm." + :type 'integer + :group 'erc-server) + +;; Ping handling + +(defcustom erc-server-send-ping-interval 30 + "*Interval of sending pings to the server, in seconds. +If this is set to nil, pinging the server is disabled." + :group 'erc-server + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defcustom erc-server-send-ping-timeout 120 + "*If the time between ping and response is greater than this, reconnect. +The time is in seconds. + +This must be greater than or equal to the value for +`erc-server-send-ping-interval'. + +If this is set to nil, never try to reconnect." + :group 'erc-server + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defvar erc-server-ping-handler nil + "This variable holds the periodic ping timer.") +(make-variable-buffer-local 'erc-server-ping-handler) + +;;;; Helper functions + +;; From Circe +(defun erc-split-line (longline) + "Return a list of lines which are not too long for IRC. +The length is specified in `erc-split-line-length'. + +Currently this is called by `erc-send-input'." + (if (< (length longline) + erc-split-line-length) + (list longline) + (with-temp-buffer + (insert longline) + (let ((fill-column erc-split-line-length)) + (fill-region (point-min) (point-max) + nil t)) + (split-string (buffer-string) "\n")))) + +;; Used by CTCP functions +(defun erc-upcase-first-word (str) + "Upcase the first word in STR." + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (upcase-word 1) + (buffer-string))) + +(defun erc-server-setup-periodical-ping (buffer) + "Set up a timer to periodically ping the current server. +The current buffer is given by BUFFER." + (with-current-buffer buffer + (and erc-server-ping-handler (erc-cancel-timer erc-server-ping-handler)) + (when erc-server-send-ping-interval + (setq erc-server-ping-handler (run-with-timer + 4 erc-server-send-ping-interval + #'erc-server-send-ping + buffer)) + (setq erc-server-ping-timer-alist (cons (cons buffer + erc-server-ping-handler) + erc-server-ping-timer-alist))))) + +(defun erc-server-process-alive () + "Return non-nil when `erc-server-process' is open or running." + (and erc-server-process + (processp erc-server-process) + (memq (process-status erc-server-process) '(run open)))) + +;;;; Connecting to a server + +(defun erc-server-connect (server port buffer) + "Perform the connection and login using the specified SERVER and PORT. +We will store server variables in the buffer given by BUFFER." + (let ((msg (erc-format-message 'connect ?S server ?p port))) + (message "%s" msg) + (let ((process (funcall erc-server-connect-function + (format "erc-%s-%s" server port) + nil server port))) + (unless (processp process) + (error "Connection attempt failed")) + (message "%s...done" msg) + ;; Misc server variables + (with-current-buffer buffer + (setq erc-server-process process) + (setq erc-server-quitting nil) + (setq erc-server-reconnecting nil) + (setq erc-server-timed-out nil) + (setq erc-server-banned nil) + (setq erc-server-error-occurred nil) + (let ((time (erc-current-time))) + (setq erc-server-last-sent-time time) + (setq erc-server-last-ping-time time) + (setq erc-server-last-received-time time)) + (setq erc-server-lines-sent 0) + ;; last peers (sender and receiver) + (setq erc-server-last-peers '(nil . nil))) + ;; we do our own encoding and decoding + (when (fboundp 'set-process-coding-system) + (set-process-coding-system process 'raw-text)) + ;; process handlers + (set-process-sentinel process 'erc-process-sentinel) + (set-process-filter process 'erc-server-filter-function) + (set-process-buffer process buffer))) + (erc-log "\n\n\n********************************************\n") + (message "%s" (erc-format-message + 'login ?n + (with-current-buffer buffer (erc-current-nick)))) + ;; wait with script loading until we receive a confirmation (first + ;; MOTD line) + (if (eq erc-server-connect-function 'open-network-stream-nowait) + ;; it's a bit unclear otherwise that it's attempting to establish a + ;; connection + (erc-display-message nil nil buffer "Opening connection..\n") + (erc-login))) + +(defun erc-server-reconnect () +"Reestablish the current IRC connection. +Make sure you are in an ERC buffer when running this." + (let ((buffer (erc-server-buffer))) + (unless (buffer-live-p buffer) + (if (eq major-mode 'erc-mode) + (setq buffer (current-buffer)) + (error "Reconnect must be run from an ERC buffer"))) + (with-current-buffer buffer + (erc-update-mode-line) + (erc-set-active-buffer (current-buffer)) + (setq erc-server-last-sent-time 0) + (setq erc-server-lines-sent 0) + (erc-open erc-session-server erc-session-port erc-server-current-nick + erc-session-user-full-name t erc-session-password)))) + +(defun erc-server-filter-function (process string) + "The process filter for the ERC server." + (with-current-buffer (process-buffer process) + (setq erc-server-last-received-time (erc-current-time)) + ;; If you think this is written in a weird way - please refer to the + ;; docstring of `erc-server-processing-p' + (if erc-server-processing-p + (setq erc-server-filter-data + (if erc-server-filter-data + (concat erc-server-filter-data string) + string)) + ;; This will be true even if another process is spawned! + (let ((erc-server-processing-p t)) + (setq erc-server-filter-data (if erc-server-filter-data + (concat erc-server-filter-data + string) + string)) + (while (and erc-server-filter-data + (string-match "[\n\r]+" erc-server-filter-data)) + (let ((line (substring erc-server-filter-data + 0 (match-beginning 0)))) + (setq erc-server-filter-data + (if (= (match-end 0) + (length erc-server-filter-data)) + nil + (substring erc-server-filter-data + (match-end 0)))) + (erc-parse-server-response process line))))))) + +(defsubst erc-server-reconnect-p (event) + "Return non-nil if ERC should attempt to reconnect automatically. +EVENT is the message received from the closed connection process." + (or erc-server-reconnecting + (and erc-server-auto-reconnect + (not erc-server-banned) + (not erc-server-error-occurred) + ;; make sure we don't infinitely try to reconnect, unless the + ;; user wants that + (or (eq erc-server-reconnect-attempts t) + (and (integerp erc-server-reconnect-attempts) + (< erc-server-reconnect-count + erc-server-reconnect-attempts))) + (or erc-server-timed-out + (not (string-match "^deleted" event))) + ;; open-network-stream-nowait error for connection refused + (not (string-match "^failed with code 111" event))))) + +(defun erc-process-sentinel-2 (event buffer) + "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." + (if (not (buffer-live-p buffer)) + (erc-update-mode-line) + (with-current-buffer buffer + (let ((reconnect-p (erc-server-reconnect-p event))) + (erc-display-message nil 'error (current-buffer) + (if reconnect-p 'disconnected + 'disconnected-noreconnect)) + (if (not reconnect-p) + ;; terminate, do not reconnect + (progn + (erc-display-message nil 'error (current-buffer) + 'terminated ?e event) + ;; Update mode line indicators + (erc-update-mode-line) + (set-buffer-modified-p nil)) + ;; reconnect + (condition-case err + (progn + (setq erc-server-reconnecting nil) + (erc-server-reconnect) + (setq erc-server-reconnect-count 0)) + (error (when (buffer-live-p buffer) + (set-buffer buffer) + (if (integerp erc-server-reconnect-attempts) + (setq erc-server-reconnect-count + (1+ erc-server-reconnect-count)) + (message "%s ... %s" + "Reconnecting until we succeed" + "kill the ERC server buffer to stop")) + (if (numberp erc-server-reconnect-timeout) + (run-at-time erc-server-reconnect-timeout nil + #'erc-process-sentinel-2 + event buffer) + (error (concat "`erc-server-reconnect-timeout`" + " must be a number"))))))))))) + +(defun erc-process-sentinel-1 (event buffer) + "Called when `erc-process-sentinel' has decided that we're disconnecting. +Determine whether user has quit or whether erc has been terminated. +Conditionally try to reconnect and take appropriate action." + (with-current-buffer buffer + (if erc-server-quitting + ;; normal quit + (progn + (erc-display-message nil 'error (current-buffer) 'finished) + ;; Update mode line indicators + (erc-update-mode-line) + ;; Kill server buffer if user wants it + (set-buffer-modified-p nil) + (when erc-kill-server-buffer-on-quit + (kill-buffer (current-buffer)))) + ;; unexpected disconnect + (erc-process-sentinel-2 event buffer)))) + +(defun erc-process-sentinel (cproc event) + "Sentinel function for ERC process." + (with-current-buffer (process-buffer cproc) + (erc-log (format + "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" + cproc (process-status cproc) event erc-server-quitting)) + (if (string-match "^open" event) + ;; newly opened connection (no wait) + (erc-login) + ;; assume event is 'failed + (let ((buf (process-buffer cproc))) + (erc-with-all-buffers-of-server cproc nil + (setq erc-server-connected nil)) + (when erc-server-ping-handler + (progn (erc-cancel-timer erc-server-ping-handler) + (setq erc-server-ping-handler nil))) + (run-hook-with-args 'erc-disconnected-hook + (erc-current-nick) (system-name) "") + ;; Remove the prompt + (goto-char (or (marker-position erc-input-marker) (point-max))) + (forward-line 0) + (erc-remove-text-properties-region (point) (point-max)) + (delete-region (point) (point-max)) + ;; Decide what to do with the buffer + ;; Restart if disconnected + (erc-process-sentinel-1 event buf))))) + +;;;; Sending messages + +(defun erc-coding-system-for-target (target) + "Return the coding system or cons cell appropriate for TARGET. +This is determined via `erc-encoding-coding-alist' or +`erc-server-coding-system'." + (unless target (setq target (erc-default-target))) + (or (when target + (let ((case-fold-search t)) + (catch 'match + (dolist (pat erc-encoding-coding-alist) + (when (string-match (car pat) target) + (throw 'match (cdr pat))))))) + (and (functionp erc-server-coding-system) + (funcall erc-server-coding-system target)) + erc-server-coding-system)) + +(defun erc-decode-string-from-target (str target) + "Decode STR as appropriate for TARGET. +This is indicated by `erc-encoding-coding-alist', defaulting to the value of +`erc-server-coding-system'." + (unless (stringp str) + (setq str "")) + (let ((coding (erc-coding-system-for-target target))) + (when (consp coding) + (setq coding (cdr coding))) + (erc-decode-coding-string str coding))) + +;; proposed name, not used by anything yet +(defun erc-send-line (text display-fn) + "Send TEXT to the current server. Wrapping and flood control apply. +Use DISPLAY-FN to show the results." + (mapc (lambda (line) + (erc-server-send line) + (funcall display-fn)) + (erc-split-line text))) + +;; From Circe, with modifications +(defun erc-server-send (string &optional forcep target) + "Send STRING to the current server. +If FORCEP is non-nil, no flood protection is done - the string is +sent directly. This might cause the messages to arrive in a wrong +order. + +If TARGET is specified, look up encoding information for that +channel in `erc-encoding-coding-alist' or +`erc-server-coding-system'. + +See `erc-server-flood-margin' for an explanation of the flood +protection algorithm." + (erc-log (concat "erc-server-send: " string "(" (buffer-name) ")")) + (setq erc-server-last-sent-time (erc-current-time)) + (let ((encoding (erc-coding-system-for-target target))) + (when (consp encoding) + (setq encoding (car encoding))) + (if (erc-server-process-alive) + (erc-with-server-buffer + (let ((str (concat string "\r\n"))) + (if forcep + (progn + (setq erc-server-flood-last-message + (+ erc-server-flood-penalty + erc-server-flood-last-message)) + (erc-log-irc-protocol str 'outbound) + (condition-case err + (progn + ;; Set encoding just before sending the string + (when (fboundp 'set-process-coding-system) + (set-process-coding-system erc-server-process + 'raw-text encoding)) + (process-send-string erc-server-process str)) + ;; See `erc-server-send-queue' for full + ;; explanation of why we need this condition-case + (error nil))) + (setq erc-server-flood-queue + (append erc-server-flood-queue + (list (cons str encoding)))) + (erc-server-send-queue (current-buffer)))) + t) + (message "ERC: No process running") + nil))) + +(defun erc-server-send-ping (buf) + "Send a ping to the IRC server buffer in BUF. +Additionally, detect whether the IRC process has hung." + (if (buffer-live-p buf) + (with-current-buffer buf + (if (and erc-server-send-ping-timeout + (> + (erc-time-diff (erc-current-time) + erc-server-last-received-time) + erc-server-send-ping-timeout)) + (progn + ;; if the process is hung, kill it + (setq erc-server-timed-out t) + (delete-process erc-server-process)) + (erc-server-send (format "PING %.0f" (erc-current-time))))) + ;; remove timer if the server buffer has been killed + (let ((timer (assq buf erc-server-ping-timer-alist))) + (when timer + (erc-cancel-timer (cdr timer)) + (setcdr timer nil))))) + +;; From Circe +(defun erc-server-send-queue (buffer) + "Send messages in `erc-server-flood-queue'. +See `erc-server-flood-margin' for an explanation of the flood +protection algorithm." + (with-current-buffer buffer + (let ((now (erc-current-time))) + (when erc-server-flood-timer + (erc-cancel-timer erc-server-flood-timer) + (setq erc-server-flood-timer nil)) + (when (< erc-server-flood-last-message + now) + (setq erc-server-flood-last-message now)) + (while (and erc-server-flood-queue + (< erc-server-flood-last-message + (+ now erc-server-flood-margin))) + (let ((msg (caar erc-server-flood-queue)) + (encoding (cdar erc-server-flood-queue))) + (setq erc-server-flood-queue (cdr erc-server-flood-queue) + erc-server-flood-last-message + (+ erc-server-flood-last-message + erc-server-flood-penalty)) + (erc-log-irc-protocol msg 'outbound) + (erc-log (concat "erc-server-send-queue: " + msg "(" (buffer-name buffer) ")")) + (when (erc-server-process-alive) + (condition-case err + ;; Set encoding just before sending the string + (progn + (when (fboundp 'set-process-coding-system) + (set-process-coding-system erc-server-process + 'raw-text encoding)) + (process-send-string erc-server-process msg)) + ;; Sometimes the send can occur while the process is + ;; being killed, which results in a weird SIGPIPE error. + ;; Catch this and ignore it. + (error nil))))) + (when erc-server-flood-queue + (setq erc-server-flood-timer + (run-at-time (+ 0.2 erc-server-flood-penalty) + nil #'erc-server-send-queue buffer)))))) + +(defun erc-message (message-command line &optional force) + "Send LINE to the server as a privmsg or a notice. +MESSAGE-COMMAND should be either \"PRIVMSG\" or \"NOTICE\". +If the target is \",\", the last person you've got a message from will +be used. If the target is \".\", the last person you've sent a message +to will be used." + (cond + ((string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line) + (let ((tgt (match-string 1 line)) + (s (match-string 2 line))) + (erc-log (format "cmd: MSG(%s): [%s] %s" message-command tgt s)) + (cond + ((string= tgt ",") + (if (car erc-server-last-peers) + (setq tgt (car erc-server-last-peers)) + (setq tgt nil))) + ((string= tgt ".") + (if (cdr erc-server-last-peers) + (setq tgt (cdr erc-server-last-peers)) + (setq tgt nil)))) + (cond + (tgt + (setcdr erc-server-last-peers tgt) + (erc-server-send (format "%s %s :%s" message-command tgt s) + force)) + (t + (erc-display-message nil 'error (current-buffer) 'no-target)))) + t) + (t nil))) + +;;; CTCP + +(defun erc-send-ctcp-message (tgt l &optional force) + "Send CTCP message L to TGT. + +If TGT is nil the message is not sent. +The command must contain neither a prefix nor a trailing `\\n'. + +See also `erc-server-send'." + (let ((l (erc-upcase-first-word l))) + (cond + (tgt + (erc-log (format "erc-send-CTCP-message: [%s] %s" tgt l)) + (erc-server-send (format "PRIVMSG %s :\C-a%s\C-a" tgt l) + force))))) + +(defun erc-send-ctcp-notice (tgt l &optional force) + "Send CTCP notice L to TGT. + +If TGT is nil the message is not sent. +The command must contain neither a prefix nor a trailing `\\n'. + +See also `erc-server-send'." + (let ((l (erc-upcase-first-word l))) + (cond + (tgt + (erc-log (format "erc-send-CTCP-notice: [%s] %s" tgt l)) + (erc-server-send (format "NOTICE %s :\C-a%s\C-a" tgt l) + force))))) + +;;;; Handling responses + +(defun erc-parse-server-response (proc string) + "Parse and act upon a complete line from an IRC server. +PROC is the process (connection) from which STRING was received. +PROCs `process-buffer' is `current-buffer' when this function is called." + (unless (string= string "") ;; Ignore empty strings + (save-match-data + (let ((posn (if (eq (aref string 0) ?:) + (string-match " " string) + 0)) + (msg (make-erc-response :unparsed string))) + + (setf (erc-response.sender msg) + (if (eq posn 0) + erc-session-server + (substring string 1 posn))) + + (setf (erc-response.command msg) + (let* ((bposn (string-match "[^ \n]" string posn)) + (eposn (string-match " " string bposn))) + (setq posn (and eposn + (string-match "[^ \n]" string eposn))) + (substring string bposn eposn))) + + (while (and posn + (not (eq (aref string posn) ?:))) + (push (let* ((bposn posn) + (eposn (string-match " " string bposn))) + (setq posn (and eposn + (string-match "[^ \n]" string eposn))) + (substring string bposn eposn)) + (erc-response.command-args msg))) + (when posn + (let ((str (substring string (1+ posn)))) + (push str (erc-response.command-args msg)))) + + (setf (erc-response.contents msg) + (first (erc-response.command-args msg))) + + (setf (erc-response.command-args msg) + (nreverse (erc-response.command-args msg))) + + (erc-decode-parsed-server-response msg) + + (erc-handle-parsed-server-response proc msg))))) + +(defun erc-decode-parsed-server-response (parsed-response) + "Decode a pre-parsed PARSED-RESPONSE before it can be handled. + +If there is a channel name in `erc-response.command-args', decode +`erc-response' according to this channel name and +`erc-encoding-coding-alist', or use `erc-server-coding-system' +for decoding." + (let ((args (erc-response.command-args parsed-response)) + (decode-target nil) + (decoded-args ())) + (dolist (arg args nil) + (when (string-match "^[#&].*" arg) + (setq decode-target arg))) + (when (stringp decode-target) + (setq decode-target (erc-decode-string-from-target decode-target nil))) + (setf (erc-response.unparsed parsed-response) + (erc-decode-string-from-target + (erc-response.unparsed parsed-response) + decode-target)) + (setf (erc-response.sender parsed-response) + (erc-decode-string-from-target + (erc-response.sender parsed-response) + decode-target)) + (setf (erc-response.command parsed-response) + (erc-decode-string-from-target + (erc-response.command parsed-response) + decode-target)) + (dolist (arg (nreverse args) nil) + (push (erc-decode-string-from-target arg decode-target) + decoded-args)) + (setf (erc-response.command-args parsed-response) decoded-args) + (setf (erc-response.contents parsed-response) + (erc-decode-string-from-target + (erc-response.contents parsed-response) + decode-target)))) + +(defun erc-handle-parsed-server-response (process parsed-response) + "Handle a pre-parsed PARSED-RESPONSE from PROCESS. + +Hands off to helper functions via `erc-call-hooks'." + (if (member (erc-response.command parsed-response) + erc-server-prevent-duplicates) + (let ((m (erc-response.unparsed parsed-response))) + ;; duplicate supression + (if (< (or (gethash m erc-server-duplicates) 0) + (- (erc-current-time) erc-server-duplicate-timeout)) + (erc-call-hooks process parsed-response)) + (puthash m (erc-current-time) erc-server-duplicates)) + ;; Hand off to the relevant handler. + (erc-call-hooks process parsed-response))) + +(defun erc-get-hook (command) + "Return the hook variable associated with COMMAND. + +See also `erc-server-responses'." + (gethash (format (if (numberp command) "%03i" "%s") command) + erc-server-responses)) + +(defun erc-call-hooks (process message) + "Call hooks associated with MESSAGE in PROCESS. + +Finds hooks by looking in the `erc-server-responses' hashtable." + (let ((hook (or (erc-get-hook (erc-response.command message)) + 'erc-default-server-functions))) + (run-hook-with-args-until-success hook process message) + (erc-with-server-buffer + (run-hook-with-args 'erc-timer-hook (erc-current-time))))) + +(add-hook 'erc-default-server-functions 'erc-handle-unknown-server-response) + +(defun erc-handle-unknown-server-response (proc parsed) + "Display unknown server response's message." + (let ((line (concat (erc-response.sender parsed) + " " + (erc-response.command parsed) + " " + (mapconcat 'identity (erc-response.command-args parsed) + " ")))) + (erc-display-message parsed 'notice proc line))) + + +(put 'define-erc-response-handler 'edebug-form-spec + '(&define :name erc-response-handler + (name &rest name) + &optional sexp sexp def-body)) + +(defmacro* define-erc-response-handler ((name &rest aliases) + &optional extra-fn-doc extra-var-doc + &rest fn-body) + "Define an ERC handler hook/function pair. +NAME is the response name as sent by the server (see the IRC RFC for +meanings). + +This creates: + - a hook variable `erc-server-NAME-functions' initialized to `erc-server-NAME'. + - a function `erc-server-NAME' with body FN-BODY. + +If ALIASES is non-nil, each alias in ALIASES is `defalias'ed to +`erc-server-NAME'. +Alias hook variables are created as `erc-server-ALIAS-functions' and +initialized to the same default value as `erc-server-NAME-functions'. + +FN-BODY is the body of `erc-server-NAME' it may refer to the two +function arguments PROC and PARSED. + +If EXTRA-FN-DOC is non-nil, it is inserted at the beginning of the +defined function's docstring. + +If EXTRA-VAR-DOC is non-nil, it is inserted at the beginning of the +defined variable's docstring. + +As an example: + + (define-erc-response-handler (311 WHOIS WI) + \"Some non-generic function documentation.\" + \"Some non-generic variable documentation.\" + (do-stuff-with-whois proc parsed)) + +Would expand to: + + (prog2 + (defvar erc-server-311-functions 'erc-server-311 + \"Some non-generic variable documentation. + + Hook called upon receiving a 311 server response. + Each function is called with two arguments, the process associated + with the response and the parsed response. + See also `erc-server-311'.\") + + (defun erc-server-311 (proc parsed) + \"Some non-generic function documentation. + + Handler for a 311 server response. + PROC is the server process which returned the response. + PARSED is the actual response as an `erc-response' struct. + If you want to add responses don't modify this function, but rather + add things to `erc-server-311-functions' instead.\" + (do-stuff-with-whois proc parsed)) + + (puthash \"311\" 'erc-server-311-functions erc-server-responses) + (puthash \"WHOIS\" 'erc-server-WHOIS-functions erc-server-responses) + (puthash \"WI\" 'erc-server-WI-functions erc-server-responses) + + (defalias 'erc-server-WHOIS 'erc-server-311) + (defvar erc-server-WHOIS-functions 'erc-server-311 + \"Some non-generic variable documentation. + + Hook called upon receiving a WHOIS server response. + + Each function is called with two arguments, the process associated + with the response and the parsed response. If the function returns + non-nil, stop processing the hook. Otherwise, continue. + + See also `erc-server-311'.\") + + (defalias 'erc-server-WI 'erc-server-311) + (defvar erc-server-WI-functions 'erc-server-311 + \"Some non-generic variable documentation. + + Hook called upon receiving a WI server response. + Each function is called with two arguments, the process associated + with the response and the parsed response. If the function returns + non-nil, stop processing the hook. Otherwise, continue. + + See also `erc-server-311'.\")) + +\(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)" + (if (numberp name) (setq name (intern (format "%03i" name)))) + (setq aliases (mapcar (lambda (a) + (if (numberp a) + (format "%03i" a) + a)) + aliases)) + (let* ((hook-name (intern (format "erc-server-%s-functions" name))) + (fn-name (intern (format "erc-server-%s" name))) + (hook-doc (format "%sHook called upon receiving a %%s server response. +Each function is called with two arguments, the process associated +with the response and the parsed response. If the function returns +non-nil, stop processing the hook. Otherwise, continue. + +See also `%s'." + (if extra-var-doc + (concat extra-var-doc "\n\n") + "") + fn-name)) + (fn-doc (format "%sHandler for a %s server response. +PROC is the server process which returned the response. +PARSED is the actual response as an `erc-response' struct. +If you want to add responses don't modify this function, but rather +add things to `%s' instead." + (if extra-fn-doc + (concat extra-fn-doc "\n\n") + "") + name hook-name)) + (fn-alternates + (loop for alias in aliases + collect (intern (format "erc-server-%s" alias)))) + (var-alternates + (loop for alias in aliases + collect (intern (format "erc-server-%s-functions" alias))))) + `(prog2 + ;; Normal hook variable. + (defvar ,hook-name ',fn-name ,(format hook-doc name)) + ;; Handler function + (defun ,fn-name (proc parsed) + ,fn-doc + ,@fn-body) + + ;; Make find-function and find-variable find them + (put ',fn-name 'definition-name ',name) + (put ',hook-name 'definition-name ',name) + + ;; Hashtable map of responses to hook variables + ,@(loop for response in (cons name aliases) + for var in (cons hook-name var-alternates) + collect `(puthash ,(format "%s" response) ',var + erc-server-responses)) + ;; Alternates. + ;; Functions are defaliased, hook variables are defvared so we + ;; can add hooks to one alias, but not another. + ,@(loop for fn in fn-alternates + for var in var-alternates + for a in aliases + nconc (list `(defalias ',fn ',fn-name) + `(defvar ,var ',fn-name ,(format hook-doc a)) + `(put ',var 'definition-name ',hook-name)))))) + +(define-erc-response-handler (ERROR) + "Handle an ERROR command from the server." nil + (setq erc-server-error-occurred t) + (erc-display-message + parsed 'error nil 'ERROR + ?s (erc-response.sender parsed) ?c (erc-response.contents parsed))) + +(define-erc-response-handler (INVITE) + "Handle invitation messages." + nil + (let ((target (first (erc-response.command-args parsed))) + (chnl (erc-response.contents parsed))) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (setq erc-invitation chnl) + (when (string= target (erc-current-nick)) + (erc-display-message + parsed 'notice 'active + 'INVITE ?n nick ?u login ?h host ?c chnl))))) + + +(define-erc-response-handler (JOIN) + "Handle join messages." + nil + (let ((chnl (erc-response.contents parsed)) + (buffer nil)) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + ;; strip the stupid combined JOIN facility (IRC 2.9) + (if (string-match "^\\(.*\\)?\^g.*$" chnl) + (setq chnl (match-string 1 chnl))) + (save-excursion + (let* ((str (cond + ;; If I have joined a channel + ((erc-current-nick-p nick) + (setq buffer (erc-open erc-session-server erc-session-port + nick erc-session-user-full-name + nil nil + erc-default-recipients chnl + erc-server-process)) + (when buffer + (set-buffer buffer) + (erc-add-default-channel chnl) + (erc-server-send (format "MODE %s" chnl))) + (erc-with-buffer (chnl proc) + (erc-channel-begin-receiving-names)) + (erc-update-mode-line) + (run-hooks 'erc-join-hook) + (erc-make-notice + (erc-format-message 'JOIN-you ?c chnl))) + (t + (setq buffer (erc-get-buffer chnl proc)) + (erc-make-notice + (erc-format-message + 'JOIN ?n nick ?u login ?h host ?c chnl)))))) + (when buffer (set-buffer buffer)) + (erc-update-channel-member chnl nick nick t nil nil host login) + ;; on join, we want to stay in the new channel buffer + ;;(set-buffer ob) + (erc-display-message parsed nil buffer str)))))) + +(define-erc-response-handler (KICK) + "Handle kick messages received from the server." nil + (let* ((ch (first (erc-response.command-args parsed))) + (tgt (second (erc-response.command-args parsed))) + (reason (erc-trim-string (erc-response.contents parsed))) + (buffer (erc-get-buffer ch proc))) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (erc-remove-channel-member buffer tgt) + (cond + ((string= tgt (erc-current-nick)) + (erc-display-message + parsed 'notice buffer + 'KICK-you ?n nick ?u login ?h host ?c ch ?r reason) + (run-hook-with-args 'erc-kick-hook buffer) + (erc-with-buffer + (buffer) + (erc-remove-channel-users)) + (erc-delete-default-channel ch buffer) + (erc-update-mode-line buffer)) + ((string= nick (erc-current-nick)) + (erc-display-message + parsed 'notice buffer + 'KICK-by-you ?k tgt ?c ch ?r reason)) + (t (erc-display-message + parsed 'notice buffer + 'KICK ?k tgt ?n nick ?u login ?h host ?c ch ?r reason)))))) + +(define-erc-response-handler (MODE) + "Handle server mode changes." nil + (let ((tgt (first (erc-response.command-args parsed))) + (mode (mapconcat 'identity (cdr (erc-response.command-args parsed)) + " "))) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (erc-log (format "MODE: %s -> %s: %s" nick tgt mode)) + ;; dirty hack + (let ((buf (cond ((erc-channel-p tgt) + (erc-get-buffer tgt proc)) + ((string= tgt (erc-current-nick)) nil) + ((erc-active-buffer) (erc-active-buffer)) + (t (erc-get-buffer tgt))))) + (with-current-buffer (or buf + (current-buffer)) + (erc-update-modes tgt mode nick host login)) + (if (or (string= login "") (string= host "")) + (erc-display-message parsed 'notice buf + 'MODE-nick ?n nick + ?t tgt ?m mode) + (erc-display-message parsed 'notice buf + 'MODE ?n nick ?u login + ?h host ?t tgt ?m mode))) + (erc-banlist-update proc parsed)))) + +(define-erc-response-handler (NICK) + "Handle nick change messages." nil + (let ((nn (erc-response.contents parsed)) + bufs) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (setq bufs (erc-buffer-list-with-nick nick proc)) + (erc-log (format "NICK: %s -> %s" nick nn)) + ;; if we had a query with this user, make sure future messages will be + ;; sent to the correct nick. also add to bufs, since the user will want + ;; to see the nick change in the query, and if it's a newly begun query, + ;; erc-channel-users won't contain it + (erc-buffer-filter + (lambda () + (when (equal (erc-default-target) nick) + (setq erc-default-recipients + (cons nn (cdr erc-default-recipients))) + (rename-buffer nn) + (erc-update-mode-line) + (add-to-list 'bufs (current-buffer))))) + (erc-update-user-nick nick nn host nil nil login) + (cond + ((string= nick (erc-current-nick)) + (add-to-list 'bufs (erc-server-buffer)) + (erc-set-current-nick nn) + (erc-update-mode-line) + (setq erc-nick-change-attempt-count 0) + (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) + (erc-display-message + parsed 'notice bufs + 'NICK-you ?n nick ?N nn) + (run-hook-with-args 'erc-nick-changed-functions nn nick)) + (t + (erc-handle-user-status-change 'nick (list nick login host) (list nn)) + (erc-display-message parsed 'notice bufs 'NICK ?n nick + ?u login ?h host ?N nn)))))) + +(define-erc-response-handler (PART) + "Handle part messages." nil + (let* ((chnl (first (erc-response.command-args parsed))) + (reason (erc-trim-string (erc-response.contents parsed))) + (buffer (erc-get-buffer chnl proc))) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (erc-remove-channel-member buffer nick) + (erc-display-message parsed 'notice buffer + 'PART ?n nick ?u login + ?h host ?c chnl ?r (or reason "")) + (when (string= nick (erc-current-nick)) + (run-hook-with-args 'erc-part-hook buffer) + (erc-with-buffer + (buffer) + (erc-remove-channel-users)) + (erc-delete-default-channel chnl buffer) + (erc-update-mode-line buffer) + (when erc-kill-buffer-on-part + (kill-buffer buffer)))))) + +(define-erc-response-handler (PING) + "Handle ping messages." nil + (let ((pinger (first (erc-response.command-args parsed)))) + (erc-log (format "PING: %s" pinger)) + ;; ping response to the server MUST be forced, or you can lose big + (erc-server-send (format "PONG :%s" pinger) t) + (when erc-verbose-server-ping + (erc-display-message + parsed 'error proc + 'PING ?s (erc-time-diff erc-server-last-ping-time (erc-current-time)))) + (setq erc-server-last-ping-time (erc-current-time)))) + +(define-erc-response-handler (PONG) + "Handle pong messages." nil + (let ((time (string-to-number (erc-response.contents parsed)))) + (when (> time 0) + (setq erc-server-lag (erc-time-diff time (erc-current-time))) + (when erc-verbose-server-ping + (erc-display-message + parsed 'notice proc 'PONG + ?h (first (erc-response.command-args parsed)) ?i erc-server-lag + ?s (if (/= erc-server-lag 1) "s" ""))) + (erc-update-mode-line)))) + +(define-erc-response-handler (PRIVMSG NOTICE) + "Handle private messages, including messages in channels." nil + (let ((sender-spec (erc-response.sender parsed)) + (cmd (erc-response.command parsed)) + (tgt (car (erc-response.command-args parsed))) + (msg (erc-response.contents parsed))) + (if (or (erc-ignored-user-p sender-spec) + (erc-ignored-reply-p msg tgt proc)) + (when erc-minibuffer-ignored + (message "Ignored %s from %s to %s" cmd sender-spec tgt)) + (let* ((sndr (erc-parse-user sender-spec)) + (nick (nth 0 sndr)) + (login (nth 1 sndr)) + (host (nth 2 sndr)) + (msgp (string= cmd "PRIVMSG")) + (noticep (string= cmd "NOTICE")) + ;; S.B. downcase *both* tgt and current nick + (privp (erc-current-nick-p tgt)) + s buffer + fnick) + (setf (erc-response.contents parsed) msg) + (setq buffer (erc-get-buffer (if privp nick tgt) proc)) + (when buffer + (with-current-buffer buffer + ;; update the chat partner info. Add to the list if private + ;; message. We will accumulate private identities indefinitely + ;; at this point. + (erc-update-channel-member (if privp nick tgt) nick nick + privp nil nil host login nil nil t) + (let ((cdata (erc-get-channel-user nick))) + (setq fnick (funcall erc-format-nick-function + (car cdata) (cdr cdata)))))) + (cond + ((erc-is-message-ctcp-p msg) + (setq s (if msgp + (erc-process-ctcp-query proc parsed nick login host) + (erc-process-ctcp-reply proc parsed nick login host + (match-string 1 msg))))) + (t + (setcar erc-server-last-peers nick) + (setq s (erc-format-privmessage + (or fnick nick) msg + ;; If buffer is a query buffer, + ;; format the nick as for a channel. + (and (not (and buffer + (erc-query-buffer-p buffer) + erc-format-query-as-channel-p)) + privp) + msgp)))) + (when s + (if (and noticep privp) + (progn + (run-hook-with-args 'erc-echo-notice-always-hook + s parsed buffer nick) + (run-hook-with-args-until-success + 'erc-echo-notice-hook s parsed buffer nick)) + (erc-display-message parsed nil buffer s))) + (when (string= cmd "PRIVMSG") + (erc-auto-query proc parsed)))))) + +;; FIXME: need clean way of specifiying extra hooks in +;; define-erc-response-handler. +(add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query) + +(define-erc-response-handler (QUIT) + "Another user has quit IRC." nil + (let ((reason (erc-response.contents parsed)) + bufs) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (setq bufs (erc-buffer-list-with-nick nick proc)) + (erc-remove-user nick) + (setq reason (erc-wash-quit-reason reason nick login host)) + (erc-display-message parsed 'notice bufs + 'QUIT ?n nick ?u login + ?h host ?r reason)))) + +(define-erc-response-handler (TOPIC) + "The channel topic has changed." nil + (let* ((ch (first (erc-response.command-args parsed))) + (topic (erc-trim-string (erc-response.contents parsed))) + (time (format-time-string "%T %m/%d/%y" (current-time)))) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (erc-update-channel-member ch nick nick nil nil nil host login) + (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) + (erc-display-message parsed 'notice (erc-get-buffer ch proc) + 'TOPIC ?n nick ?u login ?h host + ?c ch ?T topic)))) + +(define-erc-response-handler (WALLOPS) + "Display a WALLOPS message." nil + (let ((message (erc-response.contents parsed))) + (multiple-value-bind (nick login host) + (erc-parse-user (erc-response.sender parsed)) + (erc-display-message + parsed 'notice nil + 'WALLOPS ?n nick ?m message)))) + +(define-erc-response-handler (001) + "Set `erc-server-current-nick' to reflect server settings and display the welcome message." + nil + (erc-set-current-nick (first (erc-response.command-args parsed))) + (erc-update-mode-line) ; needed here? + (setq erc-nick-change-attempt-count 0) + (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) + (erc-display-message + parsed 'notice 'active (erc-response.contents parsed))) + +(define-erc-response-handler (MOTD 002 003 371 372 374 375) + "Display the server's message of the day." nil + (erc-handle-login) + (erc-display-message + parsed 'notice (if erc-server-connected 'active proc) + (erc-response.contents parsed))) + +(define-erc-response-handler (376 422) + "End of MOTD/MOTD is missing." nil + (erc-server-MOTD proc parsed) + (erc-connection-established proc parsed)) + +(define-erc-response-handler (004) + "Display the server's identification." nil + (multiple-value-bind (server-name server-version) + (cdr (erc-response.command-args parsed)) + (setq erc-server-version server-version) + (setq erc-server-announced-name server-name) + (erc-update-mode-line-buffer (process-buffer proc)) + (erc-display-message + parsed 'notice proc + 's004 ?s server-name ?v server-version + ?U (fourth (erc-response.command-args parsed)) + ?C (fifth (erc-response.command-args parsed))))) + +(define-erc-response-handler (005) + "Set the variable `erc-server-parameters' and display the received message. + +According to RFC 2812, suggests alternate servers on the network. +Many servers, however, use this code to show which parameters they have set, +for example, the network identifier, maximum allowed topic length, whether +certain commands are accepted and more. See documentation for +`erc-server-parameters' for more information on the parameters sent. + +A server may send more than one 005 message." + nil + (let ((line (mapconcat 'identity + (setf (erc-response.command-args parsed) + (cdr (erc-response.command-args parsed))) + " "))) + (while (erc-response.command-args parsed) + (let ((section (pop (erc-response.command-args parsed)))) + ;; fill erc-server-parameters + (when (string-match "^\\([A-Z]+\\)\=\\(.*\\)$\\|^\\([A-Z]+\\)$" + section) + (add-to-list 'erc-server-parameters + `(,(or (match-string 1 section) + (match-string 3 section)) + . + ,(match-string 2 section)))))) + (erc-display-message parsed 'notice proc line))) + +(define-erc-response-handler (221) + "Display the current user modes." nil + (let* ((nick (first (erc-response.command-args parsed))) + (modes (mapconcat 'identity + (cdr (erc-response.command-args parsed)) " "))) + (erc-set-modes nick modes) + (erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes))) + +(define-erc-response-handler (252) + "Display the number of IRC operators online." nil + (erc-display-message parsed 'notice 'active 's252 + ?i (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (253) + "Display the number of unknown connections." nil + (erc-display-message parsed 'notice 'active 's253 + ?i (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (254) + "Display the number of channels formed." nil + (erc-display-message parsed 'notice 'active 's254 + ?i (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (250 251 255 256 257 258 259 265 266 377 378) + "Generic display of server messages as notices. + +See `erc-display-server-message'." nil + (erc-display-server-message proc parsed)) + +(define-erc-response-handler (275) + "Display secure connection message." nil + (multiple-value-bind (nick user message) + (cdr (erc-response.command-args parsed)) + (erc-display-message + parsed 'notice 'active 's275 + ?n nick + ?m (mapconcat 'identity (cddr (erc-response.command-args parsed)) + " ")))) + +(define-erc-response-handler (290) + "Handle dancer-ircd CAPAB messages." nil nil) + +(define-erc-response-handler (301) + "AWAY notice." nil + (erc-display-message parsed 'notice 'active 's301 + ?n (second (erc-response.command-args parsed)) + ?r (erc-response.contents parsed))) + +(define-erc-response-handler (303) + "ISON reply" nil + (erc-display-message parsed 'notice 'active 's303 + ?n (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (305) + "Return from AWAYness." nil + (erc-process-away proc nil) + (erc-display-message parsed 'notice 'active + 's305 ?m (erc-response.contents parsed))) + +(define-erc-response-handler (306) + "Set AWAYness." nil + (erc-process-away proc t) + (erc-display-message parsed 'notice 'active + 's306 ?m (erc-response.contents parsed))) + +(define-erc-response-handler (307) + "Display nick-identified message." nil + (multiple-value-bind (nick user message) + (cdr (erc-response.command-args parsed)) + (erc-display-message + parsed 'notice 'active 's307 + ?n nick + ?m (mapconcat 'identity (cddr (erc-response.command-args parsed)) + " ")))) + +(define-erc-response-handler (311 314) + "WHOIS/WHOWAS notices." nil + (let ((fname (erc-response.contents parsed)) + (catalog-entry (intern (format "s%s" (erc-response.command parsed))))) + (multiple-value-bind (nick user host) + (cdr (erc-response.command-args parsed)) + (erc-update-user-nick nick nick host nil fname user) + (erc-display-message + parsed 'notice 'active catalog-entry + ?n nick ?f fname ?u user ?h host)))) + +(define-erc-response-handler (312) + "Server name response in WHOIS." nil + (multiple-value-bind (nick server-host) + (cdr (erc-response.command-args parsed)) + (erc-display-message + parsed 'notice 'active 's312 + ?n nick ?s server-host ?c (erc-response.contents parsed)))) + +(define-erc-response-handler (313) + "IRC Operator response in WHOIS." nil + (erc-display-message + parsed 'notice 'active 's313 + ?n (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (315 318 323 369) + ;; 315 - End of WHO + ;; 318 - End of WHOIS list + ;; 323 - End of channel LIST + ;; 369 - End of WHOWAS + "End of WHO/WHOIS/LIST/WHOWAS notices." nil + (ignore proc parsed)) + +(define-erc-response-handler (317) + "IDLE notice." nil + (multiple-value-bind (nick seconds-idle on-since time) + (cdr (erc-response.command-args parsed)) + (setq time (when on-since + (format-time-string "%T %Y/%m/%d" + (erc-string-to-emacs-time on-since)))) + (erc-update-user-nick nick nick nil nil nil + (and time (format "on since %s" time))) + (if time + (erc-display-message + parsed 'notice 'active 's317-on-since + ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)) ?t time) + (erc-display-message + parsed 'notice 'active 's317 + ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)))))) + +(define-erc-response-handler (319) + "Channel names in WHOIS response." nil + (erc-display-message + parsed 'notice 'active 's319 + ?n (second (erc-response.command-args parsed)) + ?c (erc-response.contents parsed))) + +(define-erc-response-handler (320) + "Identified user in WHOIS." nil + (erc-display-message + parsed 'notice 'active 's320 + ?n (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (321) + "LIST header." nil + (setq erc-channel-list nil)) + +(defun erc-server-321-message (proc parsed) + "Display a message for the 321 event." + (erc-display-message parsed 'notice proc 's321) + nil) +(add-hook 'erc-server-321-functions 'erc-server-321-message t) + +(define-erc-response-handler (322) + "LIST notice." nil + (let ((topic (erc-response.contents parsed))) + (multiple-value-bind (channel num-users) + (cdr (erc-response.command-args parsed)) + (add-to-list 'erc-channel-list (list channel)) + (erc-update-channel-topic channel topic)))) + +(defun erc-server-322-message (proc parsed) + "Display a message for the 322 event." + (let ((topic (erc-response.contents parsed))) + (multiple-value-bind (channel num-users) + (cdr (erc-response.command-args parsed)) + (erc-display-message + parsed 'notice proc 's322 + ?c channel ?u num-users ?t (or topic ""))))) +(add-hook 'erc-server-322-functions 'erc-server-322-message t) + +(define-erc-response-handler (324) + "Channel or nick modes." nil + (let ((channel (second (erc-response.command-args parsed))) + (modes (mapconcat 'identity (cddr (erc-response.command-args parsed)) + " "))) + (erc-set-modes channel modes) + (erc-display-message + parsed 'notice (erc-get-buffer channel proc) + 's324 ?c channel ?m modes))) + +(define-erc-response-handler (329) + "Channel creation date." nil + (let ((channel (second (erc-response.command-args parsed))) + (time (erc-string-to-emacs-time + (third (erc-response.command-args parsed))))) + (erc-display-message + parsed 'notice (erc-get-buffer channel proc) + 's329 ?c channel ?t (format-time-string "%A %Y/%m/%d %X" time)))) + +(define-erc-response-handler (330) + "Nick is authed as (on Quakenet network)." nil + ;; FIXME: I don't know what the magic numbers mean. Mummy, make + ;; the magic numbers go away. + ;; No seriously, I have no clue about the format of this command, + ;; and don't sit on Quakenet, so can't test. Originally we had: + ;; nick == (aref parsed 3) + ;; authaccount == (aref parsed 4) + ;; authmsg == (aref parsed 5) + ;; The guesses below are, well, just that. -- Lawrence 2004/05/10 + (let ((nick (second (erc-response.command-args parsed))) + (authaccount (third (erc-response.command-args parsed))) + (authmsg (erc-response.contents parsed))) + (erc-display-message parsed 'notice 'active 's330 + ?n nick ?a authmsg ?i authaccount))) + +(define-erc-response-handler (331) + "No topic set for channel." nil + (let ((channel (second (erc-response.command-args parsed))) + (topic (erc-response.contents parsed))) + (erc-display-message parsed 'notice (erc-get-buffer channel proc) + 's331 ?c channel))) + +(define-erc-response-handler (332) + "TOPIC notice." nil + (let ((channel (second (erc-response.command-args parsed))) + (topic (erc-response.contents parsed))) + (erc-update-channel-topic channel topic) + (erc-display-message parsed 'notice (erc-get-buffer channel proc) + 's332 ?c channel ?T topic))) + +(define-erc-response-handler (333) + "Who set the topic, and when." nil + (multiple-value-bind (channel nick time) + (cdr (erc-response.command-args parsed)) + (setq time (format-time-string "%T %Y/%m/%d" + (erc-string-to-emacs-time time))) + (erc-update-channel-topic channel + (format "\C-o (%s, %s)" nick time) + 'append) + (erc-display-message parsed 'notice (erc-get-buffer channel proc) + 's333 ?c channel ?n nick ?t time))) + +(define-erc-response-handler (341) + "Let user know when an INVITE attempt has been sent successfully." + nil + (multiple-value-bind (nick channel) + (cdr (erc-response.command-args parsed)) + (erc-display-message parsed 'notice (erc-get-buffer channel proc) + 's341 ?n nick ?c channel))) + +(define-erc-response-handler (352) + "WHO notice." nil + (multiple-value-bind (channel user host server nick away-flag) + (cdr (erc-response.command-args parsed)) + (let ((full-name (erc-response.contents parsed)) + hopcount) + (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) + (setq hopcount (match-string 1 full-name)) + (setq full-name (match-string 2 full-name))) + (erc-update-channel-member channel nick nick nil nil nil host + user full-name) + (erc-display-message parsed 'notice 'active 's352 + ?c channel ?n nick ?a away-flag + ?u user ?h host ?f full-name)))) + +(define-erc-response-handler (353) + "NAMES notice." nil + (let ((channel (third (erc-response.command-args parsed))) + (users (erc-response.contents parsed))) + (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) + 'active) + 's353 ?c channel ?u users) + (erc-with-buffer (channel proc) + (erc-channel-receive-names users)))) + +(define-erc-response-handler (366) + "End of NAMES." nil + (erc-with-buffer ((second (erc-response.command-args parsed)) proc) + (erc-channel-end-receiving-names))) + +(define-erc-response-handler (367) + "Channel ban list entries." nil + (multiple-value-bind (channel banmask setter time) + (cdr (erc-response.command-args parsed)) + ;; setter and time are not standard + (if setter + (erc-display-message parsed 'notice 'active 's367-set-by + ?c channel + ?b banmask + ?s setter + ?t (or time "")) + (erc-display-message parsed 'notice 'active 's367 + ?c channel + ?b banmask)))) + +(define-erc-response-handler (368) + "End of channel ban list." nil + (let ((channel (second (erc-response.command-args parsed)))) + (erc-display-message parsed 'notice 'active 's368 + ?c channel))) + +(define-erc-response-handler (379) + "Forwarding to another channel." nil + ;; FIXME: Yet more magic numbers in original code, I'm guessing this + ;; command takes two arguments, and doesn't have any "contents". -- + ;; Lawrence 2004/05/10 + (multiple-value-bind (from to) + (cdr (erc-response.command-args parsed)) + (erc-display-message parsed 'notice 'active + 's379 ?c from ?f to))) + +(define-erc-response-handler (391) + "Server's time string." nil + (erc-display-message + parsed 'notice 'active + 's391 ?s (second (erc-response.command-args parsed)) + ?t (third (erc-response.command-args parsed)))) + +(define-erc-response-handler (401) + "No such nick/channel." nil + (let ((nick/channel (second (erc-response.command-args parsed)))) + (when erc-whowas-on-nosuchnick + (erc-log (format "cmd: WHOWAS: %s" nick/channel)) + (erc-server-send (format "WHOWAS %s 1" nick/channel))) + (erc-display-message parsed '(notice error) 'active + 's401 ?n nick/channel))) + +(define-erc-response-handler (403) + "No such channel." nil + (erc-display-message parsed '(notice error) 'active + 's403 ?c (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (404) + "Cannot send to channel." nil + (erc-display-message parsed '(notice error) 'active + 's404 ?c (second (erc-response.command-args parsed)))) + + +(define-erc-response-handler (405) + "Can't join that many channels." nil + (erc-display-message parsed '(notice error) 'active + 's405 ?c (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (406) + "No such nick." nil + (erc-display-message parsed '(notice error) 'active + 's406 ?n (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (412) + "No text to send." nil + (erc-display-message parsed '(notice error) 'active 's412)) + +(define-erc-response-handler (421) + "Unknown command." nil + (erc-display-message parsed '(notice error) 'active 's421 + ?c (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (432) + "Bad nick." nil + (erc-display-message parsed '(notice error) 'active 's432 + ?n (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (433) + "Login-time \"nick in use\"." nil + (erc-nickname-in-use (second (erc-response.command-args parsed)) + "already in use")) + +(define-erc-response-handler (437) + "Nick temporarily unavailable (on IRCnet)." nil + (let ((nick/channel (second (erc-response.command-args parsed)))) + (unless (erc-channel-p nick/channel) + (erc-nickname-in-use nick/channel "temporarily unavailable")))) + +(define-erc-response-handler (442) + "Not on channel." nil + (erc-display-message parsed '(notice error) 'active 's442 + ?c (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (461) + "Not enough parameters for command." nil + (erc-display-message parsed '(notice error) 'active 's461 + ?c (second (erc-response.command-args parsed)) + ?m (erc-response.contents parsed))) + +(define-erc-response-handler (465) + "You are banned from this server." nil + (setq erc-server-banned t) + ;; show the server's message, as a reason might be provided + (erc-display-error-notice + parsed + (erc-response.contents parsed))) + +(define-erc-response-handler (474) + "Banned from channel errors." nil + (erc-display-message parsed '(notice error) nil + (intern (format "s%s" + (erc-response.command parsed))) + ?c (second (erc-response.command-args parsed)))) + +(define-erc-response-handler (475) + "Channel key needed." nil + (erc-display-message parsed '(notice error) nil 's475 + ?c (second (erc-response.command-args parsed))) + (when erc-prompt-for-channel-key + (let ((channel (second (erc-response.command-args parsed))) + (key (read-from-minibuffer + (format "Channel %s is mode +k. Enter key (RET to cancel): " + (second (erc-response.command-args parsed)))))) + (when (and key (> (length key) 0)) + (erc-cmd-JOIN channel key))))) + +(define-erc-response-handler (477) + "Channel doesn't support modes." nil + (let ((channel (second (erc-response.command-args parsed))) + (message (erc-response.contents parsed))) + (erc-display-message parsed 'notice (erc-get-buffer channel proc) + (format "%s: %s" channel message)))) + +(define-erc-response-handler (482) + "You need to be a channel operator to do that." nil + (let ((channel (second (erc-response.command-args parsed))) + (message (erc-response.contents parsed))) + (erc-display-message parsed '(error notice) 'active 's482 + ?c channel ?m message))) + +(define-erc-response-handler (431 445 446 451 462 463 464 481 483 484 485 + 491 501 502) + ;; 431 - No nickname given + ;; 445 - SUMMON has been disabled + ;; 446 - USERS has been disabled + ;; 451 - You have not registered + ;; 462 - Unauthorized command (already registered) + ;; 463 - Your host isn't among the privileged + ;; 464 - Password incorrect + ;; 481 - Need IRCop privileges + ;; 483 - You can't kill a server! + ;; 484 - Your connection is restricted! + ;; 485 - You're not the original channel operator + ;; 491 - No O-lines for your host + ;; 501 - Unknown MODE flag + ;; 502 - Cannot change mode for other users + "Generic display of server error messages. + +See `erc-display-error-notice'." nil + (erc-display-error-notice + parsed + (intern (format "s%s" (erc-response.command parsed))))) + +;; FIXME: These are yet to be implemented, they're just stubs for now +;; -- Lawrence 2004/05/12 + +;; response numbers left here for reference + +;; (define-erc-response-handler (323 364 365 381 382 392 393 394 395 +;; 200 201 202 203 204 205 206 208 209 211 212 213 +;; 214 215 216 217 218 219 241 242 243 244 249 261 +;; 262 302 342 351 402 407 409 411 413 414 415 +;; 423 424 436 441 443 444 467 471 472 473 KILL) +;; nil nil +;; (ignore proc parsed)) + +(provide 'erc-backend) + +;;; erc-backend.el ends here +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;; arch-tag: a64e6bb7-a780-4efd-8f98-083b18c7c84a diff --git a/lisp/erc-bbdb.el b/lisp/erc-bbdb.el new file mode 100644 index 0000000..5d6ed78 --- /dev/null +++ b/lisp/erc-bbdb.el @@ -0,0 +1,269 @@ +;;; erc-bbdb.el --- Integrating the BBDB into ERC + +;; Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007 +;; 2008 Free Software Foundation, Inc. + +;; Author: Andreas Fuchs +;; Maintainer: Mario Lang + +;; 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 3, 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 mode connects the BBDB to ERC. Whenever a known nick +;; connects, the corresponding BBDB record pops up. To identify +;; users, use the irc-nick field. Define it, if BBDB asks you about +;; that. When you use /WHOIS on a known nick, the corresponding +;; record will be updated. + +;;; History + +;; Andreas Fuchs wrote zenirc-bbdb-whois.el, which was +;; adapted for ERC by Mario Lang . + +;; Changes by Edgar Gonçalves +;; May 31 2005: +;; - new variable: erc-bbdb-bitlbee-name-field - the field name for the +;; msn/icq/etc nick +;; - nick doesn't go the the name. now it asks for an existing record to +;; merge with. If none, then create a new one with the nick as name. + +;;; Code: + +(require 'erc) +(require 'bbdb) +(require 'bbdb-com) +(require 'bbdb-gui) +(require 'bbdb-hooks) + +(defgroup erc-bbdb nil + "Variables related to BBDB usage." + :group 'erc) + +(defcustom erc-bbdb-auto-create-on-whois-p nil + "*If nil, don't create bbdb records automatically when a WHOIS is done. +Leaving this at nil is a good idea, but you can turn it +on if you want to have lots of People named \"John Doe\" in your BBDB." + :group 'erc-bbdb + :type 'boolean) + +(defcustom erc-bbdb-auto-create-on-join-p nil + "*If nil, don't create bbdb records automatically when a person joins a channel. +Leaving this at nil is a good idea, but you can turn it +on if you want to have lots of People named \"John Doe\" in your BBDB." + :group 'erc-bbdb + :type 'boolean) + +(defcustom erc-bbdb-auto-create-on-nick-p nil + "*If nil, don't create bbdb records automatically when a person changes her nick. +Leaving this at nil is a good idea, but you can turn it +on if you want to have lots of People named \"John Doe\" in your BBDB." + :group 'erc-bbdb + :type 'boolean) + +(defcustom erc-bbdb-popup-type 'visible + "*If t, pop up a BBDB buffer showing the record of a WHOISed person +or the person who has just joined a channel. + +If set to 'visible, the BBDB buffer only pops up when someone was WHOISed +or a person joined a channel visible on any frame. + +If set to nil, never pop up a BBDD buffer." + :group 'erc-bbdb + :type '(choice (const :tag "When visible" visible) + (const :tag "When joining" t) + (const :tag "Never" nil))) + +(defcustom erc-bbdb-irc-nick-field 'irc-nick + "The notes field name to use for annotating IRC nicknames." + :group 'erc-bbdb + :type 'symbol) + +(defcustom erc-bbdb-irc-channel-field 'irc-channel + "The notes field name to use for annotating IRC channels." + :group 'erc-bbdb + :type 'symbol) + +(defcustom erc-bbdb-irc-highlight-field 'irc-highlight + "The notes field name to use for highlighting a person's messages." + :group 'erc-bbdb + :type 'symbol) + +(defcustom erc-bbdb-bitlbee-name-field 'bitlbee-name + "The notes field name to use for annotating bitlbee displayed name. +This is the name that a bitlbee (AIM/MSN/ICQ) contact provides as +their \"displayed name\"." + :group 'erc-bbdb + :type 'symbol) + +(defcustom erc-bbdb-elide-display nil + "*If t, show BBDB popup buffer elided." + :group 'erc-bbdb + :type 'boolean) + +(defcustom erc-bbdb-electric-p nil + "*If t, BBDB popup buffer is electric." + :group 'erc-bbdb + :type 'boolean) + +(defun erc-bbdb-search-name-and-create (create-p name nick finger-host silent) + (let* ((ircnick (cons erc-bbdb-irc-nick-field (concat "^" + (regexp-quote nick)))) + (finger (cons bbdb-finger-host-field (regexp-quote finger-host))) + (record (or (bbdb-search (bbdb-records) nil nil nil ircnick) + (and name (bbdb-search-simple name nil)) + (bbdb-search (bbdb-records) nil nil nil finger) + (unless silent + (bbdb-completing-read-one-record + "Merge using record of (C-g to skip, RET for new): ")) + (when create-p + (bbdb-create-internal (or name + "John Doe") + nil nil nil nil nil))))) + ;; sometimes, the record will be a list. I don't know why. + (if (listp record) + (car record) + record))) + +(defun erc-bbdb-show-entry (record channel proc) + (let ((bbdb-display-layout (bbdb-grovel-elide-arg erc-bbdb-elide-display)) + (bbdb-electric-p erc-bbdb-electric-p)) + (when (and record (or (eq erc-bbdb-popup-type t) + (and (eq erc-bbdb-popup-type 'visible) + (and channel + (or (eq channel t) + (get-buffer-window (erc-get-buffer + channel proc) + 'visible)))))) + (bbdb-display-records (list record))))) + +(defun erc-bbdb-insinuate-and-show-entry-1 (create-p proc nick name finger-host silent &optional chan new-nick) + (let ((record (erc-bbdb-search-name-and-create + create-p nil nick finger-host silent))) ;; don't search for a name + (when record + (bbdb-annotate-notes record (or new-nick nick) erc-bbdb-irc-nick-field) + (bbdb-annotate-notes record finger-host bbdb-finger-host-field) + (and name + (bbdb-annotate-notes record name erc-bbdb-bitlbee-name-field t)) + (and chan + (not (eq chan t)) + (bbdb-annotate-notes record chan erc-bbdb-irc-channel-field)) + (erc-bbdb-highlight-record record) + (erc-bbdb-show-entry record chan proc)))) + +(defun erc-bbdb-insinuate-and-show-entry (create-p proc nick name finger-host silent &optional chan new-nick) + ;; run this outside of the IRC filter process, to avoid an annoying + ;; error when the user hits C-g + (run-at-time 0.1 nil + #'erc-bbdb-insinuate-and-show-entry-1 + create-p proc nick name finger-host silent chan new-nick)) + +(defun erc-bbdb-whois (proc parsed) + (let (; We could use server name too, probably + (nick (second (erc-response.command-args parsed))) + (name (erc-response.contents parsed)) + (finger-host (concat (third (erc-response.command-args parsed)) + "@" + (fourth (erc-response.command-args parsed))))) + (erc-bbdb-insinuate-and-show-entry erc-bbdb-auto-create-on-whois-p proc + nick name finger-host nil t))) + +(defun erc-bbdb-JOIN (proc parsed) + (let* ((sender (erc-parse-user (erc-response.sender parsed))) + (nick (nth 0 sender))) + (unless (string= nick (erc-current-nick)) + (let* ((channel (erc-response.contents parsed)) + (finger-host (concat (nth 1 sender) "@" (nth 2 sender)))) + (erc-bbdb-insinuate-and-show-entry + erc-bbdb-auto-create-on-join-p proc + nick nil finger-host t channel))))) + +(defun erc-bbdb-NICK (proc parsed) + "Annotate new nick name to a record in case it already exists." + (let* ((sender (erc-parse-user (erc-response.sender parsed))) + (nick (nth 0 sender))) + (unless (string= nick (erc-current-nick)) + (let* ((finger-host (concat (nth 1 sender) "@" (nth 2 sender)))) + (erc-bbdb-insinuate-and-show-entry + erc-bbdb-auto-create-on-nick-p proc + nick nil finger-host t nil (erc-response.contents parsed)))))) + +(defun erc-bbdb-init-highlighting-hook-fun (proc parsed) + (erc-bbdb-init-highlighting)) + +(defun erc-bbdb-init-highlighting () + "Initialize the highlighting based on BBDB fields. +This function typically gets called on a successful server connect. +The field name in the BBDB which controls highlighting is specified by +`erc-bbdb-irc-highlight-field'. Fill in either \"pal\" +\"dangerous-host\" or \"fool\". They work exactly like their +counterparts `erc-pals', `erc-dangerous-hosts' and `erc-fools'." + (let* ((irc-highlight (cons erc-bbdb-irc-highlight-field + ".+")) + (matching-records (bbdb-search (bbdb-records) + nil nil nil irc-highlight))) + (mapcar 'erc-bbdb-highlight-record matching-records))) + +(defun erc-bbdb-highlight-record (record) + (let* ((notes (bbdb-record-raw-notes record)) + (highlight-field (assoc erc-bbdb-irc-highlight-field notes)) + (nick-field (assoc erc-bbdb-irc-nick-field notes))) + (if (and highlight-field + nick-field) + (let ((highlight-types (split-string (cdr highlight-field) + bbdb-notes-default-separator)) + (nick-names (split-string (cdr nick-field) + (concat "\\(\n\\|" + bbdb-notes-default-separator + "\\)")))) + (mapcar + (lambda (highlight-type) + (mapcar + (lambda (nick-name) + (if (member highlight-type + '("pal" "dangerous-host" "fool")) + (add-to-list (intern (concat "erc-" highlight-type "s")) + (regexp-quote nick-name)) + (error (format "\"%s\" (in \"%s\") is not a valid highlight type!" + highlight-type nick-name)))) + nick-names)) + highlight-types))))) + +;;;###autoload (autoload 'erc-bbdb-mode "erc-bbdb") +(define-erc-module bbdb nil + "In ERC BBDB mode, you can directly interact with your BBDB." + ((add-hook 'erc-server-311-functions 'erc-bbdb-whois t) + (add-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN t) + (add-hook 'erc-server-NICK-functions 'erc-bbdb-NICK t) + (add-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun t)) + ((remove-hook 'erc-server-311-functions 'erc-bbdb-whois) + (remove-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN) + (remove-hook 'erc-server-NICK-functions 'erc-bbdb-NICK) + (remove-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun))) + +(provide 'erc-bbdb) + +;;; erc-bbdb.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; coding: utf-8 +;; End: + +;; arch-tag: 1edf3729-cd49-47dc-aced-70fcfc28c815 diff --git a/lisp/erc-button.el b/lisp/erc-button.el new file mode 100644 index 0000000..7e45c6c --- /dev/null +++ b/lisp/erc-button.el @@ -0,0 +1,537 @@ +;; erc-button.el --- A way of buttonizing certain things in ERC buffers + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: irc, button, url, regexp +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcButton + +;; 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 3, 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: + +;; Heavily borrowed from gnus-art.el. Thanks to the original authors. +;; This buttonizes nicks and other stuff to make it all clickable. +;; To enable, add to your ~/.emacs: +;; (require 'erc-button) +;; (erc-button-mode 1) +;; +;; Todo: +;; * Rewrite all this to do the same, but use button.el from GNU Emacs +;; if it's available for xemacs too. Why? button.el is much faster, +;; and much more elegant, and solves the problem we get with large buffers +;; and a large erc-button-marker-list. + + +;;; Code: + +(require 'erc) +(require 'wid-edit) +(require 'erc-fill) + +;;; Minor Mode + +(defgroup erc-button nil + "Define how text can be turned into clickable buttons." + :group 'erc) + +;;;###autoload (autoload 'erc-button-mode "erc-button" nil t) +(define-erc-module button nil + "This mode buttonizes all messages according to `erc-button-alist'." + ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) + (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) + (add-hook 'erc-complete-functions 'erc-button-next) + (add-hook 'erc-mode-hook 'erc-button-setup)) + ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) + (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) + (remove-hook 'erc-complete-functions 'erc-button-next) + (remove-hook 'erc-mode-hook 'erc-button-setup) + (when (featurep 'xemacs) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (kill-local-variable 'widget-button-face)))))) + +;;; Variables + +(defface erc-button '((t (:bold t))) + "ERC button face." + :group 'erc-faces) + +(defcustom erc-button-face 'erc-button + "Face used for highlighting buttons in ERC buffers. + +A button is a piece of text that you can activate by pressing +`RET' or `mouse-2' above it. See also `erc-button-keymap'." + :type 'face + :group 'erc-faces) + +(defcustom erc-button-nickname-face 'erc-nick-default-face + "Face used for ERC nickname buttons." + :type 'face + :group 'erc-faces) + +(defcustom erc-button-mouse-face 'highlight + "Face used for mouse highlighting in ERC buffers. + +Buttons will be displayed in this face when the mouse cursor is +above them." + :type 'face + :group 'erc-faces) + +(defcustom erc-button-url-regexp + (concat "\\(www\\.\\|\\(s?https?\\|" + "ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)" + "\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?" + "[-a-zA-Z0-9_=!?#$@~`%&*+\\/:;.,()]+[-a-zA-Z0-9_=#$@~`%&*+\\/()]") + "Regular expression that matches URLs." + :group 'erc-button + :type 'regexp) + +(defcustom erc-button-wrap-long-urls nil + "If non-nil, \"long\" URLs matching `erc-button-url-regexp' will be wrapped. + +If this variable is a number, consider URLs longer than its value to +be \"long\". If t, URLs will be considered \"long\" if they are +longer than `erc-fill-column'." + :group 'erc-button + :type '(choice integer boolean)) + +(defcustom erc-button-buttonize-nicks t + "Flag indicating whether nicks should be buttonized or not." + :group 'erc-button + :type 'boolean) + +(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html" + "*URL used to browse rfc references. +%s is replaced by the number." + :group 'erc-button + :type 'string) + +(defcustom erc-button-google-url "http://www.google.com/search?q=%s" + "*URL used to browse Google search references. +%s is replaced by the search string." + :group 'erc-button + :type 'string) + +(defcustom erc-button-alist + ;; Since the callback is only executed when the user is clicking on + ;; a button, it makes no sense to optimize performance by + ;; bytecompiling lambdas in this alist. On the other hand, it makes + ;; things hard to maintain. + '(('nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) + (erc-button-url-regexp 0 t browse-url 0) + (" ]+\\) *>" 0 t browse-url 1) + ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) + ;; emacs internal + ("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1) + ;; pseudo links + ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1) + ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)" + 0 t (lambda (page) + (browse-url (concat "http://c2.com/cgi-bin/wiki?" page))) + 2) + ("EmacsWiki:\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)" 0 t erc-browse-emacswiki 1) + ("Lisp:\\([a-zA-Z.+-]+\\)" 0 t erc-browse-emacswiki-lisp 1) + ("\\bGoogle:\\([^ \t\n\r\f]+\\)" + 0 t (lambda (keywords) + (browse-url (format erc-button-google-url keywords))) + 1) + ("\\brfc[#: ]?\\([0-9]+\\)" + 0 t (lambda (num) + (browse-url (format erc-button-rfc-url num))) + 1) + ;; other + ("\\s-\\(@\\([0-9][0-9][0-9]\\)\\)" 1 t erc-button-beats-to-time 2)) + "*Alist of regexps matching buttons in ERC buffers. +Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where + +REGEXP is the string matching text around the button or a symbol + indicating a variable holding that string, or a list of + strings, or an alist with the strings in the car. Note that + entries in lists or alists are considered to be nicks or other + complete words. Therefore they are enclosed in \\< and \\> + while searching. REGEXP can also be the quoted symbol + 'nicknames, which matches the nickname of any user on the + current server. + +BUTTON is the number of the regexp grouping actually matching the + button, This is ignored if REGEXP is 'nicknames. + +FORM is a lisp expression which must eval to true for the button to + be added, + +CALLBACK is the function to call when the user push this button. + CALLBACK can also be a symbol. Its variable value will be used + as the callback function. + +PAR is a number of a regexp grouping whose text will be passed to + CALLBACK. There can be several PAR arguments. If REGEXP is + 'nicknames, these are ignored, and CALLBACK will be called with + the nickname matched as the argument." + :group 'erc-button + :type '(repeat + (list :tag "Button" + (choice :tag "Matches" + regexp + (variable :tag "Variable containing regexp") + (const :tag "Nicknames" 'nicknames)) + (integer :tag "Number of the regexp section that matches") + (choice :tag "When to buttonize" + (const :tag "Always" t) + (sexp :tag "Only when this evaluates to non-nil")) + (function :tag "Function to call when button is pressed") + (repeat :tag "Sections of regexp to send to the function" + :inline t + (integer :tag "Regexp section number"))))) + +(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?" + "*URL of the EmacsWiki Homepage." + :group 'erc-button + :type 'string) + +(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/" + "*URL of the EmacsWiki ELisp area." + :group 'erc-button + :type 'string) + +(defvar erc-button-keymap + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'erc-button-press-button) + (if (featurep 'xemacs) + (define-key map (kbd "") 'erc-button-click-button) + (define-key map (kbd "") 'erc-button-click-button)) + (define-key map (kbd "TAB") 'erc-button-next) + (define-key map (kbd "") 'erc-button-previous) + (set-keymap-parent map erc-mode-map) + map) + "Local keymap for ERC buttons.") + +(defvar erc-button-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\( "w" table) + (modify-syntax-entry ?\) "w" table) + (modify-syntax-entry ?\[ "w" table) + (modify-syntax-entry ?\] "w" table) + (modify-syntax-entry ?\{ "w" table) + (modify-syntax-entry ?\} "w" table) + (modify-syntax-entry ?` "w" table) + (modify-syntax-entry ?' "w" table) + (modify-syntax-entry ?^ "w" table) + (modify-syntax-entry ?- "w" table) + (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?| "w" table) + (modify-syntax-entry ?\\ "w" table) + table) + "Syntax table used when buttonizing messages. +This syntax table should make all the legal nick characters word +constituents.") + +(defvar erc-button-keys-added nil + "Internal variable used to keep track of whether we've added the +global-level ERC button keys yet.") + +(defun erc-button-setup () + "Add ERC mode-level button movement keys. This is only done once." + ;; Make XEmacs use `erc-button-face'. + (when (featurep 'xemacs) + (set (make-local-variable 'widget-button-face) nil)) + ;; Add keys. + (unless erc-button-keys-added + (define-key erc-mode-map (kbd "") 'erc-button-previous) + (setq erc-button-keys-added t))) + +(defun erc-button-add-buttons () + "Find external references in the current buffer and make buttons of them. +\"External references\" are things like URLs, as +specified by `erc-button-alist'." + (interactive) + (save-excursion + (with-syntax-table erc-button-syntax-table + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (inhibit-field-text-motion t) + (alist erc-button-alist) + entry regexp data) + (erc-button-remove-old-buttons) + (dolist (entry alist) + (if (equal (car entry) (quote (quote nicknames))) + (erc-button-add-nickname-buttons entry) + (progn + (setq regexp (or (and (stringp (car entry)) (car entry)) + (and (boundp (car entry)) + (symbol-value (car entry))))) + (cond ((stringp regexp) + (erc-button-add-buttons-1 regexp entry)) + ((and (listp regexp) (stringp (car regexp))) + (dolist (r regexp) + (erc-button-add-buttons-1 + (concat "\\<" (regexp-quote r) "\\>") + entry))) + ((and (listp regexp) (listp (car regexp)) + (stringp (caar regexp))) + (dolist (elem regexp) + (erc-button-add-buttons-1 + (concat "\\<" (regexp-quote (car elem)) "\\>") + entry))))))))))) + +(defun erc-button-add-nickname-buttons (entry) + "Search through the buffer for nicknames, and add buttons." + (let ((form (nth 2 entry)) + (fun (nth 3 entry)) + bounds word) + (when (or (eq t form) + (eval form)) + (goto-char (point-min)) + (while (forward-word 1) + (setq bounds (bounds-of-thing-at-point 'word)) + (setq word (buffer-substring-no-properties + (car bounds) (cdr bounds))) + (when (or (and (erc-server-buffer-p) (erc-get-server-user word)) + (and erc-channel-users (erc-get-channel-user word))) + (erc-button-add-button (car bounds) (cdr bounds) + fun t (list word))))))) + +(defun erc-button-add-buttons-1 (regexp entry) + "Search through the buffer for matches to ENTRY and add buttons." + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (form (nth 2 entry)) + (fun (nth 3 entry)) + (data (mapcar 'match-string (nthcdr 4 entry)))) + (when (or (eq t form) + (eval form)) + (erc-button-add-button start end fun nil data regexp))))) + +(defun erc-button-remove-old-buttons () + "Remove all existing buttons. +This is called with narrowing in effect, just before the text is +buttonized again. Removing a button means to remove all the properties +that `erc-button-add-button' adds, except for the face." + (remove-text-properties + (point-min) (point-max) + '(erc-callback nil + erc-data nil + mouse-face nil + keymap nil))) + +(defun erc-button-add-button (from to fun nick-p &optional data regexp) + "Create a button between FROM and TO with callback FUN and data DATA. +NICK-P specifies if this is a nickname button. +REGEXP is the regular expression which matched for this button." + ;; Really nasty hack to ise urls, and line-wrap them if + ;; they're going to be wider than `erc-fill-column'. + ;; This could be a lot cleaner, but it works for me -- lawrence. + (let (fill-column) + (when (and erc-button-wrap-long-urls + (string= regexp erc-button-url-regexp) + (> (- to from) + (setq fill-column (- (if (numberp erc-button-wrap-long-urls) + erc-button-wrap-long-urls + erc-fill-column) + (length erc-fill-prefix))))) + (setq to (prog1 (point-marker) (insert ">")) + from (prog2 (goto-char from) (point-marker) (insert " (- to pos) fill-column) + (goto-char (+ pos fill-column)) + (insert "\n" erc-fill-prefix) ; This ought to figure out + ; what type of filling we're + ; doing, and indent accordingly. + (move-marker pos (point)))))) + (if nick-p + (when erc-button-nickname-face + (erc-button-add-face from to erc-button-nickname-face)) + (when erc-button-face + (erc-button-add-face from to erc-button-face))) + (add-text-properties + from to + (nconc (and erc-button-mouse-face + (list 'mouse-face erc-button-mouse-face)) + (list 'erc-callback fun) + (list 'keymap erc-button-keymap) + (list 'rear-nonsticky t) + (and data (list 'erc-data data)))) + (widget-convert-button 'link from to :action 'erc-button-press-button + :suppress-face t + ;; Make XEmacs use our faces. + :button-face (if nick-p + erc-button-nickname-face + erc-button-face) + ;; Make XEmacs behave with mouse-clicks, for + ;; some reason, widget stuff overrides the + ;; 'keymap text-property. + :mouse-down-action 'erc-button-click-button)) + +(defun erc-button-add-face (from to face) + "Add FACE to the region between FROM and TO." + ;; If we just use `add-text-property', then this will overwrite any + ;; face text property already used for the button. It will not be + ;; merged correctly. If we use overlays, then redisplay will be + ;; very slow with lots of buttons. This is why we manually merge + ;; face text properties. + (let ((old (erc-list (get-text-property from 'face))) + (pos from) + (end (next-single-property-change from 'face nil to)) + new) + ;; old is the face at pos, in list form. It is nil if there is no + ;; face at pos. If nil, the new face is FACE. If not nil, the + ;; new face is a list containing FACE and the old stuff. end is + ;; where this face changes. + (while (< pos to) + (setq new (if old (cons face old) face)) + (put-text-property pos end 'face new) + (setq pos end + old (erc-list (get-text-property pos 'face)) + end (next-single-property-change pos 'face nil to))))) + +;; widget-button-click calls with two args, we ignore the first. +;; Since Emacs runs this directly, rather than with +;; widget-button-click, we need to fake an extra arg in the +;; interactive spec. +(defun erc-button-click-button (ignore event) + "Call `erc-button-press-button'." + (interactive "P\ne") + (save-excursion + (mouse-set-point event) + (erc-button-press-button))) + +;; XEmacs calls this via widget-button-press with a bunch of arguments +;; which we don't care about. +(defun erc-button-press-button (&rest ignore) + "Check text at point for a callback function. +If the text at point has a `erc-callback' property, +call it with the value of the `erc-data' text property." + (interactive) + (let* ((data (get-text-property (point) 'erc-data)) + (fun (get-text-property (point) 'erc-callback))) + (unless fun + (message "No button at point")) + (when (and fun (symbolp fun) (not (fboundp fun))) + (error "Function %S is not bound" fun)) + (apply fun data))) + +(defun erc-button-next () + "Go to the next button in this buffer." + (interactive) + (let ((here (point))) + (when (< here (erc-beg-of-input-line)) + (while (and (get-text-property here 'erc-callback) + (not (= here (point-max)))) + (setq here (1+ here))) + (while (and (not (get-text-property here 'erc-callback)) + (not (= here (point-max)))) + (setq here (1+ here))) + (if (< here (point-max)) + (goto-char here) + (error "No next button")) + t))) + +(defun erc-button-previous () + "Go to the previous button in this buffer." + (interactive) + (let ((here (point))) + (when (< here (erc-beg-of-input-line)) + (while (and (get-text-property here 'erc-callback) + (not (= here (point-min)))) + (setq here (1- here))) + (while (and (not (get-text-property here 'erc-callback)) + (not (= here (point-min)))) + (setq here (1- here))) + (if (> here (point-min)) + (goto-char here) + (error "No previous button")) + t))) + +(defun erc-browse-emacswiki (thing) + "Browse to thing in the emacs-wiki." + (browse-url (concat erc-emacswiki-url thing))) + +(defun erc-browse-emacswiki-lisp (thing) + "Browse to THING in the emacs-wiki elisp area." + (browse-url (concat erc-emacswiki-lisp-url thing))) + +;;; Nickname buttons: + +(defcustom erc-nick-popup-alist + '(("DeOp" . (erc-cmd-DEOP nick)) + ("Kick" . (erc-cmd-KICK (concat nick " " + (read-from-minibuffer + (concat "Kick " nick ", reason: "))))) + ("Msg" . (erc-cmd-MSG (concat nick " " + (read-from-minibuffer + (concat "Message to " nick ": "))))) + ("Op" . (erc-cmd-OP nick)) + ("Query" . (erc-cmd-QUERY nick)) + ("Whois" . (erc-cmd-WHOIS nick)) + ("Lastlog" . (erc-cmd-LASTLOG nick))) + "*An alist of possible actions to take on a nickname. +An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with +the variable `nick' bound to the nick in question. + +Examples: + (\"DebianDB\" . + (shell-command + (format + \"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\" + nick)))" + :group 'erc-button + :type '(repeat (cons (string :tag "Op") + sexp))) + +(defun erc-nick-popup (nick) + (let* ((completion-ignore-case t) + (action (completing-read (concat "What action to take on '" nick "'? ") + erc-nick-popup-alist)) + (code (cdr (assoc action erc-nick-popup-alist)))) + (when code + (erc-set-active-buffer (current-buffer)) + (eval code)))) + +;;; Callback functions +(defun erc-button-describe-symbol (symbol-name) + "Describe SYMBOL-NAME. +Use `describe-function' for functions, `describe-variable' for variables, +and `apropos' for other symbols." + (let ((symbol (intern-soft symbol-name))) + (cond ((and symbol (fboundp symbol)) + (describe-function symbol)) + ((and symbol (boundp symbol)) + (describe-variable symbol)) + (t (apropos symbol-name))))) + +(defun erc-button-beats-to-time (beats) + "Display BEATS in a readable time format." + (let* ((seconds (- (* (string-to-number beats) 86.4) + 3600 + (- (car (current-time-zone))))) + (hours (mod (floor seconds 3600) 24)) + (minutes (mod (round seconds 60) 60))) + (message (format "@%s is %d:%02d local time" + beats hours minutes)))) + +(provide 'erc-button) + +;;; erc-button.el ends here +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;; arch-tag: 7d23bed4-2f30-4273-a03f-d7a274c605c4 diff --git a/lisp/erc-capab.el b/lisp/erc-capab.el new file mode 100644 index 0000000..4876dec --- /dev/null +++ b/lisp/erc-capab.el @@ -0,0 +1,208 @@ +;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB + +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; 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 3, 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 file defines the ERC module `erc-capab-identify', which allows +;; flagging of unidentified users on servers running dancer-ircd or +;; hyperion. freenode.net supports this capability, for example. + +;; With CAPAB IDENTIFY-MSG and IDENTIFY-CTCP enabled, messages from +;; users who have identified themselves to NickServ will have a plus +;; sign and messages from unidentified users will have a minus sign +;; added as a prefix. Note that it is not necessary for your nickname +;; to be identified in order to receive these marked messages. + +;; The plus or minus sign is removed from the message, and a prefix, +;; `erc-capab-identify-prefix', is inserted in the front of the user's +;; nickname if the nickname is not identified. + +;; Please note that once this has been enabled on a server, there is no +;; way to tell the server to stop sending marked messages. If you +;; disable this module, it will continue removing message flags, but the +;; unidentified nickname prefix will not be added to messages. + +;; Visit and +;; to find further +;; explanations of this capability. + +;; From freenode.net's web site (not there anymore) on how to mark +;; unidentified users: +;; "We recommend that you add an asterisk before the nick, and +;; optionally either highlight or colourize the line in some +;; appropriate fashion, if the user is not identified." + +;;; Usage: + +;; Put the following in your ~/.emacs file. + +;; (require 'erc-capab) +;; (erc-capab-identify-mode 1) + +;; `erc-capab-identify-prefix' will now be added to the beginning of +;; unidentified users' nicknames. The default is an asterisk, "*". +;; You can customize the prefix and the face used to display it, +;; `erc-capab-identify-unidentified'. If the value of +;; `erc-capab-identify-prefix' is nil or you disable this module (see +;; `erc-capab-identify-disable'), no prefix will be inserted, but the +;; flag sent by the server will still be stripped. + +;;; Code: + +(require 'erc) +(eval-when-compile (require 'cl)) + +;;; Customization: + +(defgroup erc-capab nil + "Support for dancer-ircd's CAPAB settings." + :group 'erc) + +(defcustom erc-capab-identify-prefix "*" + "The prefix used for unidentified users. + +If you change this from the default \"*\", be sure to use a +character not found in IRC nicknames to avoid confusion." + :group 'erc-capab + :type '(choice string (const nil))) + +(defface erc-capab-identify-unidentified '((t)) ; same as `erc-default-face' + "Face to use for `erc-capab-identify-prefix'." + :group 'erc-capab + :group 'erc-faces) + +;;; Define module: + +;;;###autoload (autoload 'erc-capab-identify-mode "erc-capab" nil t) +(define-erc-module capab-identify nil + "Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP." + ;; append so that `erc-server-parameters' is already set by `erc-server-005' + ((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t) + (add-hook 'erc-server-290-functions 'erc-capab-identify-activate) + (add-hook 'erc-server-PRIVMSG-functions + 'erc-capab-identify-remove/set-identified-flag) + (add-hook 'erc-server-NOTICE-functions + 'erc-capab-identify-remove/set-identified-flag) + (add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t) + (mapc (lambda (buffer) + (when buffer + (with-current-buffer buffer (erc-capab-identify-setup)))) + (erc-buffer-list 'erc-open-server-buffer-p))) + ((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup) + (remove-hook 'erc-server-290-functions 'erc-capab-identify-activate) + ;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks + ;; because there doesn't seem to be a way to tell the server to turn it off + (remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix))) + +;;; Variables: + +(defvar erc-capab-identify-activated nil + "CAPAB IDENTIFY-MSG has been activated.") +(make-variable-buffer-local 'erc-capab-identify-activated) + +(defvar erc-capab-identify-sent nil + "CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.") +(make-variable-buffer-local 'erc-capab-identify-sent) + +;;; Functions: + +(defun erc-capab-identify-setup (&optional proc parsed) + "Set up CAPAB IDENTIFY on the current server. + +Optional argument PROC is the current server's process. +Optional argument PARSED is the current message, a response struct. + +These arguments are sent to this function when called as a hook in +`erc-server-005-functions'." + (unless erc-capab-identify-sent + (erc-capab-identify-send-messages))) + +(defun erc-capab-identify-send-messages () + "Send CAPAB IDENTIFY messages if the server supports it." + (when (and (stringp erc-server-version) + (string-match "^\\(dancer-ircd\\|hyperion\\)" erc-server-version) + ;; could possibly check for '("IRCD" . "dancer") in + ;; `erc-server-parameters' instead of looking for a specific name + ;; in `erc-server-version' + (assoc "CAPAB" erc-server-parameters)) + (erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP") + (erc-server-send "CAPAB IDENTIFY-MSG") + (erc-server-send "CAPAB IDENTIFY-CTCP") + (setq erc-capab-identify-sent t))) + + +(defun erc-capab-identify-activate (proc parsed) + "Set `erc-capab-identify-activated' and display an activation message. + +PROC is the current server's process. +PARSED is an `erc-parsed' response struct." + (when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed)) + (string= "IDENTIFY-CTCP" (erc-response.contents parsed))) + (setq erc-capab-identify-activated t) + (erc-display-message + parsed 'notice 'active (format "%s activated" + (erc-response.contents parsed))))) + +(defun erc-capab-identify-remove/set-identified-flag (proc parsed) + "Remove PARSED message's id flag and add the `erc-identified' text property. + +PROC is the current server's process. +PARSED is an `erc-parsed' response struct." + (let ((msg (erc-response.contents parsed))) + (when (and erc-capab-identify-activated + (string-match "^\\([-\\+]\\)\\(.+\\)$" msg)) + (setf (erc-response.contents parsed) + (if erc-capab-identify-mode + (erc-propertize (match-string 2 msg) + 'erc-identified + (if (string= (match-string 1 msg) "+") + 1 + 0)) + (match-string 2 msg))) + nil))) + +(defun erc-capab-identify-add-prefix () + "Add `erc-capab-identify-prefix' to nickname if user is unidentified." + (when (and erc-capab-identify-prefix + (erc-with-server-buffer erc-capab-identify-activated)) + (goto-char (or (erc-find-parsed-property) (point-min))) + (let ((nickname (erc-capab-identify-get-unidentified-nickname + (erc-get-parsed-vector (point))))) + (when (and nickname + (goto-char (point-min)) + ;; assuming the first use of `nickname' is the sender's nick + (re-search-forward (regexp-quote nickname) nil t)) + (goto-char (match-beginning 0)) + (insert (erc-propertize erc-capab-identify-prefix + 'face 'erc-capab-identify-unidentified)))))) + +(defun erc-capab-identify-get-unidentified-nickname (parsed) + "Return the nickname of the user if unidentified. +PARSED is an `erc-parsed' response struct." + (when (and (erc-response-p parsed) + (equal 0 (get-text-property 0 'erc-identified + (erc-response.contents parsed)))) + (let ((nickuserhost (erc-get-parsed-vector-nick parsed))) + (when nickuserhost + (nth 0 (erc-parse-user nickuserhost)))))) + +(provide 'erc-capab) + +;; arch-tag: 27b6d668-7ee5-4e47-b9f0-27d7a4362062 +;;; erc-capab.el ends here diff --git a/lisp/erc-chess.el b/lisp/erc-chess.el new file mode 100644 index 0000000..94c8414 --- /dev/null +++ b/lisp/erc-chess.el @@ -0,0 +1,181 @@ +;;; erc-chess.el --- CTCP chess playing support for ERC + +;; Copyright (C) 2002, 2004, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: games, comm + +;; 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 3, 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 module requires chess.el by John Wiegley. +;; You need to have chess.el installed (load-path properly set) + +;;; Code: + +(require 'erc) +(require 'chess-network) +(require 'chess-display) +(require 'chess) + +;;;; Variables + +(defgroup erc-chess nil + "Playing chess over IRC." + :group 'erc) + +(defcustom erc-chess-verbose-flag nil + "*If non-nil, inform about bogus CTCP CHESS messages in the server buffer." + :group 'erc-chess + :type 'boolean) + +(defcustom erc-chess-debug-flag t + "*If non-nil, print all chess CTCP messages received in the server buffer." + :group 'erc-chess + :type 'boolean) + +;;;###autoload +(defvar erc-ctcp-query-CHESS-hook '(erc-chess-ctcp-query-handler)) + +(defvar erc-chess-alist nil + "Alist of chess sessions. It has the form of (NICK ENGINE)") +(make-variable-buffer-local 'erc-chess-alist) + +(defvar erc-chess-regexp-alist chess-network-regexp-alist) +(defvar erc-chess-partner) +(make-variable-buffer-local 'erc-chess-partner) + +;;;; Catalog messages + +(erc-define-catalog + 'english + '((ctcp-chess-debug . "CTCPchess: %n (%u@%h) sent: '%m'") + (ctcp-chess-quit . "Chess game with %n (%u@%h) quit"))) + + +(defun erc-chess-response-handler (event &rest args) + (when (and (eq event 'accept) + (eq chess-engine-pending-offer 'match)) + (let ((display (chess-game-data (chess-engine-game nil) 'display))) + (chess-display-enable-popup display) + (chess-display-popup display))) + + (apply 'chess-engine-default-handler event args)) + + +(defun erc-chess-handler (game event &rest args) + "Handle erc-chess events. +This is the main handler for the erc-chess module." + (cond + ((eq event 'initialize) + (setq erc-chess-partner (car args)) + (setq erc-server-process (nth 1 args)) + t) + + ((eq event 'send) + ;; Transmit the string given in `(car args)' to the nick + ;; saved in `erc-chess-partner'. + (let ((nick erc-chess-partner) + (msg (substring (car args) 0 (1- (length (car args)))))) + (erc-with-server-buffer + (erc-send-ctcp-message nick (concat "CHESS " msg) t)))) + + (t + (cond + ((eq event 'accept) + (let ((display (chess-game-data (chess-engine-game nil) 'display))) + (chess-display-enable-popup display) + (chess-display-popup display))) + + ((eq event 'destroy) + (let* ((buf (process-buffer erc-server-process)) + (nick (erc-downcase erc-chess-partner)) + (engine (current-buffer))) + (erc-with-server-buffer + (let ((elt (assoc nick erc-chess-alist))) + (when (and elt (eq (nth 1 elt) engine)) + (message "Removed from erc-chess-alist in destroy event") + (setq erc-chess-alist (delq elt erc-chess-alist)))))))) + + ;; Pass all other events down to chess-network + (apply 'chess-network-handler game event args)))) + +;;;; Game initialisation + +(defun erc-chess-engine-create (nick) + "Initialize a game for a particular nick. +This function adds to `erc-chess-alist' too." + ;; Maybe move that into the connect callback? + (let* ((objects (chess-session 'erc-chess t 'erc-chess-response-handler + nick erc-server-process)) + (engine (car objects)) + (display (cadr objects))) + (when engine + (if display + (chess-game-set-data (chess-display-game display) + 'display display)) + (push (list (erc-downcase nick) engine) erc-chess-alist) + engine))) + +;;;; IRC /commands + +;;;###autoload +(defun erc-cmd-CHESS (line &optional force) + "Initiate a chess game via CTCP to NICK. +NICK should be the first and only arg to /chess" + (cond + ((string-match (concat "^\\s-*\\(" erc-valid-nick-regexp "\\)\\s-*$") line) + (let ((nick (match-string 1 line))) + (erc-with-server-buffer + (if (assoc (erc-downcase nick) erc-chess-alist) + ;; Maybe check for correctly connected game, and switch here. + (erc-display-message + nil 'notice 'active + (concat "Invitation for a game already sent to " nick)) + (with-current-buffer (erc-chess-engine-create nick) + (erc-chess-handler nil 'match) + t))))) + (t nil))) + +;;; CTCP handler +;;;###autoload +(defun erc-chess-ctcp-query-handler (proc nick login host to msg) + (if erc-chess-debug-flag + (erc-display-message + nil 'notice (current-buffer) + 'ctcp-chess-debug ?n nick ?m msg ?u login ?h host)) + (when (string-match "^CHESS\\s-+\\(.*\\)$" msg) + (let ((str (concat (match-string 1 msg) "\n")) + (elt (assoc (erc-downcase nick) erc-chess-alist))) + (if (not elt) + (chess-engine-submit (erc-chess-engine-create nick) str) + (if (buffer-live-p (nth 1 elt)) + (chess-engine-submit (nth 1 elt) str) + (setq erc-chess-alist (delq elt erc-chess-alist))))))) + +(provide 'erc-chess) + +;;; erc-chess.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: beb148d1-db16-48da-8145-9f3a7ff27b7b diff --git a/lisp/erc-compat.el b/lisp/erc-compat.el new file mode 100644 index 0000000..0367a33 --- /dev/null +++ b/lisp/erc-compat.el @@ -0,0 +1,446 @@ +;;; erc-compat.el --- ERC compatibility code for XEmacs + +;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Alex Schroeder +;; URL: http://www.emacswiki.org/cgi-bin/wiki/ERC + +;; 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 3, 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 mostly defines stuff that cannot be worked around easily. + +;;; Code: + +;; erc-define-minor-mode: the easy-mmode-define-minor-mode available +;; in XEmacs' easy-mmode.el does not have the BODY argument. This +;; code has to work, even if somebody has defaliased +;; easy-mmode-define-minor-mode to define-minor-mode. The code runs a +;; test first, and if define-minor-mode works, it uninterns all the +;; symbols created, so nothing should be left behind. + +;;;###autoload (autoload 'erc-define-minor-mode "erc-compat") +(condition-case nil + (progn + (define-minor-mode erc-compat-test "Testing `define-minor-mode'." nil nil nil (ignore)) + (mapc 'unintern (apropos-internal "^erc-compat-test")) + (defalias 'erc-define-minor-mode 'define-minor-mode) + (put 'erc-define-minor-mode 'edebug-form-spec 'define-minor-mode)) + (error + (defmacro erc-define-minor-mode (mode doc &optional init-value lighter + keymap &rest body) + "Define a minor mode like in Emacs." + ;; Deal with at least /some/ keywords. + ;; the rest don't seem to be as important. + (let (keyw globalp group) + (while (keywordp (setq keyw (car body))) + (setq body (cdr body)) + (case keyw + (:global (setq globalp (pop body))) + (:group (setq group (pop body))) + (t (pop body)))) + `(progn + (if ,group + (defcustom ,mode ,init-value + "Non-nil if the corresponding mode is enabled." + :group ,group + :type 'boolean) + (defvar ,mode ,init-value + "Non-nil if the corresponding mode is enabled.")) + (unless ,globalp + (make-variable-buffer-local ',mode)) + (defun ,mode (&optional arg) + ,doc + (interactive) + (setq ,mode (if arg + (> (prefix-numeric-value arg) 0) + (not ,mode))) + ,@body + ,mode) + (add-minor-mode ,mode ,lighter ,keymap)))) + (put 'erc-define-minor-mode 'edebug-form-spec + '(&define name stringp + [&optional sexp sexp &or consp symbolp] + [&rest + [keywordp sexp]] + def-body)) + )) + +;; MULE: decode-coding-string and encode-coding-string -- note that +;; XEmacs' functions do not have the NOCOPY argument. + +;; latin-1 is only available as iso-8859-1 on XEmacs. Since that +;; works for both, we will use that. + +(condition-case nil + ;; Try 3 arguments + (progn + (decode-coding-string "a" 'iso-8859-1 t) + (defun erc-decode-coding-string (s coding-system) + "Decode S using CODING-SYSTEM." + (decode-coding-string s coding-system t))) + (error + (condition-case nil + ;; Try 2 arguments + (progn + (decode-coding-string "a" 'iso-8859-1) + (defun erc-decode-coding-string (s coding-system) + "Decode S using CODING-SYSTEM." + (decode-coding-string s coding-system))) + (error + ;; Default + (defun erc-decode-coding-string (s &rest ignore) + "Return S." + s))))) + +(condition-case nil + ;; Try 3 arguments + (progn + (encode-coding-string "a" 'iso-8859-1 t) + (defun erc-encode-coding-string (s coding-system) + "Encode S using CODING-SYSTEM. +Return the same string, if the encoding operation is trivial. +See `erc-encoding-coding-alist'." + (encode-coding-string s coding-system t))) + (error + (condition-case nil + ;; Try 2 arguments + (progn + (encode-coding-string "a" 'iso-8859-1) + (defun erc-encode-coding-string (s coding-system) + "Encode S using CODING-SYSTEM. +See `erc-encoding-coding-alist'." + (encode-coding-string s coding-system))) + (error + ;; Default + (defun erc-encode-coding-string (s &rest ignore) + "Return S unchanged." + s))))) + +(if (not (fboundp 'propertize)) + (defun erc-propertize (string &rest props) + (let ((string (copy-sequence string))) + (while props + (put-text-property 0 (length string) + (nth 0 props) (nth 1 props) string) + (setq props (cddr props))) + string)) + (defalias 'erc-propertize 'propertize)) + +;;; XEmacs does not have `view-mode-enter', but its `view-mode' has a +;;; similar argument list. And we need this in erc-match.el. + +;; Emacs view-mode-enter: (view-mode-enter &optional RETURN-TO +;; EXIT-ACTION) + +;; XEmacs view-mode: (view-mode &optional PREV-BUFFER EXIT-ACTION +;; CLEAN-BS) + +;; But note Emacs view-mode: (view-mode &optional ARG) + +(defun erc-view-mode-enter (&optional return-to exit-action) + "Enter View mode. +See either `view-mode-enter' (if using Emacs) +or `view-mode' (if using XEmacs) +to determine what the arguments accomplish. + +If we cannot find a suitable way of passing the arguments, we +default to just entering View mode." + (cond ((fboundp 'view-mode-enter) + (view-mode-enter return-to exit-action)) + ((featurep 'xemacs) + (condition-case nil + (view-mode return-to exit-action) + (view-mode 1))) + (t nil))) + +;; if we're in emacs21 CVS, we use help-function-arglist which is more +;; sophisticated and can handle subrs, etc +(if (fboundp 'help-function-arglist) + (defalias 'erc-function-arglist 'help-function-arglist) + (defun erc-function-arglist (fun) + "Returns the arglist signature of FUN" + (let ((def (symbol-function fun))) + (ignore-errors + ;; load an autoloaded function first + (when (equal 'autoload (car-safe def)) + (load (second def)) + (setq def (symbol-function fun))) + (if (listp def) + (second def) + (format "[Arglist not available, try %s instead]" + (substitute-command-keys "\\[describe-function]"))))))) + +;; XEmacs doesn't have `delete-dups'. Taken from subr.el. +(if (fboundp 'delete-dups) + (defalias 'erc-delete-dups 'delete-dups) + (defun erc-delete-dups (list) + "Destructively remove `equal' duplicates from LIST. +Store the result in LIST and return it. LIST must be a proper list. +Of several `equal' occurrences of an element in LIST, the first +one is kept." + (let ((tail list)) + (while tail + (setcdr tail (delete (car tail) (cdr tail))) + (setq tail (cdr tail)))) + list)) + +;;; XEmacs has `replace-in-string', Emacs has `replace-regexp-in-string': + +(cond ((fboundp 'replace-regexp-in-string) + (defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string)) + ((fboundp 'replace-in-string) + (defun erc-replace-regexp-in-string (regexp rep string &optional fixedcase literal) + (replace-in-string string regexp rep literal)))) + +;;; Several different Emacsen have different variables for setting +;;; write hooks. +(cond ((boundp 'write-file-functions) + (defun erc-set-write-file-functions (new-val) + (set (make-local-variable 'write-file-functions) new-val))) + ((boundp 'local-write-file-hooks) + (defun erc-set-write-file-functions (new-val) + (setq local-write-file-hooks new-val))) + (t + (defun erc-set-write-file-functions (new-val) + (set (make-local-variable 'write-file-hooks) new-val)))) + +;;; Done! + +;; XEmacs has a string representation of the build time. It's +;; possible for date-to-time to throw an "invalid date" error, so +;; we'll just use a string instead of a time. +(defvar erc-emacs-build-time + (if (stringp emacs-build-time) + emacs-build-time + (format-time-string "%Y-%m-%d" emacs-build-time)) + "Time at which Emacs was dumped out.") + +;; Emacs 21 and XEmacs do not have user-emacs-directory, but XEmacs +;; has user-init-directory. +(defvar erc-user-emacs-directory + (cond ((boundp 'user-emacs-directory) + user-emacs-directory) + ((boundp 'user-init-directory) + user-init-directory) + (t "~/.emacs.d/")) + "Directory beneath which additional per-user Emacs-specific files +are placed. +Note that this should end with a directory separator.") + +;; XEmacs' `replace-match' does not replace matching subexpressions in strings. +(defun erc-replace-match-subexpression-in-string + (newtext string match subexp start &optional fixedcase literal) + "Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT. +MATCH is the text which matched the subexpression (see `match-string'). +START is the beginning position of the last match (see `match-beginning'). +See `replace-match' for explanations of FIXEDCASE and LITERAL." + (cond ((featurep 'xemacs) + (string-match match string start) + (replace-match newtext fixedcase literal string)) + (t (replace-match newtext fixedcase literal string subexp)))) + +;; If a version of Emacs or XEmacs does not have gnus or tramp, they +;; will not have the format-spec library. We deal with this by +;; providing copies of its functions if the library is not available. +(condition-case nil + (require 'format-spec) + (error + (defun format-spec (format specification) + "Return a string based on FORMAT and SPECIFICATION. +FORMAT is a string containing `format'-like specs like \"bash %u %k\", +while SPECIFICATION is an alist mapping from format spec characters +to values." + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (cond + ;; Quoted percent sign. + ((eq (char-after) ?%) + (delete-char 1)) + ;; Valid format spec. + ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") + (let* ((num (match-string 1)) + (spec (string-to-char (match-string 2))) + (val (cdr (assq spec specification)))) + (delete-region (1- (match-beginning 0)) (match-end 0)) + (unless val + (error "Invalid format character: %s" spec)) + (insert (format (concat "%" num "s") val)))) + ;; Signal an error on bogus format strings. + (t + (error "Invalid format string")))) + (buffer-string))) + + (defun format-spec-make (&rest pairs) + "Return an alist suitable for use in `format-spec' based on PAIRS. +PAIRS is a list where every other element is a character and a value, +starting with a character." + (let (alist) + (while pairs + (unless (cdr pairs) + (error "Invalid list of pairs")) + (push (cons (car pairs) (cadr pairs)) alist) + (setq pairs (cddr pairs))) + (nreverse alist))))) + +;; Emacs21 does not have `with-selected-window', but Emacs22 and +;; XEmacs do. +(if (or (fboundp 'with-selected-window) + (condition-case nil + (progn + (require 'window) + (fboundp 'with-selected-window)) + (error nil))) + (defmacro erc-with-selected-window (window &rest body) + "Execute the forms in BODY with WINDOW as the selected window. +The value returned is the value of the last form in BODY." + (cons 'with-selected-window (cons window body))) + ;; ripped from subr.el in Emacs 22 + (defmacro erc-with-selected-window (window &rest body) + "Execute the forms in BODY with WINDOW as the selected window. +The value returned is the value of the last form in BODY." + `(let ((save-selected-window-window (selected-window)) + (save-selected-window-alist + (mapcar (lambda (frame) (list frame (frame-selected-window frame))) + (frame-list)))) + (save-current-buffer + (unwind-protect + (progn (select-window ,window 'norecord) + ,@body) + (dolist (elt save-selected-window-alist) + (and (frame-live-p (car elt)) + (window-live-p (cadr elt)) + (set-frame-selected-window (car elt) (cadr elt)))) + (if (window-live-p save-selected-window-window) + (select-window save-selected-window-window 'norecord))))))) + +(put 'erc-with-selected-window 'lisp-indent-function 1) +(put 'erc-with-selected-window 'edebug-form-spec '(form body)) + +;; Emacs has `cancel-timer', but XEmacs uses `delete-itimer'. +(defun erc-cancel-timer (timer) + (cond ((fboundp 'cancel-timer) + (cancel-timer timer)) + ((fboundp 'delete-itimer) + (delete-itimer timer)) + (t + (error "Cannot find `cancel-timer' variant")))) + +;; Emacs accepts three arguments to `make-obsolete', `make-obsolete-variable' +;; XEmacs only takes two arguments +(defun erc-make-obsolete (old-name new-name when) + "Make the byte-compiler warn that OLD-NAME is obsolete. +The warning will say that NEW-NAME should be used instead. +WHEN should be a string indicating when the function was +first made obsolete, either the file's revision number or an +ERC release version number." + (condition-case nil + (make-obsolete old-name new-name when) + (wrong-number-of-arguments (make-obsolete old-name new-name)))) + +(defun erc-make-obsolete-variable (old-name new-name when) + "Make the byte-compiler warn that OLD-NAME is obsolete. +The warning will say that NEW-NAME should be used instead. +WHEN should be a string indicating when the variable was +first made obsolete, either the file's revision number or an +ERC release version number." + (condition-case nil + (make-obsolete-variable old-name new-name when) + (wrong-number-of-arguments (make-obsolete-variable old-name new-name)))) + +;; Provide a simpler replacement for `member-if' +(defun erc-member-if (predicate list) + "Find the first item satisfying PREDICATE in LIST. +Return the sublist of LIST whose car matches." + (let ((ptr list)) + (catch 'found + (while ptr + (when (funcall predicate (car ptr)) + (throw 'found ptr)) + (setq ptr (cdr ptr)))))) + +;; Provide a simpler replacement for `delete-if' +(defun erc-delete-if (predicate seq) + "Remove all items satisfying PREDICATE in SEQ. +This is a destructive function: it reuses the storage of SEQ +whenever possible." + ;; remove from car + (while (when (funcall predicate (car seq)) + (setq seq (cdr seq)))) + ;; remove from cdr + (let ((ptr seq) + (next (cdr seq))) + (while next + (when (funcall predicate (car next)) + (setcdr ptr (if (consp next) + (cdr next) + nil))) + (setq ptr (cdr ptr)) + (setq next (cdr ptr)))) + seq) + +;; Provide a simpler replacement for `remove-if-not' +(defun erc-remove-if-not (predicate seq) + "Remove all items not satisfying PREDICATE in SEQ. +This is a non-destructive function; it makes a copy of SEQ to +avoid corrupting the original SEQ." + (let (newseq) + (dolist (el seq) + (when (funcall predicate el) + (setq newseq (cons el newseq)))) + (nreverse newseq))) + +;; Copied from cl-extra.el +(defun erc-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (if (stringp seq) (substring seq start end) + (let (len) + (and end (< end 0) (setq end (+ end (setq len (length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) + (cond ((listp seq) + (if (> start 0) (setq seq (nthcdr start seq))) + (if end + (let ((res nil)) + (while (>= (setq end (1- end)) start) + (push (pop seq) res)) + (nreverse res)) + (copy-sequence seq))) + (t + (or end (setq end (or len (length seq)))) + (let ((res (make-vector (max (- end start) 0) nil)) + (i 0)) + (while (< start end) + (aset res i (aref seq start)) + (setq i (1+ i) start (1+ start))) + res)))))) + +(provide 'erc-compat) + +;;; erc-compat.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 8948ffe0-aff8-4ad8-a196-368ebbfd58ff diff --git a/lisp/erc-dcc.el b/lisp/erc-dcc.el new file mode 100644 index 0000000..2aca064 --- /dev/null +++ b/lisp/erc-dcc.el @@ -0,0 +1,1186 @@ +;;; erc-dcc.el --- CTCP DCC module for ERC + +;; Copyright (C) 1993, 1994, 1995, 1998, 2002, 2003, 2004, 2006, 2007, 2008 +;; Free Software Foundation, Inc. + +;; Author: Ben A. Mesander +;; Noah Friedman +;; Per Persson +;; Maintainer: mlang@delysid.org +;; Keywords: comm, processes +;; Created: 1994-01-23 + +;; 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 3, 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 file provides Direct Client-to-Client support for ERC. +;; +;; The original code was taken from zenirc-dcc.el, heavily mangled and +;; rewritten to support the way how ERC operates. Server socket support +;; was added for DCC CHAT and SEND afterwards. Thanks +;; to the original authors for their work. + +;;; Usage: + +;; To use this file, put +;; (require 'erc-dcc) +;; in your .emacs. +;; +;; Provided commands +;; /dcc chat nick - Either accept pending chat offer from nick, or offer +;; DCC chat to nick +;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick +;; /dcc get nick [file] - Accept DCC offer from nick +;; /dcc list - List all DCC offers/connections +;; /dcc send nick file - Offer DCC SEND to nick +;; +;; Please note that offering DCC connections (offering chats and sending +;; files) is only supported with Emacs 22. + +;;; Code: + +(require 'erc) +(eval-when-compile + (require 'cl) + (require 'pcomplete)) + +;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") +(define-erc-module dcc nil + "Provide Direct Client-to-Client support for ERC." + ((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)) + ((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))) + +(defgroup erc-dcc nil + "DCC stands for Direct Client Communication, where you and your +friend's client programs connect directly to each other, +bypassing IRC servers and their occasional \"lag\" or \"split\" +problems. Like /MSG, the DCC chat is completely private. + +Using DCC get and send, you can transfer files directly from and to other +IRC users." + :group 'erc) + +(defcustom erc-dcc-verbose nil + "*If non-nil, be verbose about DCC activity reporting." + :group 'erc-dcc + :type 'boolean) + +(defvar erc-dcc-list nil + "List of DCC connections. Looks like: + ((:nick \"nick!user@host\" :type GET :peer proc :parent proc :size size :file file) + (:nick \"nick!user@host\" :type CHAT :peer proc :parent proc) + (:nick \"nick\" :type SEND :peer server-proc :parent parent-proc :file + file :sent :confirmed )) + + :nick - a user or userhost for the peer. combine with :parent to reach them + + :type - the type of DCC connection - SEND for outgoing files, GET for + incoming, and CHAT for both directions. To tell which end started + the DCC chat, look at :peer + + :peer - the other end of the DCC connection. In the case of outgoing DCCs, + this represents a server process until a connection is established + + :parent - the server process where the dcc connection was established. + Note that this can be nil or an invalid process since a DCC + connection is in general independent from a particular server + connection after it was established. + + :file - for outgoing sends, the full path to the file. for incoming sends, + the suggested filename or vetted filename + + :size - size of the file, may be nil on incoming DCCs") + +(defun erc-dcc-list-add (type nick peer parent &rest args) + "Add a new entry of type TYPE to `erc-dcc-list' and return it." + (car + (setq erc-dcc-list + (cons + (append (list :nick nick :type type :peer peer :parent parent) args) + erc-dcc-list)))) + +;; This function takes all the usual args as open-network-stream, plus one +;; more: the entry data from erc-dcc-list for this particular process. +(defvar erc-dcc-connect-function 'erc-dcc-open-network-stream) + +(defun erc-dcc-open-network-stream (procname buffer addr port entry) + (if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes + ;; cvs emacs + (open-network-stream-nowait procname buffer addr port) + (open-network-stream procname buffer addr port))) + +(erc-define-catalog + 'english + '((dcc-chat-discarded + . "DCC: previous chat request from %n (%u@%h) discarded") + (dcc-chat-ended . "DCC: chat with %n ended %t: %e") + (dcc-chat-no-request . "DCC: chat request from %n not found") + (dcc-chat-offered . "DCC: chat offered by %n (%u@%h:%p)") + (dcc-chat-offer . "DCC: offering chat to %n") + (dcc-chat-accept . "DCC: accepting chat from %n") + (dcc-chat-privmsg . "=%n= %m") + (dcc-closed . "DCC: Closed %T from %n") + (dcc-command-undefined + . "DCC: %c undefined subcommand. GET, CHAT and LIST are defined.") + (dcc-ctcp-errmsg . "DCC: `%s' is not a DCC subcommand known to this client") + (dcc-ctcp-unknown . "DCC: unknown dcc command `%q' from %n (%u@%h)") + (dcc-get-bytes-received . "DCC: %f: %b bytes received") + (dcc-get-complete + . "DCC: file %f transfer complete (%s bytes in %t seconds)") + (dcc-get-cmd-aborted . "DCC: Aborted getting %f from %n") + (dcc-get-file-too-long + . "DCC: %f: File longer than sender claimed; aborting transfer") + (dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer") + (dcc-list-head . "DCC: From Type Active Size Filename") + (dcc-list-line . "DCC: -------- ---- ------ ------------ --------") + (dcc-list-item . "DCC: %-8n %-4t %-6a %-12s %f") + (dcc-list-end . "DCC: End of list.") + (dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q") + (dcc-privileged-port + . "DCC: possibly bogus request: %p is a privileged port.") + (dcc-request-bogus . "DCC: bogus dcc `%r' from %n (%u@%h)") + (dcc-send-finished . "DCC: SEND of %f to %n finished (size %s)") + (dcc-send-offered . "DCC: file %f offered by %n (%u@%h) (size %s)") + (dcc-send-offer . "DCC: offering %f to %n"))) + +;;; Misc macros and utility functions + +(defun erc-dcc-member (&rest args) + "Return the first matching entry in `erc-dcc-list' which satisfies the +constraints given as a plist in ARGS. Returns nil on no match. + +The property :nick is treated specially, if it contains a '!' character, +it is treated as a nick!user@host string, and compared with the :nick property +value of the individual elements using string-equal. Otherwise it is +compared with `erc-nick-equal-p' which is IRC case-insensitive." + (let ((list erc-dcc-list) + result test) + ;; for each element in erc-dcc-list + (while (and list (not result)) + (let ((elt (car list)) + (prem args) + (cont t)) + ;; loop through the constraints + (while (and prem cont) + (let ((prop (car prem)) + (val (cadr prem))) + (setq prem (cddr prem) + ;; plist-member is a predicate in xemacs + test (and (plist-member elt prop) + (plist-get elt prop))) + ;; if the property exists and is equal, we continue, else, try the + ;; next element of the list + (or (and (eq prop :nick) (string-match "!" val) + test (string-equal test val)) + (and (eq prop :nick) + test val + (erc-nick-equal-p + (erc-extract-nick test) + (erc-extract-nick val))) + ;; not a nick + (eq test val) + (setq cont nil)))) + (if cont + (setq result elt) + (setq list (cdr list))))) + result)) + +(defun erc-pack-int (value) + "Convert an integer into a packed string." + (let* ((len (ceiling (/ value 256.0))) + (str (make-string len ?a)) + (i (1- len))) + (while (>= i 0) + (aset str i (% value 256)) + (setq value (/ value 256)) + (setq i (1- i))) + str)) + +(defun erc-unpack-int (str) + "Unpack a packed string into an integer." + (let ((len (length str)) + (num 0) + (count 0)) + (while (< count len) + (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) + (setq count (1+ count))) + num)) + +(defconst erc-dcc-ipv4-regexp + (concat "^" + (mapconcat #'identity (make-list 4 "\\([0-9]\\{1,3\\}\\)") "\\.") + "$")) + +(defun erc-ip-to-decimal (ip) + "Convert IP address to its decimal representation. +Argument IP is the address as a string. The result is also a string." + (interactive "sIP Address: ") + (if (not (string-match erc-dcc-ipv4-regexp ip)) + (error "Not an IP address") + (let* ((ips (mapcar + (lambda (str) + (let ((n (string-to-number str))) + (if (and (>= n 0) (< n 256)) + n + (error "%d out of range" n)))) + (split-string ip "\\."))) + (res (+ (* (car ips) 16777216.0) + (* (nth 1 ips) 65536.0) + (* (nth 2 ips) 256.0) + (nth 3 ips)))) + (if (interactive-p) + (message "%s is %.0f" ip res) + (format "%.0f" res))))) + +(defun erc-decimal-to-ip (dec) + "Convert a decimal representation DEC to an IP address. +The result is also a string." + (when (stringp dec) + (setq dec (string-to-number (concat dec ".0")))) + (let* ((first (floor (/ dec 16777216.0))) + (first-rest (- dec (* first 16777216.0))) + (second (floor (/ first-rest 65536.0))) + (second-rest (- first-rest (* second 65536.0))) + (third (floor (/ second-rest 256.0))) + (third-rest (- second-rest (* third 256.0))) + (fourth (floor third-rest))) + (format "%s.%s.%s.%s" first second third fourth))) + +;;; Server code + +(defcustom erc-dcc-listen-host nil + "IP address to listen on when offering files. +Should be set to a string or nil. If nil, automatic detection of +the host interface to use will be attempted." + :group 'erc-dcc + :type (list 'choice (list 'const :tag "Auto-detect" nil) + (list 'string :tag "IP-address" + :valid-regexp erc-dcc-ipv4-regexp))) + +(defcustom erc-dcc-public-host nil + "IP address to use for outgoing DCC offers. +Should be set to a string or nil. If nil, use the value of +`erc-dcc-listen-host'." + :group 'erc-dcc + :type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil) + (list 'string :tag "IP-address" + :valid-regexp erc-dcc-ipv4-regexp))) + +(defcustom erc-dcc-send-request 'ask + "*How to treat incoming DCC Send requests. +'ask - Report the Send request, and wait for the user to manually accept it + You might want to set `erc-dcc-auto-masks' for this. +'auto - Automatically accept the request and begin downloading the file +'ignore - Ignore incoming DCC Send requests completely." + :group 'erc-dcc + :type '(choice (const ask) (const auto) (const ignore))) + +(defun erc-dcc-get-host (proc) + "Returns the local IP address used for an open PROCess." + (format-network-address (process-contact proc :local) t)) + +(defun erc-dcc-host () + "Determine the IP address we are using. +If variable `erc-dcc-host' is non-nil, use it. Otherwise call +`erc-dcc-get-host' on the erc-server-process." + (or erc-dcc-listen-host (erc-dcc-get-host erc-server-process) + (error "Unable to determine local address"))) + +(defcustom erc-dcc-port-range nil + "If nil, any available user port is used for outgoing DCC connections. +If set to a cons, it specifies a range of ports to use in the form (min . max)" + :group 'erc-dcc + :type '(choice + (const :tag "Any port" nil) + (cons :tag "Port range" + (integer :tag "Lower port") + (integer :tag "Upper port")))) + +(defcustom erc-dcc-auto-masks nil + "List of regexps matching user identifiers whose DCC send offers should be +accepted automatically. A user identifier has the form \"nick!login@host\". +For instance, to accept all incoming DCC send offers automatically, add the +string \".*!.*@.*\" to this list." + :group 'erc-dcc + :type '(repeat regexp)) + +(defun erc-dcc-server (name filter sentinel) + "Start listening on a port for an incoming DCC connection. Returns the newly +created subprocess, or nil." + (let ((port (or (and erc-dcc-port-range (car erc-dcc-port-range)) t)) + (upper (and erc-dcc-port-range (cdr erc-dcc-port-range))) + process) + (while (not process) + (condition-case err + (progn + (setq process + (make-network-process :name name + :buffer nil + :host (erc-dcc-host) + :service port + :nowait t + :noquery nil + :filter filter + :sentinel sentinel + :log #'erc-dcc-server-accept + :server t)) + (when (processp process) + (when (fboundp 'set-process-coding-system) + (set-process-coding-system process 'binary 'binary)) + (when (fboundp 'set-process-filter-multibyte) + (set-process-filter-multibyte process nil)))) + (file-error + (unless (and (string= "Cannot bind server socket" (cadr err)) + (string= "address already in use" (caddr err))) + (signal (car err) (cdr err))) + (setq port (1+ port)) + (unless (< port upper) + (error "No available ports in erc-dcc-port-range"))))) + process)) + +(defun erc-dcc-server-accept (server client message) + "Log an accepted DCC offer, then terminate the listening process and set up +the accepted connection." + (erc-log (format "(erc-dcc-server-accept): server %s client %s message %s" + server client message)) + (when (and (string-match "^accept from " message) + (processp server) (processp client)) + (let ((elt (erc-dcc-member :peer server))) + ;; change the entry in erc-dcc-list from the listening process to the + ;; accepted process + (setq elt (plist-put elt :peer client)) + ;; delete the listening process, as we've accepted the connection + (delete-process server)))) + +;;; Interactive command handling + +(defcustom erc-dcc-get-default-directory nil + "*Default directory for incoming DCC file transfers. +If this is nil, then the current value of `default-directory' is used." + :group 'erc-dcc + :type '(choice (const nil :tag "Default directory") directory)) + +;;;###autoload +(defun erc-cmd-DCC (cmd &rest args) + "Parser for /dcc command. +This figures out the dcc subcommand and calls the appropriate routine to +handle it. The function dispatched should be named \"erc-dcc-do-FOO-command\", +where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." + (when cmd + (let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command")))) + (if fn + (apply fn erc-server-process args) + (erc-display-message + nil 'notice 'active + 'dcc-command-undefined ?c cmd) + (apropos "erc-dcc-do-.*-command") + t)))) + +;;;###autoload +(defun pcomplete/erc-mode/DCC () + "Provides completion for the /DCC command." + (pcomplete-here (append '("chat" "close" "get" "list") + (when (fboundp 'make-network-process) '("send")))) + (pcomplete-here + (case (intern (downcase (pcomplete-arg 1))) + (chat (mapcar (lambda (elt) (plist-get elt :nick)) + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) 'CHAT)) + erc-dcc-list))) + (close (remove-duplicates + (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) + erc-dcc-list) :test 'string=)) + (get (mapcar #'erc-dcc-nick + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) 'GET)) + erc-dcc-list))) + (send (pcomplete-erc-all-nicks)))) + (pcomplete-here + (case (intern (downcase (pcomplete-arg 2))) + (get (mapcar (lambda (elt) (plist-get elt :file)) + (erc-remove-if-not + #'(lambda (elt) + (and (eq (plist-get elt :type) 'GET) + (erc-nick-equal-p (erc-extract-nick + (plist-get elt :nick)) + (pcomplete-arg 1)))) + erc-dcc-list))) + (close (mapcar #'erc-dcc-nick + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) + (intern (upcase (pcomplete-arg 1))))) + erc-dcc-list))) + (send (pcomplete-entries))))) + +(defun erc-dcc-do-CHAT-command (proc &optional nick) + (when nick + (let ((elt (erc-dcc-member :nick nick :type 'CHAT :parent proc))) + (if (and elt (not (processp (plist-get elt :peer)))) + ;; accept an existing chat offer + ;; FIXME: perhaps /dcc accept like other clients? + (progn (erc-dcc-chat-accept elt erc-server-process) + (erc-display-message + nil 'notice 'active + 'dcc-chat-accept ?n nick) + t) + (erc-dcc-chat nick erc-server-process) + (erc-display-message + nil 'notice 'active + 'dcc-chat-offer ?n nick) + t)))) + +(defun erc-dcc-do-CLOSE-command (proc &optional type nick) + "/dcc close type nick +type and nick are optional." + ;; FIXME, should also work if only nick is specified + (when (string-match (concat "^\\s-*\\(\\S-+\\)? *\\(" + erc-valid-nick-regexp "\\)?\\s-*$") line) + (let ((type (when (match-string 1 line) + (intern (upcase (match-string 1 line))))) + (nick (match-string 2 line)) + (ret t)) + (while ret + (if nick + (setq ret (erc-dcc-member :type type :nick nick)) + (setq ret (erc-dcc-member :type type))) + (when ret + ;; found a match - delete process if it exists. + (and (processp (plist-get ret :peer)) + (delete-process (plist-get ret :peer))) + (setq erc-dcc-list (delq ret erc-dcc-list)) + (erc-display-message + nil 'notice 'active + 'dcc-closed + ?T (plist-get ret :type) + ?n (erc-extract-nick (plist-get ret :nick)))))) + t)) + +(defun erc-dcc-do-GET-command (proc nick &optional file) + (let* ((elt (erc-dcc-member :nick nick :type 'GET)) + (filename (or file (plist-get elt :file) "unknown"))) + (if elt + (let* ((file (read-file-name + (format "Local filename (default %s): " + (file-name-nondirectory filename)) + (or erc-dcc-get-default-directory + default-directory) + (expand-file-name (file-name-nondirectory filename) + (or erc-dcc-get-default-directory + default-directory))))) + (cond ((file-exists-p file) + (if (yes-or-no-p (format "File %s exists. Overwrite? " + file)) + (erc-dcc-get-file elt file proc) + (erc-display-message + nil '(notice error) proc + 'dcc-get-cmd-aborted + ?n nick ?f filename))) + (t + (erc-dcc-get-file elt file proc)))) + (erc-display-message + nil '(notice error) 'active + 'dcc-get-notfound ?n nick ?f filename)))) + +(defun erc-dcc-do-LIST-command (proc) + "This is the handler for the /dcc list command. +It lists the current state of `erc-dcc-list' in an easy to read manner." + (let ((alist erc-dcc-list) + size elt) + (erc-display-message + nil 'notice 'active + 'dcc-list-head) + (erc-display-message + nil 'notice 'active + 'dcc-list-line) + (while alist + (setq elt (car alist) + alist (cdr alist)) + + (setq size (or (and (plist-member elt :size) + (plist-get elt :size)) + "")) + (setq size + (cond ((null size) "") + ((numberp size) (number-to-string size)) + ((string= size "") "unknown"))) + (erc-display-message + nil 'notice 'active + 'dcc-list-item + ?n (erc-dcc-nick elt) + ?t (plist-get elt :type) + ?a (if (processp (plist-get elt :peer)) + (process-status (plist-get elt :peer)) + "no") + ?s (concat size + (if (and (eq 'GET (plist-get elt :type)) + (plist-member elt :file) + (buffer-live-p (get-buffer (plist-get elt :file))) + (plist-member elt :size)) + (concat " (" (number-to-string + (* 100 + (/ (buffer-size + (get-buffer (plist-get elt :file))) + (plist-get elt :size)))) + "%)"))) + ?f (or (and (plist-member elt :file) (plist-get elt :file)) ""))) + (erc-display-message + nil 'notice 'active + 'dcc-list-end) + t)) + +(defun erc-dcc-do-SEND-command (proc nick file) + "Offer FILE to NICK by sending a ctcp dcc send message." + (if (file-exists-p file) + (progn + (erc-display-message + nil 'notice 'active + 'dcc-send-offer ?n nick ?f file) + (erc-dcc-send-file nick file) t) + (erc-display-message nil '(notice error) proc "File not found") t)) + +;;; Server message handling (i.e. messages from remote users) + +;;;###autoload +(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC) + "Hook variable for CTCP DCC queries") + +(defvar erc-dcc-query-handler-alist + '(("SEND" . erc-dcc-handle-ctcp-send) + ("CHAT" . erc-dcc-handle-ctcp-chat))) + +;;;###autoload +(defun erc-ctcp-query-DCC (proc nick login host to query) + "The function called when a CTCP DCC request is detected by the client. +It examines the DCC subcommand, and calls the appropriate routine for +that subcommand." + (let* ((cmd (cadr (split-string query " "))) + (handler (cdr (assoc cmd erc-dcc-query-handler-alist)))) + (if handler + (funcall handler proc query nick login host to) + ;; FIXME: Send a ctcp error notice to the remote end? + (erc-display-message + nil '(notice error) proc + 'dcc-ctcp-unknown + ?q query ?n nick ?u login ?h host)))) + +(defconst erc-dcc-ctcp-query-send-regexp + "^DCC SEND \\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)") + +(defun erc-dcc-handle-ctcp-send (proc query nick login host to) + "This is called if a CTCP DCC SEND subcommand is sent to the client. +It extracts the information about the dcc request and adds it to +`erc-dcc-list'." + (unless (eq erc-dcc-send-request 'ignore) + (cond + ((not (erc-current-nick-p to)) + ;; DCC SEND requests must be sent to you, and you alone. + (erc-display-message + nil 'notice proc + 'dcc-request-bogus + ?r "SEND" ?n nick ?u login ?h host)) + ((string-match erc-dcc-ctcp-query-send-regexp query) + (let ((filename (match-string 1 query)) + (ip (erc-decimal-to-ip (match-string 2 query))) + (port (match-string 3 query)) + (size (match-string 4 query))) + ;; FIXME: a warning really should also be sent + ;; if the ip address != the host the dcc sender is on. + (erc-display-message + nil 'notice proc + 'dcc-send-offered + ?f filename ?n nick ?u login ?h host + ?s (if (string= size "") "unknown" size)) + (and (< (string-to-number port) 1025) + (erc-display-message + nil 'notice proc + 'dcc-privileged-port + ?p port)) + (erc-dcc-list-add + 'GET (format "%s!%s@%s" nick login host) + nil proc + :ip ip :port port :file filename + :size (string-to-number size)) + (if (and (eq erc-dcc-send-request 'auto) + (erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host))) + (erc-dcc-get-file (car erc-dcc-list) filename proc)))) + (t + (erc-display-message + nil 'notice proc + 'dcc-malformed + ?n nick ?u login ?h host ?q query))))) + +(defun erc-dcc-auto-mask-p (spec) + "Takes a full SPEC of a user in the form \"nick!login@host\" and +matches against all the regexp's in `erc-dcc-auto-masks'. If any +match, returns that regexp and nil otherwise." + (let ((lst erc-dcc-auto-masks)) + (while (and lst + (not (string-match (car lst) spec))) + (setq lst (cdr lst))) + (and lst (car lst)))) + +(defconst erc-dcc-ctcp-query-chat-regexp + "^DCC CHAT +chat +\\([0-9]+\\) +\\([0-9]+\\)") + +(defcustom erc-dcc-chat-request 'ask + "*How to treat incoming DCC Chat requests. +'ask - Report the Chat request, and wait for the user to manually accept it +'auto - Automatically accept the request and open a new chat window +'ignore - Ignore incoming DCC chat requests completely." + :group 'erc-dcc + :type '(choice (const ask) (const auto) (const ignore))) + +(defun erc-dcc-handle-ctcp-chat (proc query nick login host to) + (unless (eq erc-dcc-chat-request 'ignore) + (cond + (;; DCC CHAT requests must be sent to you, and you alone. + (not (erc-current-nick-p to)) + (erc-display-message + nil '(notice error) proc + 'dcc-request-bogus ?r "CHAT" ?n nick ?u login ?h host)) + ((string-match erc-dcc-ctcp-query-chat-regexp query) + ;; We need to use let* here, since erc-dcc-member might clutter + ;; the match value. + (let* ((ip (erc-decimal-to-ip (match-string 1 query))) + (port (match-string 2 query)) + (elt (erc-dcc-member :nick nick :type 'CHAT))) + ;; FIXME: A warning really should also be sent if the ip + ;; address != the host the dcc sender is on. + (erc-display-message + nil 'notice proc + 'dcc-chat-offered + ?n nick ?u login ?h host ?p port) + (and (< (string-to-number port) 1025) + (erc-display-message + nil 'notice proc + 'dcc-privileged-port ?p port)) + (cond (elt + ;; XXX: why are we updating ip/port on the existing connection? + (setq elt (plist-put (plist-put elt :port port) :ip ip)) + (erc-display-message + nil 'notice proc + 'dcc-chat-discarded ?n nick ?u login ?h host)) + (t + (erc-dcc-list-add + 'CHAT (format "%s!%s@%s" nick login host) + nil proc + :ip ip :port port))) + (if (eq erc-dcc-chat-request 'auto) + (erc-dcc-chat-accept (erc-dcc-member :nick nick :type 'CHAT) + proc)))) + (t + (erc-display-message + nil '(notice error) proc + 'dcc-malformed ?n nick ?u login ?h host ?q query))))) + + +(defvar erc-dcc-entry-data nil + "Holds the `erc-dcc-list' entry for this DCC connection.") +(make-variable-buffer-local 'erc-dcc-entry-data) + +;;; SEND handling + +(defcustom erc-dcc-block-size 1024 + "*Block size to use for DCC SEND sessions." + :group 'erc-dcc + :type 'integer) + +(defcustom erc-dcc-pump-bytes nil + "*If set to an integer, keep sending until that number of bytes are +unconfirmed." + :group 'erc-dcc + :type '(choice (const nil) integer)) + +(defsubst erc-dcc-get-parent (proc) + (plist-get (erc-dcc-member :peer proc) :parent)) + +(defun erc-dcc-send-block (proc) + "Send one block of data. +PROC is the process-object of the DCC connection. Returns the number of +bytes sent." + (let* ((elt (erc-dcc-member :peer proc)) + (confirmed-marker (plist-get elt :sent)) + (sent-marker (plist-get elt :sent))) + (with-current-buffer (process-buffer proc) + (when erc-dcc-verbose + (erc-display-message + nil 'notice (erc-dcc-get-parent proc) + (format "DCC: Confirmed %d, sent %d, sending block now" + (- confirmed-marker (point-min)) + (- sent-marker (point-min))))) + (let* ((end (min (+ sent-marker erc-dcc-block-size) + (point-max))) + (string (buffer-substring-no-properties sent-marker end))) + (when (< sent-marker end) + (set-marker sent-marker end) + (process-send-string proc string)) + (length string))))) + +(defun erc-dcc-send-filter (proc string) + (let* ((size (erc-unpack-int string)) + (elt (erc-dcc-member :peer proc)) + (parent (plist-get elt :parent)) + (sent-marker (plist-get elt :sent)) + (confirmed-marker (plist-get elt :confirmed))) + (with-current-buffer (process-buffer proc) + (set-marker confirmed-marker (+ (point-min) size)) + (cond + ((and (= confirmed-marker sent-marker) + (= confirmed-marker (point-max))) + (erc-display-message + nil 'notice parent + 'dcc-send-finished + ?n (plist-get elt :nick) + ?f buffer-file-name + ?s (number-to-string (- sent-marker (point-min)))) + (setq erc-dcc-list (delete elt erc-dcc-list)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)) + (delete-process proc)) + ((<= confirmed-marker sent-marker) + (while (and (< (- sent-marker confirmed-marker) + (or erc-dcc-pump-bytes + erc-dcc-block-size)) + (> (erc-dcc-send-block proc) 0)))) + ((> confirmed-marker sent-marker) + (erc-display-message + nil 'notice parent + (format "DCC: Client confirmed too much (%s vs %s)!" + (marker-position confirmed-marker) + (marker-position sent-marker))) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)) + (delete-process proc)))))) + +(defun erc-dcc-display-send (proc) + (erc-display-message + nil 'notice (erc-dcc-get-parent proc) + (format "DCC: SEND connect from %s" + (format-network-address (process-contact proc :remote))))) + +(defcustom erc-dcc-send-connect-hook + '(erc-dcc-display-send erc-dcc-send-block) + "*Hook run whenever the remote end of a DCC SEND offer connected to your +listening port." + :group 'erc-dcc + :type 'hook) + +(defun erc-dcc-nick (plist) + "Extract the nickname portion of the :nick property value in PLIST." + (erc-extract-nick (plist-get plist :nick))) + +(defun erc-dcc-send-sentinel (proc event) + (let* ((elt (erc-dcc-member :peer proc))) + (cond + ((string-match "^open from " event) + (when elt + (let ((buf (marker-buffer (plist-get elt :sent)))) + (with-current-buffer buf + (set-process-buffer proc buf) + (setq erc-dcc-entry-data elt))) + (run-hook-with-args 'erc-dcc-send-connect-hook proc)))))) + +(defun erc-dcc-find-file (file) + (with-current-buffer (generate-new-buffer (file-name-nondirectory file)) + (insert-file-contents-literally file) + (setq buffer-file-name file) + (current-buffer))) + +(defun erc-dcc-file-to-name (file) + (with-temp-buffer + (insert (file-name-nondirectory file)) + (subst-char-in-region (point-min) (point-max) ? ?_ t) + (buffer-string))) + +(defun erc-dcc-send-file (nick file &optional pproc) + "Open a socket for incoming connections, and send a CTCP send request to the +other client." + (interactive "sNick: \nfFile: ") + (when (null pproc) (if (processp erc-server-process) + (setq pproc erc-server-process) + (error "Can not find parent process"))) + (if (featurep 'make-network-process) + (let* ((buffer (erc-dcc-find-file file)) + (size (buffer-size buffer)) + (start (with-current-buffer buffer + (set-marker (make-marker) (point-min)))) + (sproc (erc-dcc-server "dcc-send" + 'erc-dcc-send-filter + 'erc-dcc-send-sentinel)) + (contact (process-contact sproc))) + (erc-dcc-list-add + 'SEND nick sproc pproc + :file file :size size + :sent start :confirmed (copy-marker start)) + (process-send-string + pproc (format "PRIVMSG %s :\C-aDCC SEND %s %s %d %d\C-a\n" + nick (erc-dcc-file-to-name file) + (erc-ip-to-decimal (or erc-dcc-public-host + (nth 0 contact))) + (nth 1 contact) + size))) + (error "`make-network-process' not supported by your Emacs"))) + +;;; GET handling + +(defcustom erc-dcc-receive-cache (* 1024 512) + "Number of bytes to let the receive buffer grow before flushing it." + :group 'erc-dcc + :type 'integer) + +(defvar erc-dcc-byte-count nil) +(make-variable-buffer-local 'erc-dcc-byte-count) +(defvar erc-dcc-file-name nil) +(make-variable-buffer-local 'erc-dcc-file-name) + +(defun erc-dcc-get-file (entry file parent-proc) + "This function does the work of setting up a transfer from the remote client +to the local one over a tcp connection. This involves setting up a process +filter and a process sentinel, and making the connection." + (let* ((buffer (generate-new-buffer (file-name-nondirectory file))) + proc) + (with-current-buffer buffer + (fundamental-mode) + (buffer-disable-undo (current-buffer)) + ;; This is necessary to have the buffer saved as-is in GNU + ;; Emacs. + ;; XEmacs change: We don't have `set-buffer-multibyte', setting + ;; coding system to 'binary below takes care of us. + (when (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) + + (setq mode-line-process '(":%s") + buffer-file-type t + buffer-read-only t) + (setq erc-dcc-file-name file) + + ;; Truncate the given file to size 0 before appending to it. + (write-region (point) (point) erc-dcc-file-name nil 'nomessage) + + (setq erc-server-process parent-proc + erc-dcc-entry-data entry) + (setq erc-dcc-byte-count 0) + (setq proc + (funcall erc-dcc-connect-function + "dcc-get" buffer + (plist-get entry :ip) + (string-to-number (plist-get entry :port)) + entry)) + (set-process-buffer proc buffer) + (set-process-coding-system proc 'binary 'binary) + (set-buffer-file-coding-system 'binary t) + + (set-process-filter proc 'erc-dcc-get-filter) + (set-process-sentinel proc 'erc-dcc-get-sentinel) + (setq entry (plist-put entry :start-time (erc-current-time))) + (setq entry (plist-put entry :peer proc))))) + +(defun erc-dcc-append-contents (buffer file) + "Append the contents of BUFFER to FILE. +The contents of the BUFFER will then be erased." + (with-current-buffer buffer + (let ((coding-system-for-write 'binary)) + (write-region (point-min) (point-max) erc-dcc-file-name t 'nomessage) + (erase-buffer)))) + +(defun erc-dcc-get-filter (proc str) + "This is the process filter for transfers from other clients to this one. +It reads incoming bytes from the network and stores them in the DCC +buffer, and sends back the replies after each block of data per the DCC +protocol spec. Well not really. We write back a reply after each read, +rather than every 1024 byte block, but nobody seems to care." + (with-current-buffer (process-buffer proc) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert (string-make-unibyte str)) + + (setq erc-dcc-byte-count (+ (length str) erc-dcc-byte-count)) + (when (> (point-max) erc-dcc-receive-cache) + (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) + + (and erc-dcc-verbose + (erc-display-message + nil 'notice erc-server-process + 'dcc-get-bytes-received + ?f (file-name-nondirectory buffer-file-name) + ?b (number-to-string erc-dcc-byte-count))) + (cond + ((and (> (plist-get erc-dcc-entry-data :size) 0) + (> erc-dcc-byte-count (plist-get erc-dcc-entry-data :size))) + (erc-display-message + nil '(error notice) 'active + 'dcc-get-file-too-long + ?f (file-name-nondirectory buffer-file-name)) + (delete-process proc)) + (t + (process-send-string + proc (erc-pack-int erc-dcc-byte-count))))))) + + +(defun erc-dcc-get-sentinel (proc event) + "This is the process sentinel for CTCP DCC SEND connections. +It shuts down the connection and notifies the user that the +transfer is complete." + ;; FIXME, we should look at EVENT, and also check size. + (with-current-buffer (process-buffer proc) + (delete-process proc) + (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) + (unless (= (point-min) (point-max)) + (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count)) + (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) + (erc-display-message + nil 'notice erc-server-process + 'dcc-get-complete + ?f erc-dcc-file-name + ?s (number-to-string erc-dcc-byte-count) + ?t (format "%.0f" + (erc-time-diff (plist-get erc-dcc-entry-data :start-time) + (erc-current-time))))) + (kill-buffer (process-buffer proc)) + (delete-process proc)) + +;;; CHAT handling + +(defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s" + "*Format to use for DCC Chat buffer names." + :group 'erc-dcc + :type 'string) + +(defcustom erc-dcc-chat-mode-hook nil + "*Hook calls when `erc-dcc-chat-mode' finished setting up the buffer." + :group 'erc-dcc + :type 'hook) + +(defcustom erc-dcc-chat-connect-hook nil + "" + :group 'erc-dcc + :type 'hook) + +(defcustom erc-dcc-chat-exit-hook nil + "" + :group 'erc-dcc + :type 'hook) + +(defun erc-cmd-CREQ (line &optional force) + "Set or get the DCC chat request flag. +Possible values are: ask, auto, ignore." + (when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line) + (let ((cmd (match-string 1 line))) + (if (stringp cmd) + (erc-display-message + nil 'notice 'active + (format "Set DCC Chat requests to %S" + (setq erc-dcc-chat-request (intern cmd)))) + (erc-display-message nil 'notice 'active + (format "DCC Chat requests are set to %S" + erc-dcc-chat-request))) + t))) + +(defun erc-cmd-SREQ (line &optional force) + "Set or get the DCC send request flag. +Possible values are: ask, auto, ignore." + (when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line) + (let ((cmd (match-string 1 line))) + (if (stringp cmd) + (erc-display-message + nil 'notice 'active + (format "Set DCC Send requests to %S" + (setq erc-dcc-send-request (intern cmd)))) + (erc-display-message nil 'notice 'active + (format "DCC Send requests are set to %S" + erc-dcc-send-request))) + t))) + +(defun pcomplete/erc-mode/CREQ () + (pcomplete-here '("auto" "ask" "ignore"))) +(defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ) + +(defvar erc-dcc-chat-filter-hook '(erc-dcc-chat-parse-output) + "*Hook to run after doing parsing (and possible insertion) of DCC messages.") + +(defvar erc-dcc-chat-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'erc-send-current-line) + (define-key map "\t" 'erc-complete-word) + map) + "Keymap for `erc-dcc-mode'.") + +(defun erc-dcc-chat-mode () + "Major mode for wasting time via DCC chat." + (interactive) + (kill-all-local-variables) + (setq mode-line-process '(":%s") + mode-name "DCC-Chat" + major-mode 'erc-dcc-chat-mode + erc-send-input-line-function 'erc-dcc-chat-send-input-line + erc-default-recipients '(dcc)) + (use-local-map erc-dcc-chat-mode-map) + (run-hooks 'erc-dcc-chat-mode-hook)) + +(defun erc-dcc-chat-send-input-line (recipient line &optional force) + "Send LINE to the remote end. +Argument RECIPIENT should always be the symbol dcc, and force +is ignored." + ;; FIXME: We need to get rid of all force arguments one day! + (if (eq recipient 'dcc) + (process-send-string + (get-buffer-process (current-buffer)) line) + (error "erc-dcc-chat-send-input-line in %s" (current-buffer)))) + +(defun erc-dcc-chat (nick &optional pproc) + "Open a socket for incoming connections, and send a chat request to the +other client." + (interactive "sNick: ") + (when (null pproc) (if (processp erc-server-process) + (setq pproc erc-server-process) + (error "Can not find parent process"))) + (let* ((sproc (erc-dcc-server "dcc-chat-out" + 'erc-dcc-chat-filter + 'erc-dcc-chat-sentinel)) + (contact (process-contact sproc))) + (erc-dcc-list-add 'OCHAT nick sproc pproc) + (process-send-string pproc + (format "PRIVMSG %s :\C-aDCC CHAT chat %s %d\C-a\n" + nick + (erc-ip-to-decimal (nth 0 contact)) (nth 1 contact))))) + +(defvar erc-dcc-from) +(make-variable-buffer-local 'erc-dcc-from) + +(defvar erc-dcc-unprocessed-output) +(make-variable-buffer-local 'erc-dcc-unprocessed-output) + +(defun erc-dcc-chat-setup (entry) + "Setup a DCC chat buffer, returning the buffer." + (let* ((nick (erc-extract-nick (plist-get entry :nick))) + (buffer (generate-new-buffer + (format erc-dcc-chat-buffer-name-format nick))) + (proc (plist-get entry :peer)) + (parent-proc (plist-get entry :parent))) + (erc-setup-buffer buffer) + ;; buffer is now the current buffer. + (erc-dcc-chat-mode) + (setq erc-server-process parent-proc) + (setq erc-dcc-from nick) + (setq erc-dcc-entry-data entry) + (setq erc-dcc-unprocessed-output "") + (setq erc-insert-marker (set-marker (make-marker) (point-max))) + (setq erc-input-marker (make-marker)) + (erc-display-prompt buffer (point-max)) + (set-process-buffer proc buffer) + (add-hook 'kill-buffer-hook 'erc-dcc-chat-buffer-killed nil t) + (run-hook-with-args 'erc-dcc-chat-connect-hook proc) + buffer)) + +(defun erc-dcc-chat-accept (entry parent-proc) + "Accept an incoming DCC connection and open a DCC window" + (let* ((nick (erc-extract-nick (plist-get entry :nick))) + buffer proc) + (setq proc + (funcall erc-dcc-connect-function + "dcc-chat" nil + (plist-get entry :ip) + (string-to-number (plist-get entry :port)) + entry)) + ;; XXX: connected, should we kill the ip/port properties? + (setq entry (plist-put entry :peer proc)) + (setq entry (plist-put entry :parent parent-proc)) + (set-process-filter proc 'erc-dcc-chat-filter) + (set-process-sentinel proc 'erc-dcc-chat-sentinel) + (setq buffer (erc-dcc-chat-setup entry)))) + +(defun erc-dcc-chat-filter (proc str) + (let ((orig-buffer (current-buffer))) + (unwind-protect + (progn + (set-buffer (process-buffer proc)) + (setq erc-dcc-unprocessed-output + (concat erc-dcc-unprocessed-output str)) + (run-hook-with-args 'erc-dcc-chat-filter-hook proc + erc-dcc-unprocessed-output)) + (set-buffer orig-buffer)))) + +(defun erc-dcc-chat-parse-output (proc str) + (save-match-data + (let ((posn 0) + line) + (while (string-match "\n" str posn) + (setq line (substring str posn (match-beginning 0))) + (setq posn (match-end 0)) + (erc-display-message + nil nil proc + 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'face + 'erc-nick-default-face) ?m line)) + (setq erc-dcc-unprocessed-output (substring str posn))))) + +(defun erc-dcc-chat-buffer-killed () + (erc-dcc-chat-close "killed buffer")) + +(defun erc-dcc-chat-close (&optional event) + "Close a DCC chat, removing any associated processes and tidying up +`erc-dcc-list'" + (let ((proc (plist-get erc-dcc-entry-data :peer)) + (evt (or event ""))) + (when proc + (setq erc-dcc-list (delq erc-dcc-entry-data erc-dcc-list)) + (run-hook-with-args 'erc-dcc-chat-exit-hook proc) + (delete-process proc) + (erc-display-message + nil 'notice erc-server-process + 'dcc-chat-ended ?n erc-dcc-from ?t (current-time-string) ?e evt) + (setq erc-dcc-entry-data (plist-put erc-dcc-entry-data :peer nil))))) + +(defun erc-dcc-chat-sentinel (proc event) + (let ((buf (current-buffer)) + (elt (erc-dcc-member :peer proc))) + ;; the sentinel is also notified when the connection is opened, so don't + ;; immediately kill it again + ;(message "buf %s elt %S evt %S" buf elt event) + (unwind-protect + (if (string-match "^open from" event) + (erc-dcc-chat-setup elt) + (erc-dcc-chat-close event)) + (set-buffer buf)))) + +(defun erc-dcc-no-such-nick (proc parsed) + "Detect and handle no-such-nick replies from the IRC server." + (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed)) + :parent proc)) + (peer (plist-get elt :peer))) + (when (or (and (processp peer) (not (eq (process-status peer) 'open))) + elt) + ;; Since we already created an entry before sending the CTCP + ;; message, we now remove it, if it doesn't point to a process + ;; which is already open. + (setq erc-dcc-list (delq elt erc-dcc-list)) + (if (processp peer) (delete-process peer))) + nil)) + +(provide 'erc-dcc) + +;;; erc-dcc.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;; arch-tag: cda5a6b3-c510-4dbe-b699-84cccfa04edb diff --git a/lisp/erc-ezbounce.el b/lisp/erc-ezbounce.el new file mode 100644 index 0000000..ff04129 --- /dev/null +++ b/lisp/erc-ezbounce.el @@ -0,0 +1,180 @@ +;;; erc-ezbounce.el --- Handle EZBounce bouncer commands + +;; Copyright (C) 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Andreas Fuchs +;; Keywords: comm + +;; 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 3, 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: + +;;; Code: + +(require 'erc) +(eval-when-compile (require 'cl)) + +(defgroup erc-ezbounce nil + "Interface to the EZBounce IRC bouncer (a virtual IRC server)" + :group 'erc) + +(defcustom erc-ezb-regexp "^ezbounce!srv$" + "Regexp used by the EZBouncer to identify itself to the user." + :group 'erc-ezbounce + :type 'string) + +(defcustom erc-ezb-login-alist '() + "Alist of logins suitable for the server we're connecting to. + +The alist's format is as follows: + + (((server . port) . (username . password)) + ((server . port) . (username . password)) + ...)" + :group 'erc-ezbounce + :type '(repeat + (cons (cons :tag "Server" + string + string) + (cons :tag "Login" + string + string)))) + +(defvar erc-ezb-action-alist '(("^\\[awaiting login/pass command\\]$" . erc-ezb-identify) + ("^\\[use /quote CONN to connect\\]$" . erc-ezb-select) + ("^ID +IRC NICK +TO +TIME$" . erc-ezb-init-session-list) + ("^$" . erc-ezb-end-of-session-list) + (".*" . erc-ezb-add-session)) + "Alist of actions to take on NOTICEs from EZBounce.") + + +(defvar erc-ezb-session-list '() + "List of detached EZBounce sessions.") +(make-variable-buffer-local 'erc-ezb-session-list) + +(defvar erc-ezb-inside-session-listing nil + "Indicate whether current notices are expected to be EZB session listings.") + +;;;###autoload +(defun erc-cmd-ezb (line &optional force) + "Send EZB commands to the EZBouncer verbatim." + (erc-server-send (concat "EZB " line))) +(put 'erc-cmd-EZB 'do-not-parse-args t) + +;;;###autoload +(defun erc-ezb-get-login (server port) + "Return an appropriate EZBounce login for SERVER and PORT. +Look up entries in `erc-ezb-login-alist'. If the username or password +in the alist is `nil', prompt for the appropriate values." + (let ((login (cdr (assoc (cons server port) erc-ezb-login-alist)))) + (when login + (let ((username (car login)) + (password (cdr login))) + (when (null username) + (setq username (read-from-minibuffer (format "EZBounce user name for %s:%s: " server port)))) + (when (null password) + (setq password (read-passwd (format "EZBounce password for %s:%s: " server port)))) + (cons username password))))) + +;;;###autoload +(defun erc-ezb-lookup-action (message) + (let ((function-alist erc-ezb-action-alist) + found) + (while (and (not found) + function-alist) + (let ((regexp (caar function-alist)) + (function (cdar function-alist))) + (when (string-match regexp message) + (setq found function)) + (setq function-alist (cdr function-alist)))) + found)) + +;;;###autoload +(defun erc-ezb-notice-autodetect (proc parsed) + "React on an EZBounce NOTICE request." + (let* ((sender (erc-response.sender parsed)) + (message (erc-response.contents parsed)) + (function (erc-ezb-lookup-action message))) + (when (and (string-match erc-ezb-regexp sender) + function) + (funcall function message))) + nil) + +;;;###autoload +(defun erc-ezb-identify (message) + "Identify to the EZBouncer server." + (let ((login (erc-ezb-get-login erc-session-server (erc-port-to-string erc-session-port)))) + (unless (null login) + (let ((username (car login)) + (pass (cdr login))) + (erc-server-send (concat "LOGIN " username " " pass)))))) + +;;;###autoload +(defun erc-ezb-init-session-list (message) + "Reset the EZBounce session list to nil." + (setq erc-ezb-session-list nil) + (setq erc-ezb-inside-session-listing t)) + +;;;###autoload +(defun erc-ezb-end-of-session-list (message) + "Indicate the end of the EZBounce session listing." + (setq erc-ezb-inside-session-listing nil)) + +;;;###autoload +(defun erc-ezb-add-session (message) + "Add an EZBounce session to the session list." + (when (and erc-ezb-inside-session-listing + (string-match "^\\([^ \n]+\\) +\\([^ \n]+\\) +\\([^ \n]+\\) +\\([^ \n]+\\)$" message)) + (let ((id (match-string 1 message)) + (nick (match-string 2 message)) + (to (match-string 3 message))) + (add-to-list 'erc-ezb-session-list (list id nick to))))) + +;;;###autoload +(defun erc-ezb-select (message) + "Select an IRC server to use by EZBounce, in ERC style." + (unless (and erc-ezb-session-list + (erc-ezb-select-session)) + (let* ((server (read-from-minibuffer + "IRC server: " "" nil nil 'erc-server-history-list)) + (port + (erc-string-to-port + (read-from-minibuffer "IRC port: " + (erc-port-to-string "6667"))))) + (erc-server-send (format "CONN %s %s" server port))))) + + +;;;###autoload +(defun erc-ezb-select-session () + "Select a detached EZBounce session." + (let ((session (completing-read "Existing Session (RET to enter a new one): " + erc-ezb-session-list))) + (if (string= session "") + nil + (erc-server-send (format "REATTACH %s" session))))) + + +;;;###autoload +(defun erc-ezb-initialize () + "Add EZBouncer convenience functions to ERC." + (add-hook 'erc-server-NOTICE-functions 'erc-ezb-notice-autodetect)) + +(provide 'erc-ezbounce) + +;; arch-tag: e972aa7b-a9f4-4d16-a489-074ec7a1002e +;;; erc-ezbounce.el ends here diff --git a/lisp/erc-fill.el b/lisp/erc-fill.el new file mode 100644 index 0000000..6ef5774 --- /dev/null +++ b/lisp/erc-fill.el @@ -0,0 +1,198 @@ +;;; erc-fill.el --- Filling IRC messages in various ways + +;; Copyright (C) 2001, 2002, 2003, 2004, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + +;; Author: Andreas Fuchs +;; Mario Lang +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling + +;; 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 3, 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 package implements filling of messages sent and received. Use +;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to +;; change the style. + +;;; Code: + +(require 'erc) +(require 'erc-stamp); for the timestamp stuff + +(defgroup erc-fill nil + "Filling means to reformat long lines in different ways." + :group 'erc) + +;;;###autoload (autoload 'erc-fill-mode "erc-fill" nil t) +(erc-define-minor-mode erc-fill-mode + "Toggle ERC fill mode. +With numeric arg, turn ERC fill mode on if and only if arg is +positive. In ERC fill mode, messages in the channel buffers are +filled." + nil nil nil + :global t :group 'erc-fill + (if erc-fill-mode + (erc-fill-enable) + (erc-fill-disable))) + +(defun erc-fill-enable () + "Setup hooks for `erc-fill-mode'." + (interactive) + (add-hook 'erc-insert-modify-hook 'erc-fill) + (add-hook 'erc-send-modify-hook 'erc-fill)) + +(defun erc-fill-disable () + "Cleanup hooks, disable `erc-fill-mode'." + (interactive) + (remove-hook 'erc-insert-modify-hook 'erc-fill) + (remove-hook 'erc-send-modify-hook 'erc-fill)) + +(defcustom erc-fill-prefix nil + "Values used as `fill-prefix' for `erc-fill-variable'. +nil means fill with space, a string means fill with this string." + :group 'erc-fill + :type '(choice (const nil) string)) + +(defcustom erc-fill-function 'erc-fill-variable + "Function to use for filling messages. + +Variable Filling with an `erc-fill-prefix' of nil: + + this is a very very very long message with no + meaning at all + +Variable Filling with an `erc-fill-prefix' of four spaces: + + this is a very very very long message with no + meaning at all + +Static Filling with `erc-fill-static-center' of 27: + + foo bar baz + foo bar baz quuuuux + this is a very very very long message with no + meaning at all + +These two styles are implemented using `erc-fill-variable' and +`erc-fill-static'. You can, of course, define your own filling +function. Narrowing to the region in question is in effect while your +function is called." + :group 'erc-fill + :type '(choice (const :tag "Variable Filling" erc-fill-variable) + (const :tag "Static Filling" erc-fill-static) + function)) + +(defcustom erc-fill-static-center 27 + "Column around which all statically filled messages will be +centered. This column denotes the point where the ' ' character +between and the entered text will be put, thus aligning +nick names right and text left." + :group 'erc-fill + :type 'integer) + +(defcustom erc-fill-variable-maximum-indentation 17 + "If we indent a line after a long nick, don't indent more then this +characters. Set to nil to disable." + :group 'erc-fill + :type 'integer) + +(defcustom erc-fill-column 78 + "The column at which a filled paragraph is broken." + :group 'erc-fill + :type 'integer) + +;;;###autoload +(defun erc-fill () + "Fill a region using the function referenced in `erc-fill-function'. +You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." + (unless (erc-string-invisible-p (buffer-substring (point-min) (point-max))) + (when erc-fill-function + ;; skip initial empty lines + (goto-char (point-min)) + (save-match-data + (while (and (looking-at "[ \t\n]*$") + (= (forward-line 1) 0)))) + (unless (eobp) + (save-restriction + (narrow-to-region (point) (point-max)) + (funcall erc-fill-function)))))) + +(defun erc-fill-static () + "Fills a text such that messages start at column `erc-fill-static-center'." + (save-match-data + (goto-char (point-min)) + (looking-at "^\\(\\S-+\\)") + (let ((nick (match-string 1))) + (let ((fill-column (- erc-fill-column (erc-timestamp-offset))) + (fill-prefix (make-string erc-fill-static-center 32))) + (insert (make-string (max 0 (- erc-fill-static-center + (length nick) 1)) + 32)) + (erc-fill-regarding-timestamp)) + (erc-restore-text-properties)))) + +(defun erc-fill-variable () + "Fill from `point-min' to `point-max'." + (let ((fill-prefix erc-fill-prefix) + (fill-column (or erc-fill-column fill-column))) + (goto-char (point-min)) + (if fill-prefix + (let ((first-line-offset (make-string (erc-timestamp-offset) 32))) + (insert first-line-offset) + (fill-region (point-min) (point-max) t t) + (goto-char (point-min)) + (delete-char (length first-line-offset))) + (save-match-data + (let* ((nickp (looking-at "^\\(\\S-+\\)")) + (nick (if nickp + (match-string 1) + "")) + (fill-column (- erc-fill-column (erc-timestamp-offset))) + (fill-prefix (make-string (min (+ 1 (length nick)) + (- fill-column 1) + (or erc-fill-variable-maximum-indentation + fill-column)) + 32))) + (erc-fill-regarding-timestamp)))) + (erc-restore-text-properties))) + +(defun erc-fill-regarding-timestamp () + "Fills a text such that messages start at column `erc-fill-static-center'." + (fill-region (point-min) (point-max) t t) + (goto-char (point-min)) + (forward-line) + (indent-rigidly (point) (point-max) (erc-timestamp-offset))) + +(defun erc-timestamp-offset () + "Get length of timestamp if inserted left." + (if (and (boundp 'erc-timestamp-format) + erc-timestamp-format + (eq erc-insert-timestamp-function 'erc-insert-timestamp-left) + (not erc-hide-timestamps)) + (length (format-time-string erc-timestamp-format)) + 0)) + +(provide 'erc-fill) + +;;; erc-fill.el ends here +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;; arch-tag: 89224581-c2c2-4e26-92e5-e3a390dc516a diff --git a/lisp/erc-goodies.el b/lisp/erc-goodies.el new file mode 100644 index 0000000..ff06546 --- /dev/null +++ b/lisp/erc-goodies.el @@ -0,0 +1,576 @@ +;; erc-goodies.el --- Collection of ERC modules + +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer + +;; 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 3, 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 support + +(defun erc-imenu-setup () + "Setup Imenu support in an ERC buffer." + (set (make-local-variable 'imenu-create-index-function) + 'erc-create-imenu-index)) + +(add-hook 'erc-mode-hook 'erc-imenu-setup) +(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." + ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (erc-add-scroll-to-bottom)))) + ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (remove-hook 'window-scroll-functions 'erc-scroll-to-bottom t))))) + +(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 (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)) + (erc-with-selected-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)) + +;;; Move to prompt when typing text +(define-erc-module move-to-prompt nil + "This mode causes the point to be moved to the prompt when typing text." + ((add-hook 'erc-mode-hook 'erc-move-to-prompt-setup) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (erc-move-to-prompt-setup)))) + ((remove-hook 'erc-mode-hook 'erc-move-to-prompt-setup) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer + (remove-hook 'pre-command-hook 'erc-move-to-prompt t))))) + +(defun erc-move-to-prompt () + "Move the point to the ERC prompt if this is a self-inserting command." + (when (and erc-input-marker (< (point) erc-input-marker) + (eq 'self-insert-command this-command)) + (deactivate-mark) + (push-mark) + (goto-char (point-max)))) + +(defun erc-move-to-prompt-setup () + "Initialize the move-to-prompt module for XEmacs." + (add-hook 'pre-command-hook 'erc-move-to-prompt nil t)) + +;;; Keep place in unvisited channels +(define-erc-module keep-place nil + "Leave point above un-viewed text in other channels." + ((add-hook 'erc-insert-pre-hook 'erc-keep-place)) + ((remove-hook 'erc-insert-pre-hook 'erc-keep-place))) + +(defun erc-keep-place (ignored) + "Move point away from the last line in a non-selected ERC buffer." + (when (and (not (eq (window-buffer (selected-window)) + (current-buffer))) + (>= (point) erc-insert-marker)) + (deactivate-mark) + (goto-char (erc-beg-of-input-line)) + (forward-line -1))) + +;;; Distinguish 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)) + (prog1 'default + (erc-error "erc-get-bg-color-face: n is NaN: %S" n)) + (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)) + (prog1 'default + (erc-error "erc-get-fg-color-face: n is NaN: %S" n)) + (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) + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + ;; Turn " / " into " " + (goto-char (point-min)) + (while (re-search-forward " / " nil t) + (replace-match " ")) + ;; Turn "/ " into "/" + (goto-char (point-min)) + (while (re-search-forward "/ " nil t) + (replace-match "/")) + ;; Unmorse region + (unmorse-region (point-min) (point-max))))) + +;;; 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 diff --git a/lisp/erc-hecomplete.el b/lisp/erc-hecomplete.el new file mode 100644 index 0000000..75cc50a --- /dev/null +++ b/lisp/erc-hecomplete.el @@ -0,0 +1,225 @@ +;;; erc-hecomplete.el --- Provides Nick name completion for ERC + +;; Copyright (C) 2001, 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Alex Schroeder +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion + +;; 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 3, 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 file is considered obsolete. It is recommended to use +;; completion from erc-pcomplete instead. + +;; This file is based on hippie-expand, while the new file is based on +;; pcomplete. + +;;; Code: + +(require 'erc) +(require 'erc-match); for erc-pals +(require 'hippie-exp); for the hippie expand stuff + +;;;###autoload (autoload 'erc-hecomplete-mode "erc-hecomplete" nil t) +(define-erc-module hecomplete nil + "Complete nick at point." + ((add-hook 'erc-complete-functions 'erc-hecomplete)) + ((remove-hook 'erc-complete-functions 'erc-hecomplete))) + +(defun erc-hecomplete () + "Complete nick at point. +See `erc-try-complete-nick' for more technical info. +This function is obsolete, use `erc-pcomplete' instead." + (interactive) + (let ((hippie-expand-try-functions-list '(erc-try-complete-nick))) + (hippie-expand nil))) + +(defgroup erc-hecomplete nil + "Nick completion. It is recommended to use erc-pcomplete instead." + :group 'erc) + +(defcustom erc-nick-completion 'all + "Determine how the list of nicks is determined during nick completion. +See `erc-complete-nick' for information on how to activate this. + +pals: Use `erc-pals'. +all: All channel members. + +You may also provide your own function that returns a list of completions. +One example is `erc-nick-completion-exclude-myself', +or you may use an arbitrary lisp expression." + :type '(choice (const :tag "List of pals" pals) + (const :tag "All channel members" all) + (const :tag "All channel members except yourself" + erc-nick-completion-exclude-myself) + (repeat :tag "List" (string :tag "Nick")) + function + sexp) + :group 'erc-hecomplete) + +(defcustom erc-nick-completion-ignore-case t + "*Non-nil means don't consider case significant in nick completion. +Case will be automatically corrected when non-nil. +For instance if you type \"dely TAB\" the word completes and changes to +\"delYsid\"." + :group 'erc-hecomplete + :type 'boolean) + +(defun erc-nick-completion-exclude-myself () + "Get a list of all the channel members except you. + +This function returns a list of all the members in the channel, except +your own nick. This way if you're named foo and someone is called foobar, +typing \"f o TAB\" will directly give you foobar. Use this with +`erc-nick-completion'." + (remove + (erc-current-nick) + (erc-get-channel-nickname-list))) + +(defcustom erc-nick-completion-postfix ": " + "*When `erc-complete' is used in the first word after the prompt, +add this string when a unique expansion was found." + :group 'erc-hecomplete + :type 'string) + +(defun erc-command-list () + "Returns a list of strings of the defined user commands." + (let ((case-fold-search nil)) + (mapcar (lambda (x) + (concat "/" (downcase (substring (symbol-name x) 8)))) + (apropos-internal "erc-cmd-[A-Z]+")))) + +(defun erc-try-complete-nick (old) + "Complete nick at point. +This is a function to put on `hippie-expand-try-functions-list'. +Then use \\[hippie-expand] to expand nicks. +The type of completion depends on `erc-nick-completion'." + (cond ((eq erc-nick-completion 'pals) + (try-complete-erc-nick old erc-pals)) + ((eq erc-nick-completion 'all) + (try-complete-erc-nick old (append + (erc-get-channel-nickname-list) + (erc-command-list)))) + ((functionp erc-nick-completion) + (try-complete-erc-nick old (funcall erc-nick-completion))) + (t + (try-complete-erc-nick old erc-nick-completion)))) + +(defvar try-complete-erc-nick-window-configuration nil + "The window configuration for `try-complete-erc-nick'. +When called the first time, a window config is stored here, +and when completion is done, the window config is restored +from here. See `try-complete-erc-nick-restore' and +`try-complete-erc-nick'.") + +(defun try-complete-erc-nick-restore () + "Restore window configuration." + (if (not try-complete-erc-nick-window-configuration) + (when (get-buffer "*Completions*") + (delete-windows-on "*Completions*")) + (set-window-configuration + try-complete-erc-nick-window-configuration) + (setq try-complete-erc-nick-window-configuration nil))) + +(defun try-complete-erc-nick (old completions) + "Try to complete current word depending on `erc-try-complete-nick'. +The argument OLD has to be nil the first call of this function, and t +for subsequent calls (for further possible completions of the same +string). It returns t if a new completion is found, nil otherwise. The +second argument COMPLETIONS is a list of completions to use. Actually, +it is only used when OLD is nil. It will be copied to `he-expand-list' +on the first call. After that, it is no longer used. +Window configurations are stored in +`try-complete-erc-nick-window-configuration'." + (let (expansion + final + (alist (if (consp (car completions)) + completions + (mapcar (lambda (s) + (if (and (erc-complete-at-prompt) + (and (not (= (length s) 0)) + (not (eq (elt s 0) ?/)))) + (list (concat s erc-nick-completion-postfix)) + (list (concat s " ")))) + completions))) ; make alist if required + (completion-ignore-case erc-nick-completion-ignore-case)) + (he-init-string (he-dabbrev-beg) (point)) + ;; If there is a string to complete, complete it using alist. + ;; expansion is the possible expansion, or t. If expansion is t + ;; or if expansion is the "real" thing, we are finished (final is + ;; t). Take care -- expansion can also be nil! + (unless (string= he-search-string "") + (setq expansion (try-completion he-search-string alist) + final (or (eq t expansion) + (and expansion + (eq t (try-completion expansion alist)))))) + (cond ((not expansion) + ;; There is no expansion at all. + (try-complete-erc-nick-restore) + (he-reset-string) + nil) + ((eq t expansion) + ;; The user already has the correct expansion. + (try-complete-erc-nick-restore) + (he-reset-string) + t) + ((and old (string= expansion he-search-string)) + ;; This is the second time around and nothing changed, + ;; ie. the user tried to expand something incomplete + ;; without making a choice -- hitting TAB twice, for + ;; example. + (try-complete-erc-nick-restore) + (he-reset-string) + nil) + (final + ;; The user has found the correct expansion. + (try-complete-erc-nick-restore) + (he-substitute-string expansion) + t) + (t + ;; We found something but we are not finished. Show a + ;; completions buffer. Substitute what we found and return + ;; t. + (setq try-complete-erc-nick-window-configuration + (current-window-configuration)) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list (all-completions he-search-string alist))) + (he-substitute-string expansion) + t)))) + +(defun erc-at-beginning-of-line-p (point &optional bol-func) + (save-excursion + (funcall (or bol-func + 'erc-bol)) + (equal point (point)))) + +(defun erc-complete-at-prompt () + "Returns t if point is directly after `erc-prompt' when doing completion." + (erc-at-beginning-of-line-p (he-dabbrev-beg))) + +(provide 'erc-hecomplete) + +;;; erc-hecomplete.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 3be13ee8-8fdb-41ab-83c2-6582c757b91e diff --git a/lisp/erc-ibuffer.el b/lisp/erc-ibuffer.el new file mode 100644 index 0000000..14ac365 --- /dev/null +++ b/lisp/erc-ibuffer.el @@ -0,0 +1,195 @@ +;;; erc-ibuffer.el --- ibuffer integration with ERC + +;; Copyright (C) 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcIbuffer + +;; 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 3, 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 file contains code related to Ibuffer and ERC. Totally alpha, +;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new +;; limiting commands + +;;; Code: + +(require 'ibuffer) +(require 'ibuf-ext) +(require 'erc) + +(defgroup erc-ibuffer nil + "The Ibuffer group for ERC." + :group 'erc) + +(defcustom erc-ibuffer-keyword-char ?k + "Char used to indicate a channel which had keyword traffic lately (hidden)." + :group 'erc-ibuffer + :type 'character) +(defcustom erc-ibuffer-pal-char ?p + "Char used to indicate a channel which had pal traffic lately (hidden)." + :group 'erc-ibuffer + :type 'character) +(defcustom erc-ibuffer-fool-char ?f + "Char used to indicate a channel which had fool traffic lately (hidden)." + :group 'erc-ibuffer + :type 'character) +(defcustom erc-ibuffer-dangerous-host-char ?d + "Char used to indicate a channel which had dangerous-host traffic lately +\(hidden)." + :group 'erc-ibuffer + :type 'character) + +(define-ibuffer-filter erc-server + "Toggle current view to buffers which are related to ERC servers." + (:description "erc servers" + :reader + (let ((regexp + (read-from-minibuffer "Limit by server (regexp) (RET for all): "))) + (if (string= regexp "") + ".*" + regexp))) + (with-current-buffer buf + (and (eq major-mode 'erc-mode) + (string-match qualifier (or erc-server-announced-name + erc-session-server))))) + +;; Silence the byte-compiler +(eval-when-compile + (defvar erc-modified-channels-alist)) + +(define-ibuffer-column erc-modified (:name "M") + (if (and (boundp 'erc-track-mode) + erc-track-mode) + (let ((entry (assq (current-buffer) erc-modified-channels-alist))) + (if entry + (if (> (length entry) 1) + (cond ((eq 'pal (nth 1 entry)) + (string erc-ibuffer-pal-char)) + ((eq 'fool (nth 1 entry)) + (string erc-ibuffer-fool-char)) + ((eq 'keyword (nth 1 entry)) + (string erc-ibuffer-keyword-char)) + ((eq 'dangerous-host (nth 1 entry)) + (string erc-ibuffer-dangerous-host-char)) + (t "$")) + (string ibuffer-modified-char)) + " ")) + " ")) + +(define-ibuffer-column erc-server-name (:name "Server") + (if (and erc-server-process (processp erc-server-process)) + (with-current-buffer (process-buffer erc-server-process) + (or erc-server-announced-name erc-session-server)) + "")) + +(define-ibuffer-column erc-target (:name "Target") + (if (eq major-mode 'erc-mode) + (cond ((and erc-server-process (processp erc-server-process) + (eq (current-buffer) (process-buffer erc-server-process))) + (concat "Server " erc-session-server ":" + (erc-port-to-string erc-session-port))) + ((erc-channel-p (erc-default-target)) + (concat (erc-default-target))) + ((erc-default-target) + (concat "Query: " (erc-default-target))) + (t "(parted)")) + (buffer-name))) + +(define-ibuffer-column erc-topic (:name "Topic") + (if (and (eq major-mode 'erc-mode) + erc-channel-topic) + (erc-controls-interpret erc-channel-topic) + "")) + +(define-ibuffer-column + erc-members (:name "Users") + (if (and (eq major-mode 'erc-mode) + (boundp 'erc-channel-users) + (hash-table-p erc-channel-users) + (> (hash-table-size erc-channel-users) 0)) + (number-to-string (hash-table-size erc-channel-users)) + "")) + +(define-ibuffer-column erc-away (:name "A") + (if (and erc-server-process + (processp erc-server-process) + (erc-away-time)) + "A" + " ")) + +(define-ibuffer-column + erc-op (:name "O") + (if (and (eq major-mode 'erc-mode) + (erc-channel-user-op-p (erc-current-nick))) + "@" + " ")) + +(define-ibuffer-column erc-voice (:name "V") + (if (and (eq major-mode 'erc-mode) + (erc-channel-user-voice-p (erc-current-nick))) + "+" + " ")) + +(define-ibuffer-column erc-channel-modes (:name "Mode") + (if (and (eq major-mode 'erc-mode) + (or (> (length erc-channel-modes) 0) + erc-channel-user-limit)) + (concat (apply 'concat + "(+" erc-channel-modes) + (if erc-channel-user-limit + (format "l %d" erc-channel-user-limit) + "") + ")") + (if (not (derived-mode-p 'erc-mode)) + (format-mode-line mode-name nil nil (current-buffer)) + ""))) + +(define-ibuffer-column erc-nick (:name "Nick") + (if (eq major-mode 'erc-mode) + (erc-current-nick) + "")) + +(defvar erc-ibuffer-formats + '((mark erc-modified erc-away erc-op erc-voice " " (erc-nick 8 8) " " + (erc-target 18 40) (erc-members 5 5 :center) + (erc-channel-modes 6 16 :center) " " (erc-server-name 20 30) " " + (erc-topic 10 -1)) + (mark erc-modified erc-away erc-op erc-voice " " (erc-target 18 40) + (erc-members 5 5 :center) (erc-channel-modes 9 20 :center) " " + (erc-topic 10 -1)))) +(setq ibuffer-formats (append ibuffer-formats erc-ibuffer-formats)) + +(defvar erc-ibuffer-limit-map nil + "Prefix keymap to use for ERC related limiting.") +(define-prefix-command 'erc-ibuffer-limit-map) +(define-key 'erc-ibuffer-limit-map (kbd "s") 'ibuffer-limit-by-erc-server) +(define-key ibuffer-mode-map (kbd "/ \C-e") 'erc-ibuffer-limit-map) + +(provide 'erc-ibuffer) + +;;; erc-ibuffer.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: fbad56a5-8595-45e0-a8c8-d8bb91e26944 diff --git a/lisp/erc-identd.el b/lisp/erc-identd.el new file mode 100644 index 0000000..205ab19 --- /dev/null +++ b/lisp/erc-identd.el @@ -0,0 +1,127 @@ +;;; erc-identd.el --- RFC1413 (identd authentication protocol) server + +;; Copyright (C) 2003, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: John Wiegley +;; Keywords: comm, processes + +;; 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 3, 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 module allows you to run a local identd server on port 8113. +;; You will need to set up DNAT to bind 113->8113, or use a proxy. + +;; To use this module, add identd to `erc-modules' and run +;; `erc-update-modules'. + +;; Here is an example /etc/inetd.conf rule that forwards identd +;; traffic to port 8113. You will need simpleproxy installed for it +;; to work. + +;; 113 stream tcp nowait nobody /usr/sbin/tcpd /usr/bin/simpleproxy simpleproxy -i -R 127.0.0.1:8113 + +;;; Code: + +(require 'erc) + +(defvar erc-identd-process nil) + +(defgroup erc-identd nil + "Run a local identd server." + :group 'erc) + +(defcustom erc-identd-port 8113 + "Port to run the identd server on if not specified in the argument for +`erc-identd-start'. + +This can be either a string or a number." + :group 'erc-identd + :type '(choice (const :tag "None" nil) + (integer :tag "Port number") + (string :tag "Port string"))) + +;;;###autoload (autoload 'erc-identd-mode "erc-identd") +(define-erc-module identd nil + "This mode launches an identd server on port 8113." + ((add-hook 'erc-connect-pre-hook 'erc-identd-quickstart) + (add-hook 'erc-disconnected-hook 'erc-identd-stop)) + ((remove-hook 'erc-connect-pre-hook 'erc-identd-quickstart) + (remove-hook 'erc-disconnected-hook 'erc-identd-stop))) + +(defun erc-identd-filter (proc string) + "This filter implements RFC1413 (identd authentication protocol)." + (let ((erc-identd-process proc)) + (when (string-match "\\([0-9]+\\)\\s-*,\\s-*\\([0-9]+\\)" string) + (let ((port-on-server (match-string 1 string)) + (port-on-client (match-string 2 string))) + (send-string erc-identd-process + (format "%s, %s : USERID : %s : %s\n" + port-on-server port-on-client + system-type (user-login-name))) + (stop-process erc-identd-process) + (delete-process proc))))) + +;;;###autoload +(defun erc-identd-start (&optional port) + "Start an identd server listening to port 8113. +Port 113 (auth) will need to be redirected to port 8113 on your +machine -- using iptables, or a program like redir which can be +run from inetd. The idea is to provide a simple identd server +when you need one, without having to install one globally on your +system." + (interactive (list (read-string "Serve identd requests on port: " "8113"))) + (unless port (setq port erc-identd-port)) + (when (stringp port) + (setq port (string-to-number port))) + (when erc-identd-process + (delete-process erc-identd-process)) + (setq erc-identd-process + (if (fboundp 'make-network-process) + (make-network-process :name "identd" + :buffer nil + :host 'local :service port + :server t :noquery t :nowait t + :filter 'erc-identd-filter) + (and (fboundp 'open-network-stream-server) + (open-network-stream-server + "identd" (generate-new-buffer " *erc-identd*") + port nil 'erc-identd-filter))))) + +(defun erc-identd-quickstart (&rest ignored) + "Start the identd server with the default port. +The default port is specified by `erc-identd-port'." + (erc-identd-start)) + +;;;###autoload +(defun erc-identd-stop (&rest ignore) + (interactive) + (when erc-identd-process + (delete-process erc-identd-process) + (setq erc-identd-process nil))) + +(provide 'erc-identd) + +;;; erc-identd.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: e0b5f926-0f35-40b9-8ddb-ca06b62a7544 diff --git a/lisp/erc-imenu.el b/lisp/erc-imenu.el new file mode 100644 index 0000000..37ae552 --- /dev/null +++ b/lisp/erc-imenu.el @@ -0,0 +1,138 @@ +;;; erc-imenu.el -- Imenu support for ERC + +;; Copyright (C) 2001, 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcImenu + +;; 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 3, 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 file contains code related to Ibuffer and ERC. Totally alpha, +;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new +;; limiting commands + +;;; Code: + +;;; Commentary: + +;; This package defines the function `erc-create-imenu-index'. ERC +;; uses this for `imenu-create-index-function', and autoloads it. +;; Therefore, nothing needs to be done to use this package. + +;;; Code: + +(require 'erc) +(require 'imenu) + +(defun erc-unfill-notice () + "Return text from point to a computed end as a string unfilled. +Don't rely on this function, read it first!" + (let ((str (buffer-substring + (save-excursion + (re-search-forward (regexp-quote erc-notice-prefix))) + (progn + (while (save-excursion + (forward-line 1) + (looking-at " ")) + (forward-line 1)) + (end-of-line) (point))))) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (re-search-forward "\n +" nil t) + (replace-match " ")) + (buffer-substring (point-min) (point-max))))) + +;;;###autoload +(defun erc-create-imenu-index () + (let ((index-alist '()) + (notice-alist '()) + (join-alist '()) + (left-alist '()) + (quit-alist '()) + (message-alist '()) + (mode-change-alist '()) + (topic-change-alist '()) + prev-pos) + (goto-char (point-max)) + (imenu-progress-message prev-pos 0) + (while (if (bolp) + (> (forward-line -1) + -1) + (progn (forward-line 0) + t)) + (imenu-progress-message prev-pos nil t) + (save-match-data + (when (looking-at (concat (regexp-quote erc-notice-prefix) + "\\(.+\\)$")) + (let ((notice-text ;; Ugly hack, but seems to work. + (save-excursion (erc-unfill-notice))) + (pos (point))) + (push (cons notice-text pos) notice-alist) + (or + (when (string-match "^\\(.*\\) has joined channel" notice-text) + (push (cons (match-string 1 notice-text) pos) join-alist)) + (when (string-match "^\\(.+\\) has left channel" notice-text) + (push (cons (match-string 1 notice-text) pos) left-alist)) + (when (string-match "^\\(.+\\) has quit\\(.*\\)$" notice-text) + (push (cons (concat (match-string 1 notice-text) + (match-string 2 notice-text)) + (point)) + quit-alist)) + (when (string-match + "^\\(\\S-+\\) (.+) has changed mode for \\S-+ to \\(.*\\)$" + notice-text) + (push (cons (concat (match-string 1 notice-text) ": " + (match-string 2 notice-text)) + (point)) + mode-change-alist)) + (when (string-match + "^\\(\\S-+\\) (.+) has set the topic for \\S-+: \\(.*\\)$" + notice-text) + (push (cons (concat (match-string 1 notice-text) ": " + (match-string 2 notice-text)) pos) + topic-change-alist))))) + (when (looking-at "<\\(\\S-+\\)> \\(.+\\)$") + (let ((from (match-string 1)) + (message-text (match-string 2))) + (push (cons (concat from ": " message-text) (point)) + message-alist))))) + (and notice-alist (push (cons "notices" notice-alist) index-alist)) + (and join-alist (push (cons "joined" join-alist) index-alist)) + (and left-alist (push (cons "parted" left-alist) index-alist)) + (and quit-alist (push (cons "quit" quit-alist) index-alist)) + (and mode-change-alist (push (cons "mode-change" mode-change-alist) + index-alist)) + (and message-alist (push (cons "messages" message-alist) index-alist)) + (and topic-change-alist (push (cons "topic-change" topic-change-alist) + index-alist)) + index-alist)) + +(provide 'erc-imenu) + +;;; erc-imenu.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 35c69082-ca29-43f7-a050-8da5f400de81 diff --git a/lisp/erc-join.el b/lisp/erc-join.el new file mode 100644 index 0000000..b9b85bf --- /dev/null +++ b/lisp/erc-join.el @@ -0,0 +1,139 @@ +;;; erc-join.el --- autojoin channels on connect and reconnects + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Alex Schroeder +;; Keywords: irc +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoJoin + +;; 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 3, 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 allows us to customize an `erc-autojoin-channels-alist'. As +;; we /JOIN and /PART channels, this alist is updated to reflect our +;; current setup, so that when we reconnect, we rejoin the same +;; channels. The alist can be customized, so that the customized +;; value will be used when we reconnect in our next Emacs session. + +;;; Code: + +(require 'erc) +(eval-when-compile (require 'cl)) + +(defgroup erc-autojoin nil + "Enable autojoining." + :group 'erc) + +;;;###autoload (autoload 'erc-autojoin-mode "erc-join" nil t) +(define-erc-module autojoin nil + "Makes ERC autojoin on connects and reconnects." + ((add-hook 'erc-after-connect 'erc-autojoin-channels) + (add-hook 'erc-server-JOIN-functions 'erc-autojoin-add) + (add-hook 'erc-server-PART-functions 'erc-autojoin-remove)) + ((remove-hook 'erc-after-connect 'erc-autojoin-channels) + (remove-hook 'erc-server-JOIN-functions 'erc-autojoin-add) + (remove-hook 'erc-server-PART-functions 'erc-autojoin-remove))) + +(defcustom erc-autojoin-channels-alist nil + "Alist of channels to autojoin on IRC networks. +Every element in the alist has the form (SERVER . CHANNELS). +SERVER is a regexp matching the server, and channels is the +list of channels to join. + +Customize this variable to set the value for your first connect. +Once you are connected and join and part channels, this alist +keeps track of what channels you are on, and will join them +again when you get disconnected. When you restart Emacs, however, +those changes are lost, and the customization you saved the last +time is used again." + :group 'erc-autojoin + :type '(repeat (cons :tag "Server" + (regexp :tag "Name") + (repeat :tag "Channels" + (string :tag "Name"))))) + +(defcustom erc-autojoin-domain-only t + "Truncate host name to the domain name when joining a server. +If non-nil, and a channel on the server a.b.c is joined, then +only b.c is used as the server for `erc-autojoin-channels-alist'. +This is important for networks that redirect you to other +servers, presumably in the same domain." + :group 'erc-autojoin + :type 'boolean) + +(defun erc-autojoin-channels (server nick) + "Autojoin channels in `erc-autojoin-channels-alist'." + (dolist (l erc-autojoin-channels-alist) + (when (string-match (car l) server) + (dolist (chan (cdr l)) + (erc-server-send (concat "join " chan)))))) + +(defun erc-autojoin-add (proc parsed) + "Add the channel being joined to `erc-autojoin-channels-alist'." + (let* ((chnl (erc-response.contents parsed)) + (nick (car (erc-parse-user (erc-response.sender parsed)))) + (server (with-current-buffer (process-buffer proc) + (or erc-server-announced-name erc-session-server)))) + (when (erc-current-nick-p nick) + (when (and erc-autojoin-domain-only + (string-match "[^.\n]+\\.\\([^.\n]+\\.[^.\n]+\\)$" server)) + (setq server (match-string 1 server))) + (let ((elem (assoc server erc-autojoin-channels-alist))) + (if elem + (unless (member chnl (cdr elem)) + (setcdr elem (cons chnl (cdr elem)))) + (setq erc-autojoin-channels-alist + (cons (list server chnl) + erc-autojoin-channels-alist)))))) + ;; We must return nil to tell ERC to continue running the other + ;; functions. + nil) + +;; (erc-parse-user "kensanata!~user@dclient217-162-233-228.hispeed.ch") + +(defun erc-autojoin-remove (proc parsed) + "Remove the channel being left from `erc-autojoin-channels-alist'." + (let* ((chnl (car (erc-response.command-args parsed))) + (nick (car (erc-parse-user (erc-response.sender parsed)))) + (server (with-current-buffer (process-buffer proc) + (or erc-server-announced-name erc-session-server)))) + (when (erc-current-nick-p nick) + (when (and erc-autojoin-domain-only + (string-match "[^.\n]+\\.\\([^.\n]+\\.[^.\n]+\\)$" server)) + (setq server (match-string 1 server))) + (let ((elem (assoc server erc-autojoin-channels-alist))) + (when elem + (setcdr elem (delete chnl (cdr elem))) + (unless (cdr elem) + (setq erc-autojoin-channels-alist + (delete elem erc-autojoin-channels-alist))))))) + ;; We must return nil to tell ERC to continue running the other + ;; functions. + nil) + +(provide 'erc-join) + +;;; erc-join.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: d62d8b15-8e31-49d6-8a73-12f11e717414 diff --git a/lisp/erc-lang.el b/lisp/erc-lang.el new file mode 100644 index 0000000..e3858eb --- /dev/null +++ b/lisp/erc-lang.el @@ -0,0 +1,213 @@ +;;; erc-lang.el --- provide the LANG command to ERC + +;; Copyright (C) 2002, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Alex Schroeder +;; Maintainer: Alex Schroeder +;; Version: 1.0.0 +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcLang +;; Keywords: comm languages processes + +;; 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 3, 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 two commands: `language' is for everyday use, and +;; `erc-cmd-LANG' provides the /LANG command to ERC. + +;;; Code: + +(require 'erc) + +(defvar iso-638-languages + '(("aa" . "Afar") + ("ab" . "Abkhazian") + ("af" . "Afrikaans") + ("am" . "Amharic") + ("ar" . "Arabic") + ("as" . "Assamese") + ("ay" . "Aymara") + ("az" . "Azerbaijani") + ("ba" . "Bashkir") + ("be" . "Byelorussian") + ("bg" . "Bulgarian") + ("bh" . "Bihari") + ("bi" . "Bislama") + ("bn" . "Bengali; Bangla") + ("bo" . "Tibetan") + ("br" . "Breton") + ("ca" . "Catalan") + ("co" . "Corsican") + ("cs" . "Czech") + ("cy" . "Welsh") + ("da" . "Danish") + ("de" . "German") + ("dz" . "Bhutani") + ("el" . "Greek") + ("en" . "English") + ("eo" . "Esperanto") + ("es" . "Spanish") + ("et" . "Estonian") + ("eu" . "Basque") + ("fa" . "Persian") + ("fi" . "Finnish") + ("fj" . "Fiji") + ("fo" . "Faroese") + ("fr" . "French") + ("fy" . "Frisian") + ("ga" . "Irish") + ("gd" . "Scots Gaelic") + ("gl" . "Galician") + ("gn" . "Guarani") + ("gu" . "Gujarati") + ("ha" . "Hausa") + ("he" . "Hebrew (formerly iw)") + ("hi" . "Hindi") + ("hr" . "Croatian") + ("hu" . "Hungarian") + ("hy" . "Armenian") + ("ia" . "Interlingua") + ("id" . "Indonesian (formerly in)") + ("ie" . "Interlingue") + ("ik" . "Inupiak") + ("is" . "Icelandic") + ("it" . "Italian") + ("iu" . "Inuktitut") + ("ja" . "Japanese") + ("jw" . "Javanese") + ("ka" . "Georgian") + ("kk" . "Kazakh") + ("kl" . "Greenlandic") + ("km" . "Cambodian") + ("kn" . "Kannada") + ("ko" . "Korean") + ("ks" . "Kashmiri") + ("ku" . "Kurdish") + ("ky" . "Kirghiz") + ("la" . "Latin") + ("ln" . "Lingala") + ("lo" . "Laothian") + ("lt" . "Lithuanian") + ("lv" . "Latvian, Lettish") + ("mg" . "Malagasy") + ("mi" . "Maori") + ("mk" . "Macedonian") + ("ml" . "Malayalam") + ("mn" . "Mongolian") + ("mo" . "Moldavian") + ("mr" . "Marathi") + ("ms" . "Malay") + ("mt" . "Maltese") + ("my" . "Burmese") + ("na" . "Nauru") + ("ne" . "Nepali") + ("nl" . "Dutch") + ("no" . "Norwegian") + ("oc" . "Occitan") + ("om" . "(Afan) Oromo") + ("or" . "Oriya") + ("pa" . "Punjabi") + ("pl" . "Polish") + ("ps" . "Pashto, Pushto") + ("pt" . "Portuguese") + ("qu" . "Quechua") + ("rm" . "Rhaeto-Romance") + ("rn" . "Kirundi") + ("ro" . "Romanian") + ("ru" . "Russian") + ("rw" . "Kinyarwanda") + ("sa" . "Sanskrit") + ("sd" . "Sindhi") + ("sg" . "Sangho") + ("sh" . "Serbo-Croatian") + ("si" . "Sinhalese") + ("sk" . "Slovak") + ("sl" . "Slovenian") + ("sm" . "Samoan") + ("sn" . "Shona") + ("so" . "Somali") + ("sq" . "Albanian") + ("sr" . "Serbian") + ("ss" . "Siswati") + ("st" . "Sesotho") + ("su" . "Sundanese") + ("sv" . "Swedish") + ("sw" . "Swahili") + ("ta" . "Tamil") + ("te" . "Telugu") + ("tg" . "Tajik") + ("th" . "Thai") + ("ti" . "Tigrinya") + ("tk" . "Turkmen") + ("tl" . "Tagalog") + ("tn" . "Setswana") + ("to" . "Tonga") + ("tr" . "Turkish") + ("ts" . "Tsonga") + ("tt" . "Tatar") + ("tw" . "Twi") + ("ug" . "Uighur") + ("uk" . "Ukrainian") + ("ur" . "Urdu") + ("uz" . "Uzbek") + ("vi" . "Vietnamese") + ("vo" . "Volapuk") + ("wo" . "Wolof") + ("xh" . "Xhosa") + ("yi" . "Yiddish (formerly ji)") + ("yo" . "Yoruba") + ("za" . "Zhuang") + ("zh" . "Chinese") + ("zu" . "Zulu")) + "Alist of ISO language codes and language names. +This is based on the technical contents of ISO 639:1988 (E/F) +\"Code for the representation of names of languages\". + +Typed by Keld.Simonsen@dkuug.dk 1990-11-30 + +Minor corrections, 1992-09-08 by Keld Simonsen +Sundanese corrected, 1992-11-11 by Keld Simonsen +Telugu corrected, 1995-08-24 by Keld Simonsen +Hebrew, Indonesian, Yiddish corrected 1995-10-10 by Michael Everson +Inuktitut, Uighur, Zhuang added 1995-10-10 by Michael Everson +Sinhalese corrected, 1995-10-10 by Michael Everson +Faeroese corrected to Faroese, 1995-11-18 by Keld Simonsen +Sangro corrected to Sangho, 1996-07-28 by Keld Simonsen + +Two-letter lower-case symbols are used. +The Registration Authority for ISO 639 is Infoterm, Osterreichisches +Normungsinstitut (ON), Postfach 130, A-1021 Vienna, Austria.") + +(defun language (code) + "Return the language name for the ISO CODE." + (interactive (list (completing-read "ISO language code: " + iso-638-languages))) + (message "%s" (cdr (assoc code iso-638-languages)))) + +(defun erc-cmd-LANG (language) + "Display the language name for the language code given by LANGUAGE." + (let ((lang (cdr (assoc language iso-638-languages)))) + (erc-display-message + nil 'notice 'active + (or lang (concat line ": No such domain")))) + t) + +(provide 'erc-lang) + +;; arch-tag: 8ffb1563-cc03-4517-b067-16309d4ff97b +;;; erc-lang.el ends here diff --git a/lisp/erc-list-old.el b/lisp/erc-list-old.el new file mode 100644 index 0000000..d6cfa3a --- /dev/null +++ b/lisp/erc-list-old.el @@ -0,0 +1,416 @@ +;;; erc-list-old.el --- Provide a faster channel listing mechanism + +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 +;; 2008 Free Software Foundation, Inc. +;; Copyright (C) 2004 Brian Palmer + +;; Author: Mario Lang +;; Keywords: comm + +;; This file is part of ERC. + +;; ERC 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 3, or (at your option) +;; any later version. + +;; ERC 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 ERC; 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 file provides a simple derived mode for viewing Channel lists. +;; It also serves as a demonstration of how the new server hook facility +;; can be used. + +;;; Code: + +(require 'erc) +(require 'erc-networks) +(require 'sort) +(unless (fboundp 'make-overlay) + (require 'overlay)) +(eval-when-compile (require 'cl)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; User customizable variables. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup erc-list-old nil + "Display IRC channels in another window when using /LIST" + :group 'erc) + +(defcustom erc-chanlist-progress-message t + "*Show progress message while accumulating channel list." + :group 'erc-list-old + :type 'boolean) + +(defcustom erc-no-list-networks nil + "*A list of network names on which the /LIST command refuses to work." + :group 'erc-list-old + :type '(repeat string)) + +(defcustom erc-chanlist-frame-parameters nil + "*If nil, the channel list is displayed in a new window; if non-nil, +this variable holds the frame parameters used to make a frame to +display the channel list." + :group 'erc-list-old + :type 'list) + +(defcustom erc-chanlist-hide-modeline nil + "*If nil, the channel list buffer has a modeline, otherwise the modeline is hidden." + :group 'erc-list-old + :type 'boolean) + +(defface erc-chanlist-header-face '((t (:bold t))) + "Face used for the headers in erc's channel list." + :group 'erc-faces) + +(defface erc-chanlist-odd-line-face '((t (:inverse-video t))) + "Face used for the odd lines in erc's channel list." + :group 'erc-faces) + +(defface erc-chanlist-even-line-face '((t (:inverse-video nil))) + "Face used for the even lines in erc's channel list." + :group 'erc-faces) + +(defface erc-chanlist-highlight '((t (:foreground "red"))) + "Face used to highlight the current line in the channel list." + :group 'erc-faces) + +;; This should perhaps be a defface that inherits values from the highlight face +;; but xemacs does not support inheritance +(defcustom erc-chanlist-highlight-face 'erc-chanlist-highlight + "Face used for highlighting the current line in a list." + :type 'face + :group 'erc-faces) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; All variables below this line are for internal use only. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar erc-chanlist-channel-line-regexp "^\\([#&\\*][^ \t\n]*\\)\\s-+[0-9]+" + "Regexp that matches a channel line in the channel list buffer.") + +(defvar erc-chanlist-buffer nil) +(make-variable-buffer-local 'erc-chanlist-buffer) + +(defvar erc-chanlist-last-time 0 + "A time value used to throttle the progress indicator.") + +(defvar erc-chanlist-frame nil + "The frame displaying the most recent channel list buffer.") + +(defvar erc-chanlist-sort-state 'channel + "The sort mode of the channel list buffer. Either 'channel or 'users.") +(make-variable-buffer-local 'erc-chanlist-sort-state) + +(defvar erc-chanlist-highlight-overlay nil + "The overlay used for erc chanlist highlighting") +(make-variable-buffer-local 'erc-chanlist-highlight-overlay) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Define erc-chanlist-mode. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom erc-chanlist-mode-hook nil + "Hook run by erc-chanlist-mode." + :group 'erc-list-old + :type 'hook) + +(define-derived-mode erc-chanlist-mode fundamental-mode "ERC Channel List" + "Mode for viewing a channel list of a particular server. + +\\{erc-chanlist-mode-map}" + (local-set-key "\C-c\C-j" 'erc-join-channel) + (local-set-key "j" 'erc-chanlist-join-channel) + (local-set-key "n" 'next-line) + (local-set-key "p" 'previous-line) + (local-set-key "q" 'erc-chanlist-quit) + (local-set-key "s" 'erc-chanlist-toggle-sort-state) + (local-set-key "t" 'toggle-truncate-lines) + (setq erc-chanlist-sort-state 'channel) + (setq truncate-lines t) + (add-hook 'post-command-hook 'erc-chanlist-post-command-hook 'append 'local)) + +;; Define module: +;;;###autoload (autoload 'erc-list-old-mode "erc-list-old") +(define-erc-module list nil + "List channels nicely in a separate buffer." + ((defalias 'erc-cmd-LIST 'erc-list-channels)) + ((defalias 'erc-cmd-LIST 'erc-list-channels-simple))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun erc-list-channels (&rest channel) + "Display a buffer containing a list of channels on the current server. +Optional argument CHANNEL specifies a single channel to list (instead of every +available channel)." + (interactive + (remove "" (split-string + (read-from-minibuffer "List channels (RET for all): ") " "))) + (if (and (null channel) + (erc-member-ignore-case (erc-network-name) erc-no-list-networks)) + (erc-display-line "ERC is configured not to allow the /LIST command on this network!" + (current-buffer)) + (erc-display-line (erc-make-notice (concat "Listing channel" + (if channel + "." + "s. This may take a while.")))) + (erc-chanlist channel)) + t) + +(defun erc-list-channels-simple (&optional line) + "Send the LIST command to the current server with optional channels LINE." + (when (string-match "^\\s-*\\(.*\\)$" line) + (let ((channels (match-string 1 line))) + (erc-log (format "cmd: LIST: %s" channels)) + (erc-server-send + (if (string= channels "") + "LIST" + (concat "LIST :" channels)))) + t)) +(put 'erc-list-channels-simple 'do-not-parse-args t) + +;;;###autoload +(defun erc-chanlist (&optional channels) + "Show a channel listing of the current server in a special mode. +Please note that this function only works with IRC servers which conform +to RFC and send the LIST header (#321) at start of list transmission." + (interactive) + (erc-with-server-buffer + (erc-once-with-server-event + 321 + '(progn + (add-hook 'erc-server-322-functions 'erc-chanlist-322 nil t) + + (erc-once-with-server-event + 323 + '(progn + (remove-hook 'erc-server-322-functions 'erc-chanlist-322 t) + (let ((buf erc-chanlist-buffer)) + (if (not (buffer-live-p buf)) + (error "`erc-chanlist-buffer' does not refer to a live buffer")) + + (set-buffer buf) + (buffer-disable-undo) + (let (buffer-read-only + (sort-fold-case t)) + (sort-lines nil (point-min) (point-max)) + (setq erc-chanlist-sort-state 'channel) + + (let ((sum (count-lines (point-min) (point-max)))) + (goto-char (point-min)) + (insert (substitute-command-keys + (concat "'\\[erc-chanlist-toggle-sort-state]' toggle sort mode.\n" + "'\\[erc-chanlist-quit]' kill this buffer.\n" + "'\\[toggle-truncate-lines]' toggle line truncation.\n" + "'\\[erc-chanlist-join-channel]' join the channel listed on the current line.\n\n"))) + (insert (format "%d channels (sorted by %s).\n\n" + sum (if (eq erc-chanlist-sort-state 'channel) + "channel name" + "number of users")))) + + (insert (format "%-25s%5s %s\n------------------------ ----- ----------------------------\n" + "Channel" + "Users" + "Topic")) + + ;; Display the channel list buffer. + (if erc-chanlist-frame-parameters + (progn + (if (or (null erc-chanlist-frame) + (not (frame-live-p erc-chanlist-frame))) + (setq erc-chanlist-frame + (make-frame `((name . ,(format "Channels on %s" + erc-session-server)) + ,@erc-chanlist-frame-parameters)))) + (select-frame erc-chanlist-frame) + (switch-to-buffer buf) + (erc-prettify-channel-list)) + (pop-to-buffer buf) + (erc-prettify-channel-list)))) + (goto-char (point-min)) + (search-forward-regexp "^------" nil t) + (forward-line 1) + (erc-chanlist-highlight-line) + (message "") + t)) + + (setq erc-chanlist-buffer (get-buffer-create + (format "*Channels on %s*" + (erc-response.sender parsed)))) + (with-current-buffer erc-chanlist-buffer + (setq buffer-read-only nil) + (erase-buffer) + (erc-chanlist-mode) + (setq erc-server-process proc) + (if erc-chanlist-hide-modeline + (setq mode-line-format nil)) + (setq buffer-read-only t)) + t)) + + ;; Now that we've setup our callbacks, pull the trigger. + (if (interactive-p) + (message "Collecting channel list for server %s" erc-session-server)) + (erc-server-send (if (null channels) + "LIST" + (concat "LIST " + (mapconcat #'identity channels ",")))))) + +(defun erc-chanlist-322 (proc parsed) + "Process an IRC 322 message. + +The message carries information about one channel for the LIST +command." + (multiple-value-bind (channel num-users) + (cdr (erc-response.command-args parsed)) + (let ((topic (erc-response.contents parsed))) + (with-current-buffer erc-chanlist-buffer + (save-excursion + (goto-char (point-max)) + (let (buffer-read-only) + (insert (format "%-26s%4s %s\n" (erc-controls-strip channel) + num-users + (erc-controls-strip topic)))) + + ;; Maybe display a progress indicator in the minibuffer. + (when (and erc-chanlist-progress-message + (> (erc-time-diff + erc-chanlist-last-time (erc-current-time)) + 3)) + (setq erc-chanlist-last-time (erc-current-time)) + (message "Accumulating channel list ... %c" + (aref [?/ ?| ?\\ ?- ?! ?O ?o] (random 7)))) + + ;; Return success to prevent other hook functions from being run. + t))))) + +(defun erc-chanlist-post-command-hook () + "Keep the current line highlighted." + (ignore-errors + (save-excursion + (beginning-of-line) + (if (looking-at erc-chanlist-channel-line-regexp) + (erc-chanlist-highlight-line) + (erc-chanlist-dehighlight-line))))) + +(defun erc-chanlist-highlight-line () + "Highlight the current line." + (unless erc-chanlist-highlight-overlay + (setq erc-chanlist-highlight-overlay + (make-overlay (point-min) (point-min))) + ;; Detach it from the buffer. + (delete-overlay erc-chanlist-highlight-overlay) + (overlay-put erc-chanlist-highlight-overlay + 'face erc-chanlist-highlight-face) + ;; Expressly put it at a higher priority than the text + ;; properties used for faces later on. Gnu emacs promises that + ;; right now overlays are higher priority than text properties, + ;; but why take chances? + (overlay-put erc-chanlist-highlight-overlay 'priority 1)) + (move-overlay erc-chanlist-highlight-overlay (point) (1+ (point-at-eol)))) + +(defun erc-chanlist-dehighlight-line () + "Remove the line highlighting." + (delete-overlay erc-chanlist-highlight-overlay)) + +(defun erc-prettify-channel-list () + "Make the channel list buffer look pretty. +When this function runs, the current buffer must be the channel +list buffer, or it does nothing." + (if (eq major-mode 'erc-chanlist-mode) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (when (search-forward-regexp "^-------" nil t) + (add-text-properties + (point-min) (1+ (point-at-eol)) '(face erc-chanlist-header-face)) + (forward-line 1)) + + (while (not (eobp)) + (add-text-properties + (point) (1+ (point-at-eol)) '(face erc-chanlist-odd-line-face)) + (forward-line 1) + (unless (eobp) + (add-text-properties + (point) (1+ (point-at-eol)) '(face erc-chanlist-even-line-face))) + (forward-line 1)))))) + +(defun erc-chanlist-toggle-sort-state () + "Toggle the channel list buffer sorting method. +Either sort by channel names or by number of users in each channel." + (interactive) + (let ((inhibit-read-only t) + (sort-fold-case t)) + (save-excursion + (goto-char (point-min)) + (search-forward-regexp "^-----" nil t) + (forward-line 1) + (unless (eobp) + (if (eq erc-chanlist-sort-state 'channel) + (progn + (sort-numeric-fields 2 (point) (point-max)) + (reverse-region (point) (point-max)) + (setq erc-chanlist-sort-state 'users)) + (sort-lines nil (point) (point-max)) + (setq erc-chanlist-sort-state 'channel)) + + (goto-char (point-min)) + (if (search-forward-regexp "^[0-9]+ channels (sorted by \\(.*\\)).$" + nil t) + (replace-match (if (eq erc-chanlist-sort-state 'channel) + "channel name" + "number of users") + nil nil nil 1)) + + (goto-char (point-min)) + (search-forward-regexp "^-----" nil t) + (forward-line 1) + (recenter -1) + + (erc-prettify-channel-list))))) + +(defun erc-chanlist-quit () + "Quit Chanlist mode. +Kill the channel list buffer, window, and frame (if there's a frame +devoted to the channel list)." + (interactive) + (kill-buffer (current-buffer)) + (if (eq (selected-frame) erc-chanlist-frame) + (delete-frame) + (delete-window))) + +(defun erc-chanlist-join-channel () + "Join the channel listed on the current line of the channel list buffer. +Private channels, which are shown as asterisks (*), are ignored." + (interactive) + (save-excursion + (beginning-of-line) + (when (looking-at erc-chanlist-channel-line-regexp) + (let ((channel-name (match-string 1))) + (when (and (stringp channel-name) + (not (string= channel-name "*"))) + (run-at-time 0.5 nil 'erc-join-channel channel-name)))))) + +(provide 'erc-list-old) + +;;; erc-list-old.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 4a13196a-a61b-465a-9926-044dfbc7e5ff diff --git a/lisp/erc-list.el b/lisp/erc-list.el new file mode 100644 index 0000000..586c720 --- /dev/null +++ b/lisp/erc-list.el @@ -0,0 +1,229 @@ +;;; erc-list.el --- /list support for ERC + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Tom Tromey +;; Version: 0.1 +;; Keywords: comm + +;; This file is part of ERC. + +;; ERC 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 3, or (at your option) +;; any later version. + +;; ERC 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 ERC; 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 file provides nice support for /list in ERC. + +;;; Code: + +(require 'erc) + +;; This is implicitly the width of the channel name column. Pick +;; something small enough that the topic has a chance of being +;; readable, but long enough that most channel names won't make for +;; strange formatting. +(defconst erc-list-nusers-column 25) + +;; Width of the number-of-users column. +(defconst erc-list-topic-column (+ erc-list-nusers-column 10)) + +;; The list buffer. This is buffer local in the server buffer. +(defvar erc-list-buffer nil) + +;; The argument to the last "/list". This is buffer local in the +;; server buffer. +(defvar erc-list-last-argument nil) + +;; The server buffer corresponding to the list buffer. This is buffer +;; local in the list buffer. +(defvar erc-list-server-buffer nil) + +;; Define module: +;;;###autoload (autoload 'erc-list-mode "erc-list") +(define-erc-module list nil + "List channels nicely in a separate buffer." + ((remove-hook 'erc-server-321-functions 'erc-server-321-message) + (remove-hook 'erc-server-322-functions 'erc-server-322-message)) + ((erc-with-all-buffers-of-server nil + #'erc-open-server-buffer-p + (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)) + (add-hook 'erc-server-321-functions 'erc-server-321-message t) + (add-hook 'erc-server-322-functions 'erc-server-322-message t))) + +;; Format a record for display. +(defun erc-list-make-string (channel users topic) + (concat + channel + (erc-propertize " " + 'display (list 'space :align-to erc-list-nusers-column) + 'face 'fixed-pitch) + users + (erc-propertize " " + 'display (list 'space :align-to erc-list-topic-column) + 'face 'fixed-pitch) + topic)) + +;; Insert a record into the list buffer. +(defun erc-list-insert-item (channel users topic) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (insert (erc-list-make-string channel users topic) "\n")))) + +(defun erc-list-join () + "Join the irc channel named on this line." + (interactive) + (unless (eobp) + (beginning-of-line) + (unless (looking-at "\\([&#+!][^ \n]+\\)") + (error "Not looking at channel name?")) + (let ((chan (match-string 1))) + (with-current-buffer erc-list-server-buffer + (erc-join-channel chan))))) + +(defun erc-list-kill () + "Kill the current ERC list buffer." + (interactive) + (kill-buffer (current-buffer))) + +(defun erc-list-revert () + "Refresh the list of channels." + (interactive) + (with-current-buffer erc-list-server-buffer + (erc-cmd-LIST erc-list-last-argument))) + +(defun erc-list-menu-sort-by-column (&optional e) + "Sort the channel list by the column clicked on." + (interactive (list last-input-event)) + (if e (mouse-select-window e)) + (let* ((pos (event-start e)) + (obj (posn-object pos)) + (col (if obj + (get-text-property (cdr obj) 'column-number (car obj)) + (get-text-property (posn-point pos) 'column-number)))) + (let ((buffer-read-only nil)) + (if (= col 1) + (sort-fields col (point-min) (point-max)) + (sort-numeric-fields col (point-min) (point-max)))))) + +(defvar erc-list-menu-mode-map nil + "Local keymap for `erc-list-mode' buffers.") + +(unless erc-list-menu-mode-map + (setq erc-list-menu-mode-map (make-keymap)) + (suppress-keymap erc-list-menu-mode-map) + (define-key erc-list-menu-mode-map "k" 'erc-list-kill) + (define-key erc-list-menu-mode-map "j" 'erc-list-join) + (define-key erc-list-menu-mode-map "g" 'erc-list-revert) + (define-key erc-list-menu-mode-map "n" 'next-line) + (define-key erc-list-menu-mode-map "p" 'previous-line) + (define-key erc-list-menu-mode-map "q" 'quit-window)) + +(defvar erc-list-menu-sort-button-map nil + "Local keymap for ERC list menu mode sorting buttons.") + +(unless erc-list-menu-sort-button-map + (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column) + (define-key map [follow-link] 'mouse-face) + (setq erc-list-menu-sort-button-map map))) + +;; Helper function that makes a buttonized column header. +(defun erc-list-button (title column) + (erc-propertize title + 'column-number column + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap erc-list-menu-sort-button-map)) + +(define-derived-mode erc-list-menu-mode nil "ERC-List" + "Major mode for editing a list of irc channels." + (setq header-line-format + (concat + (erc-propertize " " + 'display '(space :align-to 0) + 'face 'fixed-pitch) + (erc-list-make-string (erc-list-button "Channel" 1) + (erc-list-button "# Users" 2) + "Topic"))) + (setq truncate-lines t)) + +(put 'erc-list-menu-mode 'mode-class 'special) + +;; Handle a "322" response. This response tells us about a single +;; channel. +(defun erc-list-handle-322 (proc parsed) + (let* ((args (cdr (erc-response.command-args parsed))) + (channel (car args)) + (nusers (car (cdr args))) + (topic (erc-response.contents parsed))) + (when (buffer-live-p erc-list-buffer) + (with-current-buffer erc-list-buffer + (erc-list-insert-item channel nusers topic)))) + ;; Don't let another hook run. + t) + +;; Helper function to install our 322 handler and make our buffer. +(defun erc-list-install-322-handler (server-buffer) + (with-current-buffer server-buffer + ;; Arrange for 322 responses to insert into our buffer. + (add-hook 'erc-server-322-functions 'erc-list-handle-322 t t) + ;; Arrange for 323 (end of list) to end this. + (erc-once-with-server-event + 323 + '(progn + (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))) + ;; Find the list buffer, empty it, and display it. + (set (make-local-variable 'erc-list-buffer) + (get-buffer-create (concat "*Channels of " + erc-server-announced-name + "*"))) + (with-current-buffer erc-list-buffer + (erc-list-menu-mode) + (setq buffer-read-only nil) + (erase-buffer) + (set (make-local-variable 'erc-list-server-buffer) server-buffer) + (setq buffer-read-only t)) + (pop-to-buffer erc-list-buffer)) + t) + +;; The main entry point. +(defun erc-cmd-LIST (&optional line) + "Show a listing of channels on the current server in a separate window. + +If LINE is specified, include it with the /LIST command. It +should usually be one or more channels, separated by commas. + +Please note that this function only works with IRC servers which conform +to RFC and send the LIST header (#321) at start of list transmission." + (erc-with-server-buffer + (set (make-local-variable 'erc-list-last-argument) line) + (erc-once-with-server-event + 321 + (list 'progn + (list 'erc-list-install-322-handler (current-buffer))))) + (erc-server-send (concat "LIST :" (or (and line (substring line 1)) + "")))) +(put 'erc-cmd-LIST 'do-not-parse-args t) + +;;; erc-list.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 99c5f9cb-6bac-4224-86bf-e394768cd1d0 diff --git a/lisp/erc-log.el b/lisp/erc-log.el new file mode 100644 index 0000000..c48b5d9 --- /dev/null +++ b/lisp/erc-log.el @@ -0,0 +1,456 @@ +;;; erc-log.el --- Logging facilities for ERC. + +;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Lawrence Mitchell +;; Keywords: IRC, chat, client, Internet, logging + +;; Created 2003-04-26 +;; Logging code taken from erc.el and modified to use markers. + +;; 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 3, 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 file implements log file writing support for ERC. + +;; Quick start: +;; +;; (require 'erc-log) +;; (setq erc-log-channels-directory "/path/to/logfiles") ; must be writable +;; (erc-log-enable) +;; +;; Or: +;; +;; M-x customize-variable erc-modules, and add "log". +;; +;; There are two ways to setup logging. The first (default) method +;; will save buffers on /part, /quit, or killing the channel +;; buffer. +;; +;; The second will write to the log files on each incoming or outgoing +;; line - this may not be optimal on a laptop HDD. To use this +;; method, add the following to the above instructions. +;; +;; (setq erc-save-buffer-on-part nil +;; erc-save-queries-on-quit nil +;; erc-log-write-after-send t +;; erc-log-write-after-insert t) +;; +;; If you only want to save logs for some buffers, customise the +;; variable `erc-enable-logging'. + +;; How it works: +;; +;; If logging is enabled, at some point, `erc-save-buffer-in-logs' +;; will be called. The "end" of the buffer is taken from +;; `erc-insert-marker', while `erc-last-saved-position' holds the +;; position the buffer was last saved at (as a marker, or if the +;; buffer hasn't been saved before, as the number 1 (point-min)). + +;; The region between `erc-last-saved-position' and +;; `erc-insert-marker' is saved to the current buffer's logfile, and +;; `erc-last-saved-position' is updated to reflect this. + +;;; History: +;; 2003-04-26: logging code pulled out of erc.el. Switched to using +;; markers. + +;;; TODO: +;; +;; * Really, we need to lock the logfiles somehow, so that if a user +;; is running multiple emacsen and/or on the same channel as more +;; than one user, only one process writes to the logfile. This is +;; especially needed for those logfiles with no nick in them, as +;; these would become corrupted. +;; For a single emacs process, the problem could be solved using a +;; variable which contained the names of buffers already being +;; logged. This would require that logging be buffer-local, +;; possibly not a bad thing anyway, since many people don't want to +;; log the server buffer. +;; For multiple emacsen the problem is trickier. On some systems, +;; on could use the function `lock-buffer' and `unlock-buffer'. +;; However, file locking isn't implemented on all platforms, for +;; example, there is none on w32 systems. +;; A third possibility might be to fake lockfiles. However, this +;; might lead to problems if an emacs crashes, as the lockfile +;; would be left lying around. + +;;; Code: + +(require 'erc) +(eval-when-compile + (require 'erc-networks) + (require 'cl)) + +(defgroup erc-log nil + "Logging facilities for ERC." + :group 'erc) + +(defcustom erc-generate-log-file-name-function 'erc-generate-log-file-name-long + "*A function to generate a log filename. +The function must take five arguments: BUFFER, TARGET, NICK, SERVER and PORT. +BUFFER is the buffer to be saved, +TARGET is the name of the channel, or the target of the query, +NICK is the current nick, +SERVER and PORT are the parameters that were used to connect to BUFFERs +`erc-server-process'. + +If you want to write logs into different directories, make a +custom function which returns the directory part and set +`erc-log-channels-directory' to its name." + :group 'erc-log + :type '(choice (const :tag "Long style" erc-generate-log-file-name-long) + (const :tag "Long, but with network name rather than server" + erc-generate-log-file-name-network) + (const :tag "Short" erc-generate-log-file-name-short) + (const :tag "With date" erc-generate-log-file-name-with-date) + (function :tag "Other function"))) + +(defcustom erc-truncate-buffer-on-save nil + "Truncate any ERC (channel, query, server) buffer when it is saved." + :group 'erc-log + :type 'boolean) + +(defcustom erc-enable-logging t + "If non-nil, ERC will log IRC conversations. +This can either be a boolean value of nil or t, or a function. +If the value is a function, it will be called with one argument, the +name of the current ERC buffer. One possible function, which saves +all but server buffers is `erc-log-all-but-server-buffers'. + +This variable is buffer local. Setting it via \\[customize] sets the +default value. + +Log files are stored in `erc-log-channels-directory'." + :group 'erc-log + :type '(choice boolean + function)) +(make-variable-buffer-local 'erc-enable-logging) + +(defcustom erc-log-channels-directory "~/log" + "The directory to place log files for channels. +Leave blank to disable logging. If not nil, all the channel +buffers are logged in separate files in that directory. The +directory should not end with a trailing slash. + +If this is the name of a function, the function will be called +with the buffer, target, nick, server, and port arguments. See +`erc-generate-log-file-name-function' for a description of these +arguments." + :group 'erc-log + :type '(choice directory + (function "Function") + (const :tag "Disable logging" nil))) + +(defcustom erc-log-insert-log-on-open nil + "*Insert log file contents into the buffer if a log file exists." + :group 'erc-log + :type 'boolean) + +(defcustom erc-save-buffer-on-part t + "*Save the channel buffer content using `erc-save-buffer-in-logs' on PART. + +If you set this to nil, you may want to enable both +`erc-log-write-after-send' and `erc-log-write-after-insert'." + :group 'erc-log + :type 'boolean) + +(defcustom erc-save-queries-on-quit t + "*Save all query (also channel) buffers of the server on QUIT. + +If you set this to nil, you may want to enable both +`erc-log-write-after-send' and `erc-log-write-after-insert'." + :group 'erc-log + :type 'boolean) + +(defcustom erc-log-write-after-send nil + "*If non-nil, write to log file after every message you send. + +If you set this to nil, you may want to enable both +`erc-save-buffer-on-part' and `erc-save-queries-on-quit'." + :group 'erc-log + :type 'boolean) + +(defcustom erc-log-write-after-insert nil + "*If non-nil, write to log file when new text is added to a +logged ERC buffer. + +If you set this to nil, you may want to enable both +`erc-save-buffer-on-part' and `erc-save-queries-on-quit'." + :group 'erc-log + :type 'boolean) + +(defcustom erc-log-file-coding-system (if (featurep 'xemacs) + 'binary + 'emacs-mule) + "*The coding system ERC should use for writing log files. + +This should ideally, be a \"catch-all\" coding system, like +`emacs-mule', or `iso-2022-7bit'." + :group 'erc-log) + +(defcustom erc-log-filter-function nil + "*If non-nil, pass text through the given function before writing it to +a log file. + +The function should take one argument, which is the text to filter." + :group 'erc-log + :type '(choice (function "Function") + (const :tag "No filtering" nil))) + + +;;;###autoload (autoload 'erc-log-mode "erc-log" nil t) +(define-erc-module log nil + "Automatically logs things you receive on IRC into files. +Files are stored in `erc-log-channels-directory'; file name +format is defined through a formatting function on +`erc-generate-log-file-name-function'. + +Since automatic logging is not always a Good Thing (especially if +people say things in different coding systems), you can turn logging +behavior on and off with the variable `erc-enable-logging', which can +also be a predicate function. To only log when you are not set away, use: + +\(setq erc-enable-logging + (lambda (buffer) + (with-current-buffer buffer + (null (erc-away-time)))))" + ;; enable + ((when erc-log-write-after-insert + (add-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs)) + (when erc-log-write-after-send + (add-hook 'erc-send-post-hook 'erc-save-buffer-in-logs)) + (add-hook 'erc-kill-buffer-hook 'erc-save-buffer-in-logs) + (add-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs) + (add-hook 'kill-emacs-hook 'erc-log-save-all-buffers) + (add-hook 'erc-quit-hook 'erc-conditional-save-queries) + (add-hook 'erc-part-hook 'erc-conditional-save-buffer) + ;; append, so that 'erc-initialize-log-marker runs first + (add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append) + (dolist (buffer (erc-buffer-list)) + (erc-log-setup-logging buffer))) + ;; disable + ((remove-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs) + (remove-hook 'erc-send-post-hook 'erc-save-buffer-in-logs) + (remove-hook 'erc-kill-buffer-hook 'erc-save-buffer-in-logs) + (remove-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs) + (remove-hook 'kill-emacs-hook 'erc-log-save-all-buffers) + (remove-hook 'erc-quit-hook 'erc-conditional-save-queries) + (remove-hook 'erc-part-hook 'erc-conditional-save-buffer) + (remove-hook 'erc-connect-pre-hook 'erc-log-setup-logging) + (dolist (buffer (erc-buffer-list)) + (erc-log-disable-logging buffer)))) + +(define-key erc-mode-map "\C-c\C-l" 'erc-save-buffer-in-logs) + +;;; functionality referenced from erc.el +(defun erc-log-setup-logging (buffer) + "Setup the buffer-local logging variables in the current buffer. +This function is destined to be run from `erc-connect-pre-hook'. +The current buffer is given by BUFFER." + (when (erc-logging-enabled buffer) + (with-current-buffer buffer + (auto-save-mode -1) + (setq buffer-file-name nil) + (erc-set-write-file-functions '(erc-save-buffer-in-logs)) + (when erc-log-insert-log-on-open + (ignore-errors (insert-file-contents (erc-current-logfile)) + (move-marker erc-last-saved-position + (1- (point-max)))))))) + +(defun erc-log-disable-logging (buffer) + "Disable logging in BUFFER." + (when (erc-logging-enabled buffer) + (with-current-buffer buffer + (setq buffer-offer-save nil + erc-enable-logging nil)))) + +(defun erc-log-all-but-server-buffers (buffer) + "Returns t if logging should be enabled in BUFFER. +Returns nil if `erc-server-buffer-p' returns t." + (save-excursion + (save-window-excursion + (set-buffer buffer) + (not (erc-server-buffer-p))))) + +(defun erc-save-query-buffers (process) + "Save all buffers of the given PROCESS." + (erc-with-all-buffers-of-server process + nil + (erc-save-buffer-in-logs))) + +(defun erc-conditional-save-buffer (buffer) + "Save Query BUFFER if `erc-save-queries-on-quit' is t." + (when erc-save-buffer-on-part + (erc-save-buffer-in-logs buffer))) + +(defun erc-conditional-save-queries (process) + "Save Query buffers of PROCESS if `erc-save-queries-on-quit' is t." + (when erc-save-queries-on-quit + (erc-save-query-buffers process))) + +;; Make sure that logs get saved, even if someone overrides the active +;; process prompt for a quick exit from Emacs +(defun erc-log-save-all-buffers () + (dolist (buffer (erc-buffer-list)) + (erc-save-buffer-in-logs buffer))) + +;;;###autoload +(defun erc-logging-enabled (&optional buffer) + "Return non-nil if logging is enabled for BUFFER. +If BUFFER is nil, the value of `current-buffer' is used. +Logging is enabled if `erc-log-channels-directory' is non-nil, the directory +is writeable (it will be created as necessary) and +`erc-enable-logging' returns a non-nil value." + (and erc-log-channels-directory + (or (functionp erc-log-channels-directory) + (erc-directory-writable-p erc-log-channels-directory)) + (if (functionp erc-enable-logging) + (funcall erc-enable-logging (or buffer (current-buffer))) + erc-enable-logging))) + +(defun erc-log-standardize-name (filename) + "Make FILENAME safe to use as the name of an ERC log. +This will not work with full paths, only names. + +Any unsafe characters in the name are replaced with \"!\". The +filename is downcased." + (downcase (erc-replace-regexp-in-string + "[/\\]" "!" (convert-standard-filename filename)))) + +(defun erc-current-logfile (&optional buffer) + "Return the logfile to use for BUFFER. +If BUFFER is nil, the value of `current-buffer' is used. +This is determined by `erc-generate-log-file-name-function'. +The result is converted to lowercase, as IRC is case-insensitive" + (unless buffer (setq buffer (current-buffer))) + (let ((target (or (buffer-name buffer) (erc-default-target))) + (nick (erc-current-nick)) + (server erc-session-server) + (port erc-session-port)) + (expand-file-name + (erc-log-standardize-name + (funcall erc-generate-log-file-name-function + buffer target nick server port)) + (if (functionp erc-log-channels-directory) + (funcall erc-log-channels-directory + buffer target nick server port) + erc-log-channels-directory)))) + +(defun erc-generate-log-file-name-with-date (buffer &rest ignore) + "This function computes a short log file name. +The name of the log file is composed of BUFFER and the current date. +This function is a possible value for `erc-generate-log-file-name-function'." + (concat (buffer-name buffer) "-" (format-time-string "%Y-%m-%d") ".txt")) + +(defun erc-generate-log-file-name-short (buffer &rest ignore) + "This function computes a short log file name. +In fact, it only uses the buffer name of the BUFFER argument, so +you can affect that using `rename-buffer' and the-like. This +function is a possible value for +`erc-generate-log-file-name-function'." + (concat (buffer-name buffer) ".txt")) + +(defun erc-generate-log-file-name-long (buffer target nick server port) + "Generates a log-file name in the way ERC always did it. +This results in a file name of the form #channel!nick@server:port.txt. +This function is a possible value for `erc-generate-log-file-name-function'." + (let ((file (concat + (if target (concat target "!")) + nick "@" server ":" (cond ((stringp port) port) + ((numberp port) + (number-to-string port))) ".txt"))) + ;; we need a make-safe-file-name function. + (convert-standard-filename file))) + +(defun erc-generate-log-file-name-network (buffer target nick server port) + "Generates a log-file name using the network name rather than server name. +This results in a file name of the form #channel!nick@network.txt. +This function is a possible value for `erc-generate-log-file-name-function'." + (require 'erc-networks) + (let ((file (concat + (if target (concat target "!")) + nick "@" + (or (with-current-buffer buffer (erc-network-name)) server) + ".txt"))) + ;; we need a make-safe-file-name function. + (convert-standard-filename file))) + +;;;###autoload +(defun erc-save-buffer-in-logs (&optional buffer) + "Append BUFFER contents to the log file, if logging is enabled. +If BUFFER is not provided, current buffer is used. +Logging is enabled if `erc-logging-enabled' returns non-nil. + +This is normally done on exit, to save the unsaved portion of the +buffer, since only the text that runs off the buffer limit is logged +automatically. + +You can save every individual message by putting this function on +`erc-insert-post-hook'." + (interactive) + (or buffer (setq buffer (current-buffer))) + (when (erc-logging-enabled buffer) + (let ((file (erc-current-logfile buffer)) + (coding-system erc-log-file-coding-system) + (inhibit-clash-detection t)) ; needed for XEmacs + (save-excursion + (with-current-buffer buffer + (save-restriction + (widen) + ;; early on in the initialization, don't try and write the log out + (when (and (markerp erc-last-saved-position) + (> erc-insert-marker (1+ erc-last-saved-position))) + (let ((start (1+ (marker-position erc-last-saved-position))) + (end (marker-position erc-insert-marker))) + (if (functionp erc-log-filter-function) + (let ((text (buffer-substring start end))) + (with-temp-buffer + (insert (funcall erc-log-filter-function text)) + (let ((coding-system-for-write coding-system)) + (write-region (point-min) (point-max) + file t 'nomessage)))) + (let ((coding-system-for-write coding-system)) + (write-region start end file t 'nomessage)))) + (if (and erc-truncate-buffer-on-save (interactive-p)) + (progn + (let ((inhibit-read-only t)) (erase-buffer)) + (move-marker erc-last-saved-position (point-max)) + (erc-display-prompt)) + (move-marker erc-last-saved-position + ;; If we place erc-last-saved-position at + ;; erc-insert-marker, because text gets + ;; inserted /before/ erc-insert-marker, + ;; the log file will not be saved + ;; (erc-last-saved-position will always + ;; be equal to erc-insert-marker). + (1- (marker-position erc-insert-marker))))) + (set-buffer-modified-p nil)))))) + t) + +(provide 'erc-log) + +;;; erc-log.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 54072f99-9f0a-4846-8908-2ccde92221de diff --git a/lisp/erc-maint.el b/lisp/erc-maint.el new file mode 100644 index 0000000..bae42bc --- /dev/null +++ b/lisp/erc-maint.el @@ -0,0 +1,3 @@ +(add-to-list 'load-path ".") + +;; arch-tag: 977c5231-16c4-46d2-88f0-90abe5a79ba1 diff --git a/lisp/erc-match.el b/lisp/erc-match.el new file mode 100644 index 0000000..a98b1d9 --- /dev/null +++ b/lisp/erc-match.el @@ -0,0 +1,640 @@ +;;; erc-match.el --- Highlight messages matching certain regexps + +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + +;; Author: Andreas Fuchs +;; Keywords: comm, faces +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMatch + +;; 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 3, 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 file includes stuff to work with pattern matching in ERC. If +;; you were used to customizing erc-fools, erc-keywords, erc-pals, +;; erc-dangerous-hosts and the like, this file contains these +;; customizable variables. + +;; Usage: +;; Put (erc-match-mode 1) into your ~/.emacs file. + +;;; Code: + +(require 'erc) +(eval-when-compile (require 'cl)) + +;; Customisation: + +(defgroup erc-match nil + "Keyword and Friend/Foe/... recognition. +Group containing all things concerning pattern matching in ERC +messages." + :group 'erc) + +;;;###autoload (autoload 'erc-match-mode "erc-match") +(define-erc-module match nil + "This mode checks whether messages match certain patterns. If so, +they are hidden or highlighted. This is controlled via the variables +`erc-pals', `erc-fools', `erc-keywords', `erc-dangerous-hosts', and +`erc-current-nick-highlight-type'. For all these highlighting types, +you can decide whether the entire message or only the sending nick is +highlighted." + ((add-hook 'erc-insert-modify-hook 'erc-match-message 'append)) + ((remove-hook 'erc-insert-modify-hook 'erc-match-message))) + +;; Remaining customizations + +(defcustom erc-pals nil + "List of pals on IRC." + :group 'erc-match + :type '(repeat regexp)) + +(defcustom erc-fools nil + "List of fools on IRC." + :group 'erc-match + :type '(repeat regexp)) + +(defcustom erc-keywords nil + "List of keywords to highlight in all incoming messages. +Each entry in the list is either a regexp, or a cons cell with the +regexp in the car and the face to use in the cdr. If no face is +specified, `erc-keyword-face' is used." + :group 'erc-match + :type '(repeat (choice regexp + (list regexp face)))) + +(defcustom erc-dangerous-hosts nil + "List of regexps for hosts to highlight. +Useful to mark nicks from dangerous hosts." + :group 'erc-match + :type '(repeat regexp)) + +(defcustom erc-current-nick-highlight-type 'keyword + "*Determines how to highlight text in which your current nickname appears +\(does not apply to text sent by you\). + +The following values are allowed: + + nil - do not highlight the message at all + 'keyword - highlight all instances of current nickname in message + 'nick - highlight the nick of the user who typed your nickname + 'nick-or-keyword - highlight the nick of the user who typed your nickname, + or all instances of the current nickname if there was + no sending user + 'all - highlight the entire message where current nickname occurs + +Any other value disables highlighting of current nickname altogether." + :group 'erc-match + :type '(choice (const nil) + (const nick) + (const keyword) + (const nick-or-keyword) + (const all))) + +(defcustom erc-pal-highlight-type 'nick + "*Determines how to highlight messages by pals. +See `erc-pals'. + +The following values are allowed: + + nil - do not highlight the message at all + 'nick - highlight pal's nickname only + 'all - highlight the entire message from pal + +Any other value disables pal highlighting altogether." + :group 'erc-match + :type '(choice (const nil) + (const nick) + (const all))) + +(defcustom erc-fool-highlight-type 'nick + "*Determines how to highlight messages by fools. +See `erc-fools'. + +The following values are allowed: + + nil - do not highlight the message at all + 'nick - highlight fool's nickname only + 'all - highlight the entire message from fool + +Any other value disables fool highlighting altogether." + :group 'erc-match + :type '(choice (const nil) + (const nick) + (const all))) + +(defcustom erc-keyword-highlight-type 'keyword + "*Determines how to highlight messages containing keywords. +See variable `erc-keywords'. + +The following values are allowed: + + 'keyword - highlight keyword only + 'all - highlight the entire message containing keyword + +Any other value disables keyword highlighting altogether." + :group 'erc-match + :type '(choice (const nil) + (const keyword) + (const all))) + +(defcustom erc-dangerous-host-highlight-type 'nick + "*Determines how to highlight messages by nicks from dangerous-hosts. +See `erc-dangerous-hosts'. + +The following values are allowed: + + 'nick - highlight nick from dangerous-host only + 'all - highlight the entire message from dangerous-host + +Any other value disables dangerous-host highlighting altogether." + :group 'erc-match + :type '(choice (const nil) + (const nick) + (const all))) + + +(defcustom erc-log-matches-types-alist '((keyword . "ERC Keywords")) + "Alist telling ERC where to log which match types. +Valid match type keys are: +- keyword +- pal +- dangerous-host +- fool +- current-nick + +The other element of each cons pair in this list is the buffer name to +use for the logged message." + :group 'erc-match + :type '(repeat (cons (choice :tag "Key" + (const keyword) + (const pal) + (const dangerous-host) + (const fool) + (const current-nick)) + (string :tag "Buffer name")))) + +(defcustom erc-log-matches-flag 'away + "Flag specifying when matched message logging should happen. +When nil, don't log any matched messages. +When t, log messages. +When 'away, log messages only when away." + :group 'erc-match + :type '(choice (const nil) + (const away) + (const t))) + +(defcustom erc-log-match-format "%t<%n:%c> %m" + "Format for matched Messages. +This variable specifies how messages in the corresponding log buffers will +be formatted. The various format specs are: + +%t Timestamp (uses `erc-timestamp-format' if non-nil or \"[%Y-%m-%d %H:%M] \") +%n Nickname of sender +%u Nickname!user@host of sender +%c Channel in which this was received +%m Message" + :group 'erc-match + :type 'string) + +(defcustom erc-beep-match-types '(current-nick) + "Types of matches to beep for when a match occurs. +The function `erc-beep-on-match' needs to be added to `erc-text-matched-hook' +for beeping to work." + :group 'erc-match + :type '(choice (repeat :tag "Beep on match" (choice + (const current-nick) + (const keyword) + (const pal) + (const dangerous-host) + (const fool))) + (const :tag "Don't beep" nil))) + +(defcustom erc-text-matched-hook '(erc-log-matches) + "Hook run when text matches a given match-type. +Functions in this hook are passed as arguments: +\(match-type nick!user@host message) where MATCH-TYPE is a symbol of: +current-nick, keyword, pal, dangerous-host, fool" + :options '(erc-log-matches erc-hide-fools erc-beep-on-match) + :group 'erc-match + :type 'hook) + +;; Internal variables: + +;; This is exactly the same as erc-button-syntax-table. Should we +;; just put it in erc.el +(defvar erc-match-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\( "w" table) + (modify-syntax-entry ?\) "w" table) + (modify-syntax-entry ?\[ "w" table) + (modify-syntax-entry ?\] "w" table) + (modify-syntax-entry ?\{ "w" table) + (modify-syntax-entry ?\} "w" table) + (modify-syntax-entry ?` "w" table) + (modify-syntax-entry ?' "w" table) + (modify-syntax-entry ?^ "w" table) + (modify-syntax-entry ?- "w" table) + (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?| "w" table) + (modify-syntax-entry ?\\ "w" table) + table) + "Syntax table used when highlighting messages. +This syntax table should make all the legal nick characters word +constituents.") + +;; Faces: + +(defface erc-current-nick-face '((t (:bold t :foreground "DarkTurquoise"))) + "ERC face for occurrences of your current nickname." + :group 'erc-faces) + +(defface erc-dangerous-host-face '((t (:foreground "red"))) + "ERC face for people on dangerous hosts. +See `erc-dangerous-hosts'." + :group 'erc-faces) + +(defface erc-pal-face '((t (:bold t :foreground "Magenta"))) + "ERC face for your pals. +See `erc-pals'." + :group 'erc-faces) + +(defface erc-fool-face '((t (:foreground "dim gray"))) + "ERC face for fools on the channel. +See `erc-fools'." + :group 'erc-faces) + +(defface erc-keyword-face '((t (:bold t :foreground "pale green"))) + "ERC face for your keywords. +Note that this is the default face to use if +`erc-keywords' does not specify another." + :group 'erc-faces) + +;; Functions: + +(defun erc-add-entry-to-list (list prompt &optional completions) + "Add an entry interactively to a list. +LIST must be passed as a symbol +The query happens using PROMPT. +Completion is performed on the optional alist COMPLETIONS." + (let ((entry (completing-read + prompt + completions + (lambda (x) + (not (erc-member-ignore-case (car x) (symbol-value list))))))) + (if (erc-member-ignore-case entry (symbol-value list)) + (error "\"%s\" is already on the list" entry) + (set list (cons entry (symbol-value list)))))) + +(defun erc-remove-entry-from-list (list prompt) + "Remove an entry interactively from a list. +LIST must be passed as a symbol. +The elements of LIST can be strings, or cons cells where the +car is the string." + (let* ((alist (mapcar (lambda (x) + (if (listp x) + x + (list x))) + (symbol-value list))) + (entry (completing-read + prompt + alist + nil + t))) + (if (erc-member-ignore-case entry (symbol-value list)) + ;; plain string + (set list (delete entry (symbol-value list))) + ;; cons cell + (set list (delete (assoc entry (symbol-value list)) + (symbol-value list)))))) + +;;;###autoload +(defun erc-add-pal () + "Add pal interactively to `erc-pals'." + (interactive) + (erc-add-entry-to-list 'erc-pals "Add pal: " (erc-get-server-nickname-alist))) + +;;;###autoload +(defun erc-delete-pal () + "Delete pal interactively to `erc-pals'." + (interactive) + (erc-remove-entry-from-list 'erc-pals "Delete pal: ")) + +;;;###autoload +(defun erc-add-fool () + "Add fool interactively to `erc-fools'." + (interactive) + (erc-add-entry-to-list 'erc-fools "Add fool: " + (erc-get-server-nickname-alist))) + +;;;###autoload +(defun erc-delete-fool () + "Delete fool interactively to `erc-fools'." + (interactive) + (erc-remove-entry-from-list 'erc-fools "Delete fool: ")) + +;;;###autoload +(defun erc-add-keyword () + "Add keyword interactively to `erc-keywords'." + (interactive) + (erc-add-entry-to-list 'erc-keywords "Add keyword: ")) + +;;;###autoload +(defun erc-delete-keyword () + "Delete keyword interactively to `erc-keywords'." + (interactive) + (erc-remove-entry-from-list 'erc-keywords "Delete keyword: ")) + +;;;###autoload +(defun erc-add-dangerous-host () + "Add dangerous-host interactively to `erc-dangerous-hosts'." + (interactive) + (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: ")) + +;;;###autoload +(defun erc-delete-dangerous-host () + "Delete dangerous-host interactively to `erc-dangerous-hosts'." + (interactive) + (erc-remove-entry-from-list 'erc-dangerous-hosts "Delete dangerous-host: ")) + +(defun erc-match-current-nick-p (nickuserhost msg) + "Check whether the current nickname is in MSG. +NICKUSERHOST will be ignored." + (with-syntax-table erc-match-syntax-table + (and msg + (string-match (concat "\\b" + (regexp-quote (erc-current-nick)) + "\\b") + msg)))) + +(defun erc-match-pal-p (nickuserhost msg) + "Check whether NICKUSERHOST is in `erc-pals'. +MSG will be ignored." + (and nickuserhost + (erc-list-match erc-pals nickuserhost))) + +(defun erc-match-fool-p (nickuserhost msg) + "Check whether NICKUSERHOST is in `erc-fools' or MSG is directed at a fool." + (and msg nickuserhost + (or (erc-list-match erc-fools nickuserhost) + (erc-match-directed-at-fool-p msg)))) + +(defun erc-match-keyword-p (nickuserhost msg) + "Check whether any keyword of `erc-keywords' matches for MSG. +NICKUSERHOST will be ignored." + (and msg + (erc-list-match + (mapcar (lambda (x) + (if (listp x) + (car x) + x)) + erc-keywords) + msg))) + +(defun erc-match-dangerous-host-p (nickuserhost msg) + "Check whether NICKUSERHOST is in `erc-dangerous-hosts'. +MSG will be ignored." + (and nickuserhost + (erc-list-match erc-dangerous-hosts nickuserhost))) + +(defun erc-match-directed-at-fool-p (msg) + "Check whether MSG is directed at a fool. +In order to do this, every entry in `erc-fools' will be used. +In any of the following situations, MSG is directed at an entry FOOL: + +- MSG starts with \"FOOL: \" or \"FOO, \" +- MSG contains \", FOOL.\" (actually, \"\\s. FOOL\\s.\")" + (let ((fools-beg (mapcar (lambda (entry) + (concat "^" entry "[:,] ")) + erc-fools)) + (fools-end (mapcar (lambda (entry) + (concat "\\s. " entry "\\s.")) + erc-fools))) + (or (erc-list-match fools-beg msg) + (erc-list-match fools-end msg)))) + +(defun erc-match-message () + "Mark certain keywords in a region. +Use this defun with `erc-insert-modify-hook'." + ;; This needs some refactoring. + (goto-char (point-min)) + (let* ((to-match-nick-dep '("pal" "fool" "dangerous-host")) + (to-match-nick-indep '("keyword" "current-nick")) + (vector (erc-get-parsed-vector (point-min))) + (nickuserhost (erc-get-parsed-vector-nick vector)) + (nickname (and nickuserhost + (nth 0 (erc-parse-user nickuserhost)))) + (old-pt (point)) + (nick-beg (and nickname + (re-search-forward (regexp-quote nickname) + (point-max) t) + (match-beginning 0))) + (nick-end (when nick-beg + (match-end 0))) + (message (buffer-substring (if (and nick-end + (<= (+ 2 nick-end) (point-max))) + (+ 2 nick-end) + (point-min)) + (point-max)))) + (when vector + (mapc + (lambda (match-type) + (goto-char (point-min)) + (let* ((match-prefix (concat "erc-" match-type)) + (match-pred (intern (concat "erc-match-" match-type "-p"))) + (match-htype (eval (intern (concat match-prefix + "-highlight-type")))) + (match-regex (if (string= match-type "current-nick") + (regexp-quote (erc-current-nick)) + (eval (intern (concat match-prefix "s"))))) + (match-face (intern (concat match-prefix "-face")))) + (when (funcall match-pred nickuserhost message) + (cond + ;; Highlight the nick of the message + ((and (eq match-htype 'nick) + nick-end) + (erc-put-text-property + nick-beg nick-end + 'face match-face (current-buffer))) + ;; Highlight the nick of the message, or the current + ;; nick if there's no nick in the message (e.g. /NAMES + ;; output) + ((and (string= match-type "current-nick") + (eq match-htype 'nick-or-keyword)) + (if nick-end + (erc-put-text-property + nick-beg nick-end + 'face match-face (current-buffer)) + (goto-char (+ 2 (or nick-end + (point-min)))) + (while (re-search-forward match-regex nil t) + (erc-put-text-property (match-beginning 0) (match-end 0) + 'face match-face)))) + ;; Highlight the whole message + ((eq match-htype 'all) + (erc-put-text-property + (point-min) (point-max) + 'face match-face (current-buffer))) + ;; Highlight all occurrences of the word to be + ;; highlighted. + ((and (string= match-type "keyword") + (eq match-htype 'keyword)) + (mapc (lambda (elt) + (let ((regex elt) + (face match-face)) + (when (consp regex) + (setq regex (car elt) + face (cdr elt))) + (goto-char (+ 2 (or nick-end + (point-min)))) + (while (re-search-forward regex nil t) + (erc-put-text-property + (match-beginning 0) (match-end 0) + 'face face)))) + match-regex)) + ;; Highlight all occurrences of our nick. + ((and (string= match-type "current-nick") + (eq match-htype 'keyword)) + (goto-char (+ 2 (or nick-end + (point-min)))) + (while (re-search-forward match-regex nil t) + (erc-put-text-property (match-beginning 0) (match-end 0) + 'face match-face))) + ;; Else twiddle your thumbs. + (t nil)) + (run-hook-with-args + 'erc-text-matched-hook + (intern match-type) + (or nickuserhost + (concat "Server:" (erc-get-parsed-vector-type vector))) + message)))) + (if nickuserhost + (append to-match-nick-dep to-match-nick-indep) + to-match-nick-indep))))) + +(defun erc-log-matches (match-type nickuserhost message) + "Log matches in a separate buffer, determined by MATCH-TYPE. +The behavior of this function is controlled by the variables +`erc-log-matches-types-alist' and `erc-log-matches-flag'. +Specify the match types which should be logged in the former, +and deactivate/activate match logging in the latter. +See `erc-log-match-format'." + (let ((match-buffer-name (cdr (assq match-type + erc-log-matches-types-alist))) + (nick (nth 0 (erc-parse-user nickuserhost)))) + (when (and + (or (eq erc-log-matches-flag t) + (and (eq erc-log-matches-flag 'away) + (erc-away-time))) + match-buffer-name) + (let ((line (format-spec erc-log-match-format + (format-spec-make + ?n nick + ?t (format-time-string + (or (and (boundp 'erc-timestamp-format) + erc-timestamp-format) + "[%Y-%m-%d %H:%M] ")) + ?c (or (erc-default-target) "") + ?m message + ?u nickuserhost)))) + (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (insert line))))))) + +(defun erc-log-matches-make-buffer (name) + "Create or get a log-matches buffer named NAME and return it." + (let* ((buffer-already (get-buffer name)) + (buffer (or buffer-already + (get-buffer-create name)))) + (with-current-buffer buffer + (unless buffer-already + (insert " == Type \"q\" to dismiss messages ==\n") + (erc-view-mode-enter nil (lambda (buffer) + (when (y-or-n-p "Discard messages? ") + (kill-buffer buffer))))) + buffer))) + +(defun erc-log-matches-come-back (proc parsed) + "Display a notice that messages were logged while away." + (when (and (erc-away-time) + (eq erc-log-matches-flag 'away)) + (mapc + (lambda (match-type) + (let ((buffer (get-buffer (cdr match-type))) + (buffer-name (cdr match-type))) + (when buffer + (let* ((last-msg-time (erc-emacs-time-to-erc-time + (with-current-buffer buffer + (get-text-property (1- (point-max)) + 'timestamp)))) + (away-time (erc-emacs-time-to-erc-time (erc-away-time)))) + (when (and away-time last-msg-time + (erc-time-gt last-msg-time away-time)) + (erc-display-message + nil 'notice 'active + (format "You have logged messages waiting in \"%s\"." + buffer-name)) + (erc-display-message + nil 'notice 'active + (format "Type \"C-c C-k %s RET\" to view them." + buffer-name))))))) + erc-log-matches-types-alist)) + nil) + +; This handler must be run _before_ erc-process-away is. +(add-hook 'erc-server-305-functions 'erc-log-matches-come-back nil) + +(defun erc-go-to-log-matches-buffer () + "Interactively open an erc-log-matches buffer." + (interactive) + (let ((buffer-name (completing-read "Switch to ERC Log buffer: " + (mapcar (lambda (x) + (cons (cdr x) t)) + erc-log-matches-types-alist) + (lambda (buffer-cons) + (get-buffer (car buffer-cons)))))) + (switch-to-buffer buffer-name))) + +(define-key erc-mode-map "\C-c\C-k" 'erc-go-to-log-matches-buffer) + +(defun erc-hide-fools (match-type nickuserhost message) + "Hide foolish comments. +This function should be called from `erc-text-matched-hook'." + (when (eq match-type 'fool) + (erc-put-text-properties (point-min) (point-max) + '(invisible intangible) + (current-buffer)))) + +(defun erc-beep-on-match (match-type nickuserhost message) + "Beep when text matches. +This function is meant to be called from `erc-text-matched-hook'." + (when (member match-type erc-beep-match-types) + (beep))) + +(provide 'erc-match) + +;;; erc-match.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 1f1f595e-abcc-4b0b-83db-598a1d3f0f82 diff --git a/lisp/erc-menu.el b/lisp/erc-menu.el new file mode 100644 index 0000000..c47f754 --- /dev/null +++ b/lisp/erc-menu.el @@ -0,0 +1,154 @@ +;; erc-menu.el -- Menu-bar definitions for ERC + +;; Copyright (C) 2001, 2002, 2004, 2005, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm, processes, menu + +;; 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 3, 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: + +;; Loading this file defines a menu for ERC. + +;;; Code: + +(require 'erc) +(require 'easymenu) + +(defvar erc-menu-definition + (list "ERC" + ["Connect to server..." erc t] + ["Disconnect from server..." erc-quit-server erc-server-connected] + "-" + ["List channels..." erc-list-channels + (and erc-server-connected (fboundp 'erc-list-channels))] + ["Join channel..." erc-join-channel erc-server-connected] + ["Start a query..." erc-cmd-QUERY erc-server-connected] + ["Input action..." erc-input-action (erc-default-target)] + "-" + (list + "Current channel" + ["List users in channel" erc-channel-names erc-channel-users] + ["List channel operators" erc-cmd-OPS erc-channel-users] + ["Set topic..." erc-set-topic + (and (and (erc-default-target) (not (erc-query-buffer-p))) + (or (not (member "t" erc-channel-modes)) + (erc-channel-user-op-p (erc-current-nick))))] + (list "Channel modes" + ["Change mode..." erc-insert-mode-command + (erc-channel-user-op-p (erc-current-nick))] + ["No external send" (erc-toggle-channel-mode "n") + :active (erc-channel-user-op-p (erc-current-nick)) + :style toggle :selected (member "n" erc-channel-modes)] + ["Topic set by channel operator" (erc-toggle-channel-mode "t") + :style toggle :selected (member "t" erc-channel-modes) + :active (erc-channel-user-op-p (erc-current-nick))] + ["Invite only" (erc-toggle-channel-mode "i") + :style toggle :selected (member "i" erc-channel-modes) + :active (erc-channel-user-op-p (erc-current-nick))] + ["Private" (erc-toggle-channel-mode "p") + :style toggle :selected (member "p" erc-channel-modes) + :active (erc-channel-user-op-p (erc-current-nick))] + ["Secret" (erc-toggle-channel-mode "s") + :style toggle :selected (member "s" erc-channel-modes) + :active (erc-channel-user-op-p (erc-current-nick))] + ["Moderated" (erc-toggle-channel-mode "m") + :style toggle :selected (member "m" erc-channel-modes) + :active (erc-channel-user-op-p (erc-current-nick))] + ["Set a limit..." erc-set-channel-limit + (erc-channel-user-op-p (erc-current-nick))] + ["Set a key..." erc-set-channel-key + (erc-channel-user-op-p (erc-current-nick))]) + ["Leave this channel..." erc-part-from-channel erc-channel-users]) + "-" + (list "Pals, fools and other keywords" + ["Add pal..." erc-add-pal] + ["Delete pal..." erc-delete-pal] + ["Add fool..." erc-add-fool] + ["Delete fool..." erc-delete-fool] + ["Add keyword..." erc-add-keyword] + ["Delete keyword..." erc-delete-keyword] + ["Add dangerous host..." erc-add-dangerous-host] + ["Delete dangerous host..." erc-delete-dangerous-host]) + "-" + (list "IRC services" + ["Identify to NickServ..." erc-nickserv-identify + (and erc-server-connected (functionp 'erc-nickserv-identify))]) + "-" + ["Save buffer in log" erc-save-buffer-in-logs + (fboundp 'erc-save-buffer-in-logs)] + ["Truncate buffer" erc-truncate-buffer (fboundp 'erc-truncate-buffer)] + "-" + ["Customize ERC" (customize-group 'erc) t] + ["Enable/Disable ERC Modules" (customize-variable 'erc-modules) t] + ["Show ERC version" erc-version t]) + "ERC menu definition.") + +(defvar erc-menu-defined nil + "Internal variable used to keep track of whether we've defined the +ERC menu yet.") + +;;;###autoload (autoload 'erc-menu-mode "erc-menu" nil t) +(define-erc-module menu nil + "Enable a menu in ERC buffers." + ((unless erc-menu-defined + ;; make sure the menu only gets defined once, since Emacs 22 + ;; activates it immediately + (easy-menu-define erc-menu erc-mode-map "ERC menu" erc-menu-definition) + (setq erc-menu-defined t)) + (if (featurep 'xemacs) + (progn + ;; the menu isn't automatically added to the menu bar in + ;; XEmacs + (add-hook 'erc-mode-hook 'erc-menu-add) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer (erc-menu-add)))) + (erc-menu-add))) + ((if (featurep 'xemacs) + (progn + (remove-hook 'erc-mode-hook 'erc-menu-add) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer (erc-menu-remove)))) + (erc-menu-remove) + ;; `easy-menu-remove' is a no-op in Emacs 22 + (message "You might have to restart Emacs to remove the ERC menu")))) + +;; silence byte-compiler warning +(eval-when-compile + (defvar erc-menu nil)) + +(defun erc-menu-add () + "Add the ERC menu to the current buffer." + (easy-menu-add erc-menu erc-mode-map)) + +(defun erc-menu-remove () + "Remove the ERC menu from the current buffer." + (easy-menu-remove erc-menu)) + +(provide 'erc-menu) + +;;; erc-menu.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 671219f2-b082-4753-a185-1d0c7e0c05bd diff --git a/lisp/erc-netsplit.el b/lisp/erc-netsplit.el new file mode 100644 index 0000000..5bcb432 --- /dev/null +++ b/lisp/erc-netsplit.el @@ -0,0 +1,214 @@ +;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm + +;; 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 3, 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 module hides quit/join messages if a netsplit occurs. +;; To enable, add the following to your ~/.emacs: +;; (require 'erc-netsplit) +;; (erc-netsplit-mode 1) + +;;; Code: + +(require 'erc) +(eval-when-compile (require 'cl)) + +(defgroup erc-netsplit nil + "Netsplit detection tries to automatically figure when a +netsplit happens, and filters the QUIT messages. It also keeps +track of netsplits, so that it can filter the JOIN messages on a netjoin too." + :group 'erc) + +;;;###autoload (autoload 'erc-netsplit-mode "erc-netsplit") +(define-erc-module netsplit nil + "This mode hides quit/join messages if a netsplit occurs." + ((erc-netsplit-install-message-catalogs) + (add-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN) + (add-hook 'erc-server-MODE-functions 'erc-netsplit-MODE) + (add-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT) + (add-hook 'erc-timer-hook 'erc-netsplit-timer)) + ((remove-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN) + (remove-hook 'erc-server-MODE-functions 'erc-netsplit-MODE) + (remove-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT) + (remove-hook 'erc-timer-hook 'erc-netsplit-timer))) + +(defcustom erc-netsplit-show-server-mode-changes-flag nil + "Set to t to enable display of server mode changes." + :group 'erc-netsplit + :type 'boolean) + +(defcustom erc-netsplit-debug nil + "If non-nil, debug messages will be shown in the +sever buffer." + :group 'erc-netsplit + :type 'boolean) + +(defcustom erc-netsplit-regexp + "^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$" + "This regular expression should match quit reasons produced +by netsplits." + :group 'erc-netsplit + :type 'regexp) + +(defcustom erc-netsplit-hook nil + "Run whenever a netsplit is detected the first time. +Args: PROC is the process the netsplit originated from and + SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-netjoin-hook nil + "Run whenever a netjoin is detected the first time. +Args: PROC is the process the netjoin originated from and + SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")." + :group 'erc-hooks + :type 'hook) + +(defvar erc-netsplit-list nil + "This is a list of the form +\((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...) +where FIRST-JOIN is t or nil, depending on whether or not the first +join from that split has been detected or not.") +(make-variable-buffer-local 'erc-netsplit-list) + +(defun erc-netsplit-install-message-catalogs () + (erc-define-catalog + 'english + '((netsplit . "netsplit: %s") + (netjoin . "netjoin: %s, %N were split") + (netjoin-done . "netjoin: All lost souls are back!") + (netsplit-none . "No netsplits in progress") + (netsplit-wholeft . "split: %s missing: %n %t")))) + +(defun erc-netsplit-JOIN (proc parsed) + "Show/don't show rejoins." + (let ((nick (erc-response.sender parsed)) + (no-next-hook nil)) + (dolist (elt erc-netsplit-list) + (if (member nick (nthcdr 3 elt)) + (progn + (if (not (caddr elt)) + (progn + (erc-display-message + parsed 'notice (process-buffer proc) + 'netjoin ?s (car elt) ?N (length (nthcdr 3 elt))) + (setcar (nthcdr 2 elt) t) + (run-hook-with-args 'erc-netjoin-hook proc (car elt)))) + ;; need to remove this nick, perhaps the whole entry here. + ;; Note that by removing the nick now, we can't tell if further + ;; join messages (for other channels) should also be + ;; suppressed. + (if (null (nthcdr 4 elt)) + (progn + (erc-display-message + parsed 'notice (process-buffer proc) + 'netjoin-done ?s (car elt)) + (setq erc-netsplit-list (delq elt erc-netsplit-list))) + (delete nick elt)) + (setq no-next-hook t)))) + no-next-hook)) + +(defun erc-netsplit-MODE (proc parsed) + "Hide mode changes from servers." + ;; regexp matches things with a . in them, and no ! or @ in them. + (when (string-match "^[^@!\n]+\\.[^@!\n]+$" (erc-response.sender parsed)) + (and erc-netsplit-debug + (erc-display-message + parsed 'notice (process-buffer proc) + "[debug] server mode change.")) + (not erc-netsplit-show-server-mode-changes-flag))) + +(defun erc-netsplit-QUIT (proc parsed) + "Detect netsplits." + (let ((split (erc-response.contents parsed)) + (nick (erc-response.sender parsed)) + ass) + (when (string-match erc-netsplit-regexp split) + (setq ass (assoc split erc-netsplit-list)) + (if ass + ;; element for this netsplit exists already + (progn + (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) + (when (caddr ass) + ;; There was already a netjoin for this netsplit, it + ;; seems like the old one didn't get finished... + (erc-display-message + parsed 'notice (process-buffer proc) + 'netsplit ?s split) + (setcar (nthcdr 2 ass) t) + (run-hook-with-args 'erc-netsplit-hook proc split))) + ;; element for this netsplit does not yet exist + (setq erc-netsplit-list + (cons (list split + (erc-current-time) + nil + nick) + erc-netsplit-list)) + (erc-display-message + parsed 'notice (process-buffer proc) + 'netsplit ?s split) + (run-hook-with-args 'erc-netsplit-hook proc split)) + t))) + +(defun erc-netsplit-timer (now) + "Clean cruft from `erc-netsplit-list' older than 10 minutes." + (when erc-server-connected + (dolist (elt erc-netsplit-list) + (when (> (erc-time-diff (cadr elt) now) 600) + (when erc-netsplit-debug + (erc-display-message + nil 'notice (current-buffer) + (concat "Netsplit: Removing " (car elt)))) + (setq erc-netsplit-list (delq elt erc-netsplit-list)))))) + +;;;###autoload +(defun erc-cmd-WHOLEFT () + "Show who's gone." + (erc-with-server-buffer + (if (null erc-netsplit-list) + (erc-display-message + nil 'notice 'active + 'netsplit-none) + (dolist (elt erc-netsplit-list) + (erc-display-message + nil 'notice 'active + 'netsplit-wholeft ?s (car elt) + ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") + ?t (if (caddr elt) + "(joining)" + ""))))) + t) + +(defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT) + +(provide 'erc-netsplit) + +;;; erc-netsplit.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 61a85cb0-7e7b-4312-a4f6-313c7a25a6e8 diff --git a/lisp/erc-networks.el b/lisp/erc-networks.el new file mode 100644 index 0000000..b74fdb2 --- /dev/null +++ b/lisp/erc-networks.el @@ -0,0 +1,870 @@ +;;; erc-networks.el --- IRC networks + +;; Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm + +;; 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 3, 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 file deals with IRC networks. +;; +;; Usage: +;; +;; This is the "networks" module. +;; +;; M-x erc-server-select provides an alternative way to connect to servers by +;; choosing networks. +;; You can use (eq (erc-network) 'Network) if you'd like to set variables or do +;; certain actions according to which network you're connected to. +;; If a network you use is not listed in `erc-networks-alist', you can put +;; (add-to-list 'erc-networks-alist '(Network "irc.server-name.net")) in your +;; config file. + +;;; Code: + +(require 'erc) +(eval-when-compile (require 'cl)) + +;; Variables + +(defgroup erc-networks nil + "IRC Networks" + :group 'erc) + +(defcustom erc-server-alist +'(("4-irc: Random server" 4-irc "4-irc.com" 6667) + ("A5KNet: Random server" A5KNet "irc.a5knet.com" ((6660 6669))) + ("AbleNet: Random server" AbleNet "irc.ablenet.org" 6667) + ("Accessirc: Random server" Accessirc "irc.accessirc.net" 6667) + ("Acestar: Random server" Acestar "irc.acestar.org" 6667) + ("Action-IRC: Random server" Action-IRC "irc.action-irc.net" ((6660 6669))) + ("AfterNET: Random server" AfterNET "irc.afternet.org" 6667) + ("Alternativenet: Random server" Alternativenet "irc.altnet.org" 6667) + ("AmigaNet: Random server" AmigaNet "irc.amiganet.org" 6667) + ("AngelEyez: Random server" AngelEyez "irc.angeleyez.net" ((6666 7000))) + ("AnotherNet: Random server" Anothernet "irc.another.net" (6667 7000 )) + ("ArabChat: Random server" ArabChat "irc.arabchat.org" ((6660 6667))) + ("Ars-OpenIRC: Random server" Ars "irc.arstechnica.com" 6667) + ("AsiaTalk: Random server" AsiaTalk "irc.asiatalk.org" ((6667 6669) 7000 )) + ("AstroLink: Random server" AstroLink "irc.astrolink.org" ((6660 6667))) + ("Asylumnet: Random server" Asylumnet "irc.asylum-net.org" ((6661 6669) 7000 7777 )) + ("Austnet: Random AU server" Austnet "au.austnet.org" 6667) + ("Austnet: Random NZ server" Austnet "nz.austnet.org" 6667) + ("Austnet: Random SG server" Austnet "sg.austnet.org" 6667) + ("Austnet: Random US server" Austnet "us.austnet.org" 6667) + ("AwesomeChat: Random server" AwesomeChat "irc.awesomechat.net" ((6661 6669))) + ("Awesomechristians: Random server" Awesomechristians "irc.awesomechristians.com" 7000) + ("Axenet: Random server" Axenet "irc.axenet.org" ((6660 6667))) + ("BeyondIRC: Random server" Beyondirc "irc.beyondirc.net" ((6660 6669))) + ("BGIRC: Random server" BGIRC "irc.bulgaria.org" ((6666 6669) 7000 )) + ("Blabbernet: Random server" Blabbernet "irc.blabber.net" (6667 7000 )) + ("Blitzed: Random server" Blitzed "irc.blitzed.org" (6667 7000 )) + ("Brasirc: Random server" Brasirc "irc.brasirc.net" ((6666 6667))) + ("Brasirc: BR, PA, Belem" Brasirc "irc.libnet.com.br" ((6666 6668) 7777 8002 )) + ("BRASnet: Random European server" BRASnet "eu.brasnet.org" ((6665 6669))) + ("BRASnet: Random US server" BRASnet "us.brasnet.org" ((6665 6669))) + ("BubbleNet: Random server" BubbleNet "irc.bubblenet.org" ((6667 6669))) + ("CCnet: Random server" CCnet "irc.cchat.net" (6667 7000 )) + ("CCnet: US, TX, Dallas" CCnet "irc2.cchat.net" (6667 7000 )) + ("Chat-Net: Random server" Chat-Net "irc.chat-net.org" 6667) + ("Chat-Solutions: Random server" Chat-Solutions "irc.chat-solutions.org" 6667) + ("Chatcafe: Random server" Chatcafe "irc.chatcafe.net" 6667) + ("Chatchannel: Random server" Chatchannel "irc.chatchannel.org" ((6666 6669) 7000 )) + ("ChatCircuit: Random server" ChatCircuit "irc.chatcircuit.com" 6668) + ("Chatlink: Random server" Chatlink "irc.chatlink.org" 6667) + ("Chatnet: Random AU server" Chatnet "au.chatnet.org" 6667) + ("Chatnet: Random EU server" Chatnet "eu.chatnet.org" 6667) + ("Chatnet: Random US server" Chatnet "us.chatnet.org" 6667) + ("ChatNut: Random server" ChatNut "irc.chatnut.net" (6667 7000 )) + ("Chatpinoy: Random server" Chatpinoy "irc.chatpinoy.com" 6667) + ("ChatPR: Random server" ChatPR "irc.chatpr.org" 6667) + ("Chatroom: Random server" Chatroom "irc.chatroom.org" 6667) + ("Chatster: Random server" Chatster "irc.chatster.org" 6667) + ("ChatX: Random server" ChatX "irc.chatx.net" 6667) + ("China263: Random server" China263 "irc.263.net" 6667) + ("Cineplex1: Random server" Cineplex1 "irc.cineplex1.com" ((6666 6668))) + ("CNN: CNN News discussions" CNN "chat.cnn.com" ((6667 6669) 7000 )) + ("CobraNet: Random server" CobraNet "irc.cobra.net" 6667) + ("Coolchat: Random server" Coolchat "irc.coolchat.net" 6667) + ("Criten: Random server" Criten "irc.criten.net" 6667) + ("Cyberchat: Random server" Cyberchat "irc.cyberchat.org" (6667 6668 )) + ("CyGanet: Random server" CyGanet "irc.cyga.net" 6667) + ("DALnet: AS, MY, Coins" DALnet "coins.dal.net" ((6663 6668) 7000 )) + ("DALnet: CA, ON, Sodre" DALnet "sodre.on.ca.dal.net" ((6661 6669) 7000 )) + ("DALnet: EU, DE, Nexgo" DALnet "nexgo.de.eu.dal.net" ((6664 6669) 7000 )) + ("DALnet: EU, NO, Powertech" DALnet "powertech.no.eu.dal.net" ((6666 6667) 7000 )) + ("DALnet: EU, SE, Borg" DALnet "borg.se.eu.dal.net" (6667 7000 )) + ("DALnet: EU, SE, Ced" DALnet "ced.se.eu.dal.net" (6667 7000 )) + ("DALnet: US, GA, Astro" DALnet "astro.ga.us.dal.net" ((6661 6669) 7000 )) + ("DALnet: US, GA, Dragons" DALnet "dragons.ga.us.dal.net" ((6661 6669) 7000 )) + ("DALnet: US, GA, Elysium" DALnet "elysium.ga.us.dal.net" ((6661 6669) 7000 )) + ("DALnet: US, MA, Twisted" DALnet "twisted.ma.us.dal.net" ((6660 6669) 7001 7002 )) + ("DALnet: US, MO, Global" DALnet "global.mo.us.dal.net" ((6661 6669) 7000 )) + ("DALnet: US, NJ, Liberty" DALnet "liberty.nj.us.dal.net" ((6662 6669) 7000 )) + ("DALnet: US, VA, Wombat" DALnet "wombat.va.us.dal.net" ((6661 6669) 7000 )) + ("DALnet: Random EU server" DALnet "irc.eu.dal.net" 6667) + ("DALnet: Random US server" DALnet "irc.dal.net" ((6660 6667))) + ("Dark-Tou-Net: Random server" Dark-Tou-Net "irc.d-t-net.de" 6667) + ("Darkfire: Random server" Darkfire "irc.darkfire.net" (6667 7000 8000 )) + ("DarkMyst: Random server" DarkMyst "irc.darkmyst.org" 6667) + ("Darkserv: Random server" Darkserv "irc.darkserv.net" 6667) + ("Darksystem: Random server" Darksystem "irc.darksystem.com" 6667) + ("Darktree: Random server" Darktree "irc.darktree.net" 6667) + ("DayNet: Random server" DayNet "irc.daynet.org" 6667) + ("Deepspace: Disability network" Deepspace "irc.deepspace.org" 6667) + ("Different: Random server" Different "irc.different.net" 6667) + ("Digarix: Random server" Digarix "irc.digarix.net" 6667) + ("Digatech: Random server" Digatech "irc.digatech.net" 6667) + ("Digital-Base: Random server" Digital-Base "irc.digital-base.net" ((6660 7000))) + ("Digitalirc: Random server" Digitalirc "irc.digitalirc.net" 6667) + ("Discussioni: Random server" Discussioni "irc.discussioni.org" ((6666 6669))) + ("DorukNet: TR, Istanbul" DorukNet "irc.doruk.net.tr" ((6660 6669) 7000 8888 )) + ("Dreamcast: Random server" Dreamcast "irc0.dreamcast.com" 6667) + ("DWChat: Random server" DWChat "irc.dwchat.net" 6667) + ("Dynastynet: Random server" Dynastynet "irc.dynastynet.net" 6667) + ("EFnet: CA, AB, Edmonton (arcti)" EFnet "irc.arcti.ca" 6667) + ("EFnet: CA, AB, Edmonton (mpls)" EFnet "irc.mpls.ca" ((6660 6669))) + ("EFnet: CA, ON, Toronto" EFnet "irc2.magic.ca" 6667) + ("EFnet: CA, QB, Montreal" EFnet "irc.qeast.net" 6667) + ("EFnet: EU, DK, Aarhus" EFnet "irc.inet.tele.dk" 6667) + ("EFnet: EU, FI, Helsinki" EFnet "efnet.cs.hut.fi" 6667) + ("EFnet: EU, FR, Paris" EFnet "irc.isdnet.fr" ((6667 6669))) + ("EFnet: EU, NL, Amsterdam" EFnet "efnet.vuurwerk.nl" 6667) + ("EFnet: EU, NO, Homelien" EFnet "irc.homelien.no" (5190 (6666 6667) (7000 7001) )) + ("EFnet: EU, NO, Oslo" EFnet "irc.daxnet.no" ((6666 7000))) + ("EFnet: EU, PL, Warszawa" EFnet "irc.efnet.pl" 6667) + ("EFnet: EU, RU, Moscow" EFnet "irc.rt.ru" ((6661 6669))) + ("EFnet: EU, SE, Dalarna" EFnet "irc.du.se" ((6666 6669))) + ("EFnet: EU, SE, Gothenberg" EFnet "irc.hemmet.chalmers.se" ((6666 7000))) + ("EFnet: EU, SE, Sweden" EFnet "irc.light.se" 6667) + ("EFnet: EU, UK, London (carrier)" EFnet "irc.carrier1.net.uk" ((6666 6669))) + ("EFnet: EU, UK, London (demon)" EFnet "efnet.demon.co.uk" ((6665 6669))) + ("EFnet: ME, IL, Inter" EFnet "irc.inter.net.il" ((6665 6669))) + ("EFnet: US, AZ, Phoenix" EFnet "irc.easynews.com" (6660 (6665 6667) 7000 )) + ("EFnet: US, CA, San Jose" EFnet "irc.concentric.net" ((6665 6668))) + ("EFnet: US, CA, San Luis Obispo" EFnet "irc.prison.net" ((6666 6667))) + ("EFnet: US, GA, Atlanta" EFnet "irc.mindspring.com" ((6660 6669))) + ("EFnet: US, MI, Ann Arbor" EFnet "irc.umich.edu" 6667) + ("EFnet: US, MN, Twin Cities" EFnet "irc.umn.edu" ((6665 6669))) + ("EFnet: US, NY, Mineola" EFnet "irc.lightning.net" ((6665 7000))) + ("EFnet: US, NY, New York (east)" EFnet "irc.east.gblx.net" 6667) + ("EFnet: US, NY, New York (flamed)" EFnet "irc.flamed.net" ((6665 6669))) + ("EFnet: US, TX, Houston" EFnet "ircd.lagged.org" ((6660 6669))) + ("EFnet: US, VA, Ashburn" EFnet "irc.secsup.uu.net" ((6665 6669) 8080 )) + ("EFnet: Random AU server" EFnet "au.rr.efnet.net" 6667) + ("EFnet: Random CA server" EFnet "ca.rr.efnet.net" 6667) + ("EFnet: Random EU server" EFnet "eu.rr.efnet.net" 6667) + ("EFnet: Random US server" EFnet "us.rr.efnet.net" 6667) + ("EgyptianIRC: Random server" EgyptianIRC "irc.egyptianirc.net" ((6667 6669))) + ("Eircnet: Random server" Eircnet "irc.eircnet.org" ((6660 6669) 7000 )) + ("Eleethal: Random server" Eleethal "irc.eleethal.com" ((6660 6669) 7000 )) + ("EntertheGame: Random server" EntertheGame "irc.enterthegame.com" ((6667 6669))) + ("EpiKnet: Random server" EpiKnet "irc.epiknet.org" ((6660 6669) 7000 7001 )) + ("EsperNet: Random server" EsperNet "irc.esper.net" (5555 (6667 6669) )) + ("Esprit: Random server" Esprit "irc.esprit.net" 6667) + ("euIRC: Random server" euIRC "irc.euirc.net" ((6665 6669))) + ("Evilzinc: Random server" Evilzinc "irc.evilzinc.net" ((6660 6669) 7000 8000 )) + ("ExodusIRC: Random server" ExodusIRC "irc.exodusirc.net" ((6660 6669))) + ("FDFnet: Random server" FDFnet "irc.fdfnet.net" ((6666 6668) 9999 )) + ("FEFnet: Random server" FEFnet "irc.fef.net" 6667) + ("Financialchat: Random server" Financialchat "irc.financialchat.com" ((6667 6669) 7000 )) + ("Forestnet: Random server" Forestnet "irc.forestnet.org" (6667 7000 )) + ("ForeverChat: Random server" ForeverChat "irc.foreverchat.net" ((6660 6669) 7000 )) + ("Fraggers: Random server" Fraggers "irc.fraggers.co.uk" ((6661 6669) (7000 7001) )) + ("FreedomChat: Random server" FreedomChat "chat.freedomchat.net" 6667) + ("FreedomIRC: Random server" FreedomIRC "irc.freedomirc.net" 6667) + ("Freenode: Random server" freenode "irc.freenode.net" 6667) + ("Freenode: Random EU server" freenode "irc.eu.freenode.net" 6667) + ("Freenode: Random US server" freenode "irc.us.freenode.net" 6667) + ("FunNet: Random server" FunNet "irc.funnet.org" 6667) + ("Galaxynet: Random server" GalaxyNet "irc.galaxynet.org" ((6662 6668) 7000 )) + ("Galaxynet: AU, NZ, Auckland" GalaxyNet "auckland.nz.galaxynet.org" ((6661 6669))) + ("Galaxynet: EU, BE, Online" GalaxyNet "online.be.galaxynet.org" ((6661 6669))) + ("Galaxynet: US, FL, Florida" GalaxyNet "gymnet.us.galaxynet.org" ((6661 6669))) + ("Gamesnet: Random east US server" Gamesnet "east.gamesnet.net" 6667) + ("Gamesnet: Random west US server" Gamesnet "west.gamesnet.net" 6667) + ("GammaForce: Random server" GammaForce "irc.gammaforce.org" ((6660 6669) 7000 )) + ("GIKInet: Random server" GIKInet "irc.giki.edu.pk" 6667) + ("GizNet: Random server" GizNet "irc.giznet.org" ((6666 6669) 7000 )) + ("Globalchat: Random server" Globalchat "irc.globalchat.org" 6667) + ("GlobIRC: Random server" GlobIRC "irc.globirc.net" ((6666 6668) 9999 )) + ("Goldchat: Random server" Goldchat "irc.goldchat.nl" ((6660 6669) 7000 )) + ("Goodchatting: Random server" Goodchatting "irc.goodchatting.com" ((6661 6669) 7000 )) + ("GravityLords: Random server" GravityLords "irc.gravitylords.net" 6667) + ("Grnet: Random EU server" GRnet "gr.irc.gr" (6667 7000 )) + ("Grnet: Random server" GRnet "srv.irc.gr" (6667 7000 )) + ("Grnet: Random US server" GRnet "us.irc.gr" (6667 7000 )) + ("GulfChat: Random server" GulfChat "irc.gulfchat.net" ((6660 6669))) + ("HabberNet: Random server" HabberNet "irc.habber.net" 6667) + ("HanIRC: Random server" HanIRC "irc.hanirc.org" 6667) + ("Hellenicnet: Random server" Hellenicnet "irc.mirc.gr" (6667 7000 )) + ("IceNet: Random server" IceNet "irc.icenet.org.za" 6667) + ("ICQnet: Random server" ICQnet "irc.icq.com" 6667) + ("Infatech: Random server" Infatech "irc.infatech.net" ((6660 6669))) + ("Infinity: Random server" Infinity "irc.infinity-irc.org" 6667) + ("Infomatrix: Random server" Infomatrix "irc.infomatrix.net" 6667) + ("Inside3D: Random server" Inside3D "irc.inside3d.net" ((6661 6669))) + ("InterlinkChat: Random server" InterlinkChat "irc.interlinkchat.net" ((6660 6669) 7000 )) + ("IRC-Chile: Random server" IRC-Chile "irc.cl" 6667) + ("IRC-Hispano: Random server" IRC-Hispano "irc.irc-hispano.org" 6667) + ("IRCchat: Random server" IRCchat "irc.ircchat.tk" 6667) + ("IRCGate: Random server" IRCGate "irc.ircgate.net" ((6667 6669))) + ("IRCGeeks: Random server" IRCGeeks "irc.ircgeeks.org" ((6660 6669))) + ("IRChat: Random server" IRChat "irc.irchat.net" ((6660 6669))) + ("IrcLordz: Random server" IrcLordz "irc.irclordz.com" 6667) + ("IrcMalta: Random server" IrcMalta "irc.ircmalta.org" ((6660 6667))) + ("IRCnet: EU, FR, Random" IRCnet "irc.fr.ircnet.net" 6667) + ("IRCnet: EU, IT, Random" IRCnet "irc.ircd.it" ((6665 6669))) + ("IRCnet: AS, IL, Haifa" IRCnet "ircnet.netvision.net.il" ((6661 6668))) + ("IRCnet: AS, JP, Tokyo" IRCnet "irc.tokyo.wide.ad.jp" 6667) + ("IRCnet: AS, TW, Seed" IRCnet "irc.seed.net.tw" 6667) + ("IRCnet: EU, AT, Linz" IRCnet "linz.irc.at" ((6666 6668))) + ("IRCnet: EU, AT, Wien" IRCnet "vienna.irc.at" ((6666 6669))) + ("IRCnet: EU, BE, Brussels" IRCnet "irc.belnet.be" 6667) + ("IRCnet: EU, BE, Zaventem" IRCnet "ircnet.wanadoo.be" ((6661 6669))) + ("IRCnet: EU, CZ, Prague" IRCnet "irc.felk.cvut.cz" 6667) + ("IRCnet: EU, DE, Berlin" IRCnet "irc.fu-berlin.de" ((6665 6669))) + ("IRCnet: EU, DE, Dusseldorf" IRCnet "irc.freenet.de" ((6665 6669))) + ("IRCnet: EU, DE, Stuttgart" IRCnet "irc.belwue.de" ((6665 6669))) + ("IRCnet: EU, DK, Copenhagen" IRCnet "irc.ircnet.dk" 6667) + ("IRCnet: EU, EE, Tallinn" IRCnet "irc.estpak.ee" ((6666 6668))) + ("IRCnet: EU, FI, Helsinki" IRCnet "irc.cs.hut.fi" 6667) + ("IRCnet: EU, GR, Thessaloniki" IRCnet "irc.ee.auth.gr" ((6666 6669))) + ("IRCnet: EU, HU, Budapest" IRCnet "irc.elte.hu" 6667) + ("IRCnet: EU, IS, Reykjavik (ircnet)" IRCnet "irc.ircnet.is" ((6661 6669))) + ("IRCnet: EU, IS, Reykjavik (simnet)" IRCnet "irc.simnet.is" ((6661 6669))) + ("IRCnet: EU, IT, Rome" IRCnet "irc.tin.it" ((6665 6669))) + ("IRCnet: EU, NL, Amsterdam (nlnet)" IRCnet "irc.nl.uu.net" ((6660 6669))) + ("IRCnet: EU, NL, Amsterdam (xs4all)" IRCnet "irc.xs4all.nl" ((6660 6669))) + ("IRCnet: EU, NL, Enschede" IRCnet "irc.snt.utwente.nl" ((6660 6669))) + ("IRCnet: EU, NL, Nijmegen" IRCnet "irc.sci.kun.nl" ((6660 6669))) + ("IRCnet: EU, NO, Oslo" IRCnet "irc.ifi.uio.no" 6667) + ("IRCnet: EU, NO, Trondheim" IRCnet "irc.pvv.ntnu.no" 6667) + ("IRCnet: EU, PL, Lublin" IRCnet "lublin.irc.pl" ((6666 6668))) + ("IRCnet: EU, PL, Warsaw" IRCnet "warszawa.irc.pl" ((6666 6668))) + ("IRCnet: EU, RU, Moscow" IRCnet "irc.msu.ru" 6667) + ("IRCnet: EU, SE, Lulea" IRCnet "irc.ludd.luth.se" ((6661 6669))) + ("IRCnet: EU, UK, London (Demon)" IRCnet "ircnet.demon.co.uk" ((6665 6669))) + ("IRCnet: EU, UK, London (Easynet)" IRCnet "ircnet.easynet.co.uk" ((6666 6669))) + ("IRCnet: US, NY, New York" IRCnet "irc.stealth.net" ((6660 6669))) + ("IRCnet: Random AU server" IRCnet "au.ircnet.org" 6667) + ("IRCnet: Random EU server" IRCnet "eu.ircnet.org" ((6665 6668))) + ("IRCnet: Random US server" IRCnet "us.ircnet.org" ((6665 6668))) + ("IRCSoulZ: Random server" IRCSoulZ "irc.ircsoulz.net" 6667) + ("IRCSul: BR, PR, Maringa" IRCSul "irc.wnet.com.br" 6667) + ("IrcTalk: Random server" IrcTalk "irc.irctalk.net" ((6660 6669))) + ("Irctoo: Random server" Irctoo "irc.irctoo.net" 6667) + ("IRCtown: Random server" IRCtown "irc.irctown.net" ((6666 6669) 7000 )) + ("IRCworld: Random server" IRCworld "irc.ircworld.org" 6667) + ("ircXtreme: Random server" ircXtreme "irc.ircXtreme.net" ((6660 6669))) + ("Israelnet: Random server" Israelnet "irc.israel.net" 6667) + ("K0wNet: Random server" K0wNet "irc.k0w.net" ((6660 6669))) + ("KDFSnet: Random server" KDFSnet "irc.kdfs.net" ((6667 6669))) + ("Kemik: Random server" Kemik "irc.kemik.net" 6667) + ("Kewl.Org: Random server" Kewl\.Org "irc.kewl.org" (6667 7000 )) + ("Kickchat: Random server" Kickchat "irc.kickchat.com" ((6660 6669) 7000 )) + ("Kidsworld: Random server" KidsWorld "irc.kidsworld.org" ((6666 6669))) + ("Knightnet: AF, ZA, Durban" Knightnet "orc.dbn.za.knightnet.net" (6667 5555 )) + ("Knightnet: US, CA, Goldengate" Knightnet "goldengate.ca.us.knightnet.net" (6667 5555 )) + ("Konfido.Net: Random server" Konfido\.Net "irc.konfido.net" 6667) + ("KreyNet: Random server" Kreynet "irc.krey.net" 6667) + ("Krono: Random server" Krono "irc.krono.net" ((6660 6669) 7000 )) + ("Krushnet: Random server" Krushnet "irc.krushnet.org" 6667) + ("LagNet: Random server" LagNet "irc.lagnet.org.za" 6667) + ("LagNet: AF, ZA, Cape Town" LagNet "reaper.lagnet.org.za" 6667) + ("LagNet: AF, ZA, Johannesburg" LagNet "mystery.lagnet.org.za" 6667) + ("Librenet: Random server" Librenet "irc.librenet.net" 6667) + ("LinkNet: Random server" LinkNet "irc.link-net.org" ((6667 6669))) + ("LinuxChix: Random server" LinuxChix "irc.linuxchix.org" 6667) + ("Liquidized: Random server" Liquidized "irc.liquidized.net" (6667 7000 )) + ("M-IRC: Random server" M-IRC "irc.m-sys.org" ((6667 6669))) + ("MagicStar: Random server" MagicStar "irc.magicstar.net" 6667) + ("Mavra: Random server" Mavra "irc.mavra.net" 6667) + ("MediaDriven: Random server" MediaDriven "irc.mediadriven.com" ((6667 6669))) + ("mIRC-X: Random server" mIRC-X "irc.mircx.com" (6667 7000 )) + ("Morat: Random server" Morat "irc.morat.net" 6667) + ("MusicCity: Random server" MusicCity "chat.musiccity.com" 6667) + ("Mysteria: Random server" Mysteria "irc.mysteria.net" (6667 7000 )) + ("Mysterychat: Random server" Mysterychat "irc.mysterychat.net" ((6667 6669))) + ("Mystical: Random server" Mystical "irc.mystical.net" (6667 7000 )) + ("Narancs: Random server" Narancs "irc.narancs.com" ((6667 6669) 7000 )) + ("Net-France: Random server" Net-France "irc.net-france.com" 6667) + ("Nevernet: Random server" Nevernet "irc.nevernet.net" 6667) + ("Newnet: Random server" Newnet "irc.newnet.net" ((6665 6667))) + ("Nexusirc: Random server" Nexusirc "irc.nexusirc.org" 6667) + ("Nightstar: Random server" NightStar "irc.nightstar.net" ((6665 6669))) + ("NitrousNet: Random server" NitrousNet "irc.nitrousnet.net" 6667) + ("Novernet: Random server" Novernet "irc.novernet.com" ((6665 6669) 7000 )) + ("Nullrouted: Random server" Nullrouted "irc.nullrouted.org" ((6666 6669) 7000 )) + ("NullusNet: Random server" NullusNet "irc.nullus.net" 6667) + ("OFTC: Random server" OFTC "irc.oftc.net" ((6667 6670) 7000)) + ("OpChat: Random server" OpChat "irc.opchat.org" ((6667 6669))) + ("Othernet: Random server" Othernet "irc.othernet.org" 6667) + ("Othernet: US, FL, Miami" Othernet "miami.fl.us.othernet.org" 6667) + ("Othernet: US, MO, StLouis" Othernet "stlouis.mo.us.othernet.org" 6667) + ("Otherside: Random server" OtherSide "irc.othersideirc.net" 6667) + ("Outsiderz: Random server" Outsiderz "irc.outsiderz.com" 6667) + ("OzOrg: AU, Perth" OzOrg "iinet.perth.oz.org" 6667) + ("Peacefulhaven: Random server" Peacefulhaven "irc.peacefulhaven.net" ((6660 6669) 7000 )) + ("PhazedIRC: Random server" PhazedIRC "irc.phazedirc.net" 6667) + ("Philchat: Random server" Philchat "irc.philchat.net" 6667) + ("phrozN: Random server" phrozN "irc.phrozn.net" 6667) + ("PiNet: Random server" PiNet "irc.praetorians.org" ((6665 6669))) + ("Pinoycentral: Random server" Pinoycentral "chat.abs-cbn.com" 6667) + ("Planetarion: Random server" Planetarion "irc.planetarion.com" 6667) + ("POLNet: Random server" POLNet "irc.ircnet.pl" 6667) + ("Psionics: CA, PQ, Montreal" Psionics "chat.psionics.net" ((6660 6669))) + ("PTirc: Random server" PTirc "irc.ptirc.com.pt" 6667) + ("PTlink: Random server" PTlink "irc.ptlink.net" 6667) + ("PTnet: Random server" PTnet "irc.ptnet.org" 6667) + ("QChat: Random server" QChat "irc.qchat.net" 6667) + ("QuakeNet: Random German server" QuakeNet "de.quakenet.org" ((6667 6669))) + ("QuakeNet: Random server" QuakeNet "irc.quakenet.eu.org" ((6667 6669))) + ("QuakeNet: Random Swedish server" QuakeNet "se.quakenet.org" ((6667 6669))) + ("QuakeNet: Random UK server" QuakeNet "uk.quakenet.org" ((6667 6669))) + ("QuakeNet: Random US server" QuakeNet "us.quakenet.org" ((6667 6669))) + ("Realirc: Random server" Realirc "irc.realirc.org" 6667) + ("RealmNET: Random server" RealmNET "irc.realmnet.com" 6667) + ("Rebelchat: Random server" Rebelchat "irc.rebelchat.org" 6667) + ("Red-Latina: Random server" Red-Latina "irc.red-latina.org" 6667) + ("RedLatona: Random server" RedLatona "irc.redlatona.net" (6667 6668 )) + ("Relicnet: Random server" Relicnet "irc.relic.net" 6667) + ("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667) + ("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669))) + ("Rizon: Random server" Rizon "irc.rizon.net" (6633 (6660 6669) 6697 7000 8080 9999)) + ("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667) + ("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) )) + ("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) )) + ("Rusnet: EU, UA, Kiev" Rusnet "irc.kar.net" ((6667 6669) (7770 7775) )) + ("Sandnet: Random server" Sandnet "irc.sandnet.net" ((6660 6669) 7000 )) + ("Scunc: Random server" Scunc "irc.scunc.net" 6667) + ("SerbianCafe: Random server" SerbianCafe "irc.serbiancafe.ws" ((6665 6669))) + ("SexNet: Random server" SexNet "irc.sexnet.org" 6667) + ("ShadowFire: Random server" ShadowFire "irc.shadowfire.org" 6667) + ("ShadowWorld: Random server" ShadowWorld "irc.shadowworld.net" 6667) + ("SkyNet: Random server" SkyNet "irc.bronowski.pl" ((6666 6668))) + ("Slashnet: Random server" Slashnet "irc.slashnet.org" 6667) + ("SolarStone: Random server" SolarStone "irc.solarstone.net" ((6660 6669))) + ("Sorcerynet: Random server" Sorcery "irc.sorcery.net" (6667 7000 9000 )) + ("Sorcerynet: EU, SE, Karlskrona" Sorcery "nexus.sorcery.net" (6667 7000 9000 )) + ("Sorcerynet: US, CA, Palo Alto" Sorcery "kechara.sorcery.net" (6667 7000 9000 )) + ("SourceIRC: Random server" SourceIRC "irc.sourceirc.net" ((6667 6669) 7000 )) + ("SpaceTronix: Random server" SpaceTronix "irc.spacetronix.net" ((6660 6669) 7000 )) + ("Spirit-Harmony: Random server" Spirit-Harmony "irc.spirit-harmony.com" ((6661 6669))) + ("StarChat: Random server" StarChat "irc.starchat.net" ((6667 6669) 7000 )) + ("StarEquinox: Random server" StarEquinox "irc.starequinox.net" ((6660 6669))) + ("StarLink: Random server" Starlink "irc.starlink.net" ((6660 6669))) + ("StarLink-irc: Random server" starlink-irc "irc.starlink-irc.org" 6667) + ("StarWars-IRC: Random server" StarWars-IRC "irc.starwars-irc.net" ((6663 6667))) + ("Stormdancing: Random server" Stormdancing "irc.stormdancing.net" ((6664 6669) 7000 9000 )) + ("Superchat: Random server" Superchat "irc.superchat.org" ((6660 6668))) + ("Sysopnet: Random server" Sysopnet "irc.sysopnet.org" ((6666 6668))) + ("Telstra: Random server" Telstra "irc.telstra.com" ((6667 6669))) + ("TR-net: EU, TR, Ankara" TR-net "irc.dominet.com.tr" 6667) + ("TR-net: EU, Tr, Istanbul" TR-net "irc.teklan.com.tr" 6667) + ("Tri-net: Random server" Tri-net "irc.tri-net.org" 6667) + ("TriLink: Random server" TriLink "irc.ft4u.net" 6667) + ("TurkishChat: Random server" TurkishChat "irc.turkishchat.org" ((6660 6669) 7000 )) + ("UberNinja: Random server" UberNinja "irc.uberninja.net" ((6667 6669))) + ("UICN: Random server" UICN "irc.uicn.net" 6667) + ("UltraIRC: Random server" UltraIRC "irc.ultrairc.net" 6667) + ("UnderChat: Random server" UnderChat "irc.underchat.it" ((6660 6669) 7000 )) + ("Undernet: CA, ON, Toronto" Undernet "toronto.on.ca.undernet.org" ((6661 6669))) + ("Undernet: CA, QC, Montreal" Undernet "montreal.qu.ca.undernet.org" ((6660 6669))) + ("Undernet: EU, AT, Graz" Undernet "graz.at.eu.undernet.org" ((6661 6669))) + ("Undernet: EU, BE, Antwerp" Undernet "flanders.be.eu.undernet.org" ((6660 6669))) + ("Undernet: EU, BE, Brussels" Undernet "brussels.be.eu.undernet.org" 6667) + ("Undernet: EU, CH, Geneva" Undernet "geneva.ch.eu.undernet.org" ((6660 6669) 7777 8000 )) + ("Undernet: EU, FR, Caen" Undernet "caen.fr.eu.undernet.org" ((6666 6669))) + ("Undernet: EU, NL, Diemen" Undernet "diemen.nl.eu.undernet.org" ((6660 6669))) + ("Undernet: EU, NL, Haarlem" Undernet "haarlem.nl.eu.undernet.org" ((6660 6669))) + ("Undernet: EU, NO, Oslo" Undernet "oslo.no.eu.undernet.org" ((6660 6669))) + ("Undernet: EU, SE, Stockholm" Undernet "stockholm.se.eu.undernet.org" ((6666 6669))) + ("Undernet: EU, UK, Surrey" Undernet "surrey.uk.eu.undernet.org" ((6660 6669))) + ("Undernet: US, AZ, Mesa" Undernet "mesa.az.us.undernet.org" ((6665 6667))) + ("Undernet: US, CA, San Diego" Undernet "sandiego.ca.us.undernet.org" ((6660 6670))) + ("Undernet: US, DC, Washington" Undernet "washington.dc.us.undernet.org" ((6660 6669))) + ("Undernet: US, KS, Manhattan" Undernet "manhattan.ks.us.undernet.org" ((6660 6669))) + ("Undernet: US, NV, Las Vegas" Undernet "lasvegas.nv.us.undernet.org" ((6660 6669))) + ("Undernet: US, TX, Austin" Undernet "austin.tx.us.undernet.org" ((6660 6669))) + ("Undernet: US, UT, Saltlake" Undernet "saltlake.ut.us.undernet.org" ((6660 6669))) + ("Undernet: US, VA, Arlington" Undernet "arlington.va.us.undernet.org" ((6660 6669))) + ("Undernet: US, VA, McLean" Undernet "mclean.va.us.undernet.org" ((6666 6669))) + ("Undernet: Random EU server" Undernet "eu.undernet.org" 6667) + ("Undernet: Random US server" Undernet "us.undernet.org" 6667) + ("UnderZ: Random server" UnderZ "irc.underz.org" ((6667 6668))) + ("UniChat: Random server" UniChat "irc.uni-chat.net" 6667) + ("UnionLatina: Random server" UnionLatina "irc.unionlatina.org" 6667) + ("Univers: Random server" Univers "irc.univers.org" ((6665 6669))) + ("UnixR: Random server" UnixR "irc.unixr.net" ((6667 6669))) + ("Vidgamechat: Random server" Vidgamechat "irc.vidgamechat.com" 6667) + ("VirtuaNet: Random server" VirtuaNet "irc.virtuanet.org" ((6660 6669) 7000 )) + ("Vitamina: Random server" Vitamina "irc.vitamina.ca" 6667) + ("Voila: Random server" Voila "irc.voila.fr" 6667) + ("Wahou: Random server" Wahou "irc.wahou.org" ((6665 6669))) + ("Warpednet: Random server" Warpednet "irc.warped.net" 6667) + ("Weaklinks: Random server" Weaklinks "irc.weaklinks.net" ((6667 6669))) + ("Webnet: Random server" Webnet "irc.webchat.org" ((6667 6669) 7000 )) + ("Webnet: US, CA, Santa Clara" Webnet "webmaster.ca.us.webchat.org" ((6661 6669))) + ("WinChat: Random server" WinChat "irc.winchat.net" ((6661 6669))) + ("WinIRC: Random server" WinIRC "irc.winirc.org" ((6667 6669) 4400 )) + ("WorldIRC: Random server" WorldIRC "irc.worldirc.org" ((6660 6667))) + ("WyldRyde: Random server" WyldRyde "irc.wyldryde.net" ((6666 6669))) + ("XentoniX: Random server" XentoniX "irc.xentonix.net" ((6661 6669))) + ("Xevion: Random server" Xevion "irc.xevion.net" (6667 7000 )) + ("XNet: Random server" XNet "irc.xnet.org" 6667) + ("XWorld: Random server" XWorld "irc.xworld.org" 6667) + ("ZAnet Net: Random server" ZAnetNet "irc.zanet.net" 6667) + ("ZAnet Org: UK, London" ZAnetOrg "mystic.zanet.org.za" 6667) + ("ZiRC: Random server" ZiRC "irc.zirc.org" ((6660 6669))) + ("ZUHnet: Random server" ZUHnet "irc.zuh.net" 6667) + ("Zurna: Random server" Zurna "irc.zurna.net" 6667)) + "Alist of irc servers. (NAME NET HOST PORTS) where +NAME is a name for that server, +NET is a symbol indicating to which network from `erc-networks-alist' this + server corresponds, +HOST is the servers hostname and +PORTS is either a number, a list of numbers, or a list of port ranges." + :group 'erc-networks + :type 'sexp) + +(defcustom erc-networks-alist + '((4-irc "4-irc.com") + (A5KNet "a5knet.com") + (AbleNet "ablenet.org") + (Accessirc "accessirc.net") + (Acestar "acestar.org") + (Action-IRC "action-irc.net") + (AfterNET "afternet.org") + (Alternativenet "altnet.org") + (AmigaNet "amiganet.org") + (AngelEyez "angeleyez.net") + (Anothernet "another.net") + (ArabChat "arabchat.org") + (Ars "arstechnica.com") + (AsiaTalk "asiatalk.org") + (AstroLink "astrolink.org") + (Asylumnet "asylumnet.org") + (Austnet "austnet.org") + (AwesomeChat "awesomechat.net") + (Awesomechristians "awesomechristians.com") + (Axenet "axenet.org") + (Beyondirc "beyondirc.net") + (BGIRC "bulgaria.org") + (Blabbernet "blabber.net") + (Blitzed "blitzed.org") + (BrasIRC "brasirc.net") + (BRASnet "brasnet.org") + (BubbleNet "bubblenet.org") + (CCnet "christian-chat.net") + (Chat-Net "chat-net.org") + (Chat-Solutions "chat-solutions.org") + (Chatcafe "chatcafe.net") + (Chatchannel "chatchannel.org") + (ChatCircuit "chatcircuit.com") + (Chatlink "chatlink.org") + (Chatnet "chatnet.org") + (ChatNut "chatnut.net") + (Chatpinoy "chatpinoy.com") + (ChatPR "chatpr.org") + (Chatroom "chatroom.org") + (Chatster "chatster.org") + (ChatX "chatx.net") + (China263 "263.net") + (Cineplex1 "cineplex1.com") + (CNN "cnn.com") + (CobraNet "cobra.net") + (Coolchat "coolchat.net") + (Criten "criten.net") + (Cyberchat "cyberchat.org") + (CyGanet "cyga.net") + (DALnet "dal.net") + (Dark-Tou-Net "d-t-net.de") + (Darkfire "darkfire.net") + (DarkMyst "darkmyst.org") + (Darkserv "darkserv.net") + (Darksystem "darksystem.com") + (Darktree "darktree.net") + (DayNet "daynet.org") + (Deepspace "deepspace.org") + (Different "different.net") + (Digarix "digarix.net") + (Digatech "digatech.net") + (Digital-Base "digital-base.net") + (Digitalirc "digitalirc.net") + (Discussioni "discussioni.org") + (DorukNet "doruk.net.tr") + (DWChat "dwchat.net") + (Dynastynet "dynastynet.net") + (EFnet nil) + (EgyptianIRC "egyptianirc.net") + (Eircnet "eircnet.org") + (Eleethal "eleethal.com") + (EntertheGame "enterthegame.com") + (EpiKnet "epiknet.org") + (EsperNet "esper.net") + (Esprit "esprit.net") + (euIRC "euirc.net") + (Evilzinc "evilzinc.net") + (ExodusIRC "exodusirc.net") + (FDFnet "fdfnet.net") + (FEFnet "fef.net") + (Financialchat "financialchat.com") + (Forestnet "forestnet.org") + (ForeverChat "foreverchat.net") + (Fraggers "fraggers.co.uk") + (FreedomChat "freedomchat.net") + (FreedomIRC "freedomirc.net") + (freenode "freenode.net") + (FunNet "funnet.org") + (GalaxyNet "galaxynet.org") + (Gamesnet "gamesnet.net") + (GammaForce "gammaforce.org") + (GIKInet "giki.edu.pk") + (GizNet "giznet.org") + (Globalchat "globalchat.org") + (GlobIRC "globirc.net") + (Goldchat "goldchat.nl") + (Goodchatting "goodchatting.com") + (GravityLords "gravitylords.net") + (GRnet "irc.gr") + (GulfChat "gulfchat.net") + (HabberNet "habber.net") + (HanIRC "hanirc.org") + (Hellenicnet "mirc.gr") + (IceNet "icenet.org.za") + (ICQnet "icq.com") + (iip "anon.iip") + (Infatech "infatech.net") + (Infinity "infinity-irc.org") + (Infomatrix "infomatrix.net") + (Inside3D "inside3d.net") + (InterlinkChat "interlinkchat.net") + (IRC-Chile "irc.cl") + (IRC-Hispano "irc-hispano.org") + (IRCchat "ircchat.tk") + (IRCGate "ircgate.net") + (IRCGeeks "ircgeeks.org") + (IRChat "irchat.net") + (IrcLordz "irclordz.com") + (IrcMalta "ircmalta.org") + (IRCnet nil) + (IRCSoulZ "ircsoulz.net") + (IRCSul "wnet.com.br") + (IrcTalk "irctalk.net") + (Irctoo "irctoo.net") + (IRCtown "irc.irctown.net") + (IRCworld "ircworld.org") + (ircXtreme "ircXtreme.net") + (Israelnet "israel.net") + (K0wNet "k0w.net") + (KDFSnet "kdfs.net") + (Kemik "kemik.net") + (Kewl\.Org "kewl.org") + (Kickchat "kickchat.com") + (KidsWorld "kidsworld.org") + (Knightnet "knightnet.net") + (Konfido\.Net "konfido.net") + (Kreynet "krey.net") + (Krono "krono.net") + (Krushnet "krushnet.org") + (LagNet "lagnet.org.za") + (Librenet "librenet.net") + (LinkNet "link-net.org") + (LinuxChix "cats\.meow\.at\\|linuxchix\.org") + (Liquidized "liquidized.net") + (M-IRC "m-sys.org") + (MagicStar "magicstar.net") + (Mavra "mavra.net") + (MediaDriven "mediadriven.com") + (mIRC-X "mircx.com") + (Morat "morat.net") + (MusicCity "musiccity.com") + (Mysteria "mysteria.net") + (Mysterychat "mysterychat.net") + (Mystical "mystical.net") + (Narancs "narancs.com") + (Net-France "net-france.com") + (Nevernet "nevernet.net") + (Newnet "newnet.net") + (Nexusirc "nexusirc.org") + (NightStar "nightstar.net") + (NitrousNet "nitrousnet.net") + (Novernet "novernet.com") + (Nullrouted "nullrouted.org") + (NullusNet "nullus.net") + (OFTC "oftc.net") + (OpChat "opchat.org") + (Openprojects "openprojects.net") + (Othernet "othernet.org") + (OtherSide "othersideirc.net") + (Outsiderz "outsiderz.com") + (OzOrg "oz.org") + (Peacefulhaven "peacefulhaven.net") + (PhazedIRC "phazedirc.net") + (Philchat "philchat.net") + (phrozN "phrozn.net") + (PiNet "praetorians.org") + (Pinoycentral "abs-cbn.com") + (Planetarion "planetarion.com") + (POLNet "ircnet.pl") + (Psionics "psionics.net") + (PTirc "ptirc.com.pt") + (PTlink "ptlink.net") + (PTnet "ptnet.org") + (QChat "qchat.net") + (QuakeNet "quakenet.org") + (Realirc "realirc.org") + (RealmNET "realmnet.com") + (Rebelchat "rebelchat.org") + (Red-Latina "red-latina.org") + (RedLatona "redlatona.net") + (Relicnet "relic.net") + (Rezosup "rezosup.org") + (Risanet "risanet.com") + (Rubiks "rubiks.net") + (Rusnet "nil") + (Sandnet "sandnet.net") + (Scunc "scunc.net") + (SerbianCafe "serbiancafe.ws") + (SexNet "sexnet.org") + (ShadowFire "shadowfire.org") + (ShadowWorld "shadowworld.net") + (SkyNet "bronowski.pl") + (SlashNET "slashnet.org") + (SolarStone "solarstone.net") + (Sorcery "sorcery.net") + (SourceIRC "sourceirc.net") + (SpaceTronix "spacetronix.net") + (Spirit-Harmony "spirit-harmony.com") + (StarChat "starchat.net") + (StarEquinox "starequinox.net") + (Starlink "starlink.net") + (starlink-irc "starlink-irc.org") + (StarWars-IRC "starwars-irc.net") + (Stormdancing "stormdancing.net") + (Superchat "superchat.org") + (Sysopnet "sysopnet.org") + (Telstra "telstra.com") + (TR-net "dominet.com.tr") + (Tri-net "tri-net.org") + (TriLink "ft4u.net") + (TurkishChat "turkishchat.org") + (UberNinja "uberninja.net") + (UICN "uicn.net") + (UltraIRC "ultrairc.net") + (UnderChat "underchat.it") + (Undernet "undernet.org") + (UnderZ "underz.org") + (UniChat "irc.uni-chat.net") + (UnionLatina "unionlatina.org") + (Univers "univers.org") + (UnixR "unixr.net") + (Vidgamechat "vidgamechat.com") + (VirtuaNet "virtuanet.org") + (Vitamina "vitamina.ca") + (Voila "voila.fr") + (Wahou "wf-net.org") + (Warpednet "warped.net") + (Weaklinks "weaklinks.net") + (Webnet "webchat.org") + (WinChat "winchat.net") + (WinIRC "winirc.org") + (WorldIRC "worldirc.org") + (WyldRyde "wyldryde.net") + (XentoniX "xentonix.net") + (Xevion "xevion.net") + (XNet "xnet.org") + (XWorld "xworld.org") + (ZAnetNet "zanet.net") + (ZAnetOrg "zanet.org.za") + (ZiRC "zirc.org") + (ZUHnet "zuh.net") + (Zurna "zurna.net")) + "Alist of IRC networks. (NET MATCHER) where +NET is a symbol naming that IRC network and +MATCHER is used to find a corresponding network to a server while connected to + it. If it is regexp, it's used to match against `erc-server-announced-name'. + It can also be a function (predicate). Then it is executed with the + server buffer as current-buffer." + :group 'erc-networks + :type '(repeat + (list :tag "Network" + (symbol :tag "Network name") + (choice :tag "Network's common server ending" + (regexp) + (const :tag "Network has no common server ending" nil))))) + +(defvar erc-network nil + "The name of the network you are connected to (a symbol).") +(make-variable-buffer-local 'erc-network) + +;; Functions: + +;;;###autoload +(defun erc-determine-network () + "Return the name of the network or \"Unknown\" as a symbol. Use the +server parameter NETWORK if provided, otherwise parse the server name and +search for a match in `erc-networks-alist'." + ;; The server made it easy for us and told us the name of the NETWORK + (if (assoc "NETWORK" erc-server-parameters) + (intern (cdr (assoc "NETWORK" erc-server-parameters))) + (or + ;; Loop through `erc-networks-alist' looking for a match. + (let ((server (or erc-server-announced-name erc-session-server))) + (loop for (name matcher) in erc-networks-alist + when (and matcher + (string-match (concat matcher "\\'") server)) + do (return name))) + 'Unknown))) + +(defun erc-network () + "Return the value of `erc-network' for the current server." + (erc-with-server-buffer erc-network)) + +(defun erc-current-network () + "Deprecated. Use `erc-network' instead. Return the name of this server's +network as a symbol." + (erc-with-server-buffer + (intern (downcase (symbol-name erc-network))))) + +(erc-make-obsolete 'erc-current-network 'erc-network + "Obsolete since erc-networks 1.5") + +(defun erc-network-name () + "Returns the name of the current network as a string." + (erc-with-server-buffer (symbol-name erc-network))) + +(defun erc-set-network-name (proc parsed) + "Set `erc-network' to the value returned by `erc-determine-network'." + (unless erc-server-connected + (setq erc-network (erc-determine-network))) + nil) + +(defun erc-unset-network-name (nick ip reason) + "Set `erc-network' to nil." + (setq erc-network nil) + nil) + +(define-erc-module networks nil + "Provide data about IRC networks." + ((add-hook 'erc-server-375-functions 'erc-set-network-name) + (add-hook 'erc-server-422-functions 'erc-set-network-name) + (add-hook 'erc-disconnected-hook 'erc-unset-network-name)) + ((remove-hook 'erc-server-375-functions 'erc-set-network-name) + (remove-hook 'erc-server-422-functions 'erc-set-network-name) + (remove-hook 'erc-disconnected-hook 'erc-unset-network-name))) + +(defun erc-ports-list (ports) + "Return a list of PORTS. + +PORTS should be a list of either: + A number, in which case it is returned a list. + Or a pair of the form (LOW HIGH), in which case, a list of all the + numbers between LOW and HIGH (inclusive) is returned. + +As an example: + (erc-ports-list '(1)) => (1) + (erc-ports-list '((1 5))) => (1 2 3 4 5) + (erc-ports-list '(1 (3 5))) => (1 3 4 5)" + (let (result) + (dolist (p ports) + (cond ((numberp p) + (push p result)) + ((listp p) + (setq result (nconc (loop for i from (cadr p) downto (car p) + collect i) + result))))) + (nreverse result))) + +;;;###autoload +(defun erc-server-select () + "Interactively select a server to connect to using `erc-server-alist'." + (interactive) + (let* ((completion-ignore-case t) + (net (intern + (completing-read "Network: " + (erc-delete-dups + (mapcar (lambda (x) + (list (symbol-name (nth 1 x)))) + erc-server-alist))))) + (srv (assoc + (completing-read "Server: " + (delq nil + (mapcar (lambda (x) + (when (equal (nth 1 x) net) + x)) + erc-server-alist))) + erc-server-alist)) + (host (nth 2 srv)) + (ports (if (listp (nth 3 srv)) + (erc-ports-list (nth 3 srv)) + (list (nth 3 srv)))) + (port (nth (random (length ports)) ports))) + (erc :server host :port port))) + +;;; The following experimental +;; It does not work yet, help me with it if you +;; think it is worth the effort. + +(defvar erc-settings + '((pals freenode ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)")) + (format-nick-function (freenode "#emacs") erc-format-@nick)) + "Experimental: Alist of configuration options. +The format is (VARNAME SCOPE VALUE) where +VARNAME is a symbol identifying the configuration option, +SCOPE is either a symbol which identifies an entry from + `erc-networks-alist' or a list (NET TARGET) where NET is a network symbol and + TARGET is a string identifying the channel/query target. +VALUE is the options value.") + +(defun erc-get (var &optional net target) + (let ((items erc-settings) + elt val) + (while items + (setq elt (car items) + items (cdr items)) + (when (eq (car elt) var) + (cond ((and net target (listp (nth 1 elt)) + (eq net (car (nth 1 elt))) + (string-equal target (nth 1 (nth 1 elt)))) + (setq val (nth 2 elt) + items nil)) + ((and net (eq net (nth 1 elt))) + (setq val (nth 2 elt) + items nil)) + ((and (not net) (not target) (not (nth 1 elt))) + (setq val (nth 2 elt) + items nil))))) + val)) + +(erc-get 'pals 'freenode) + +(provide 'erc-networks) + +;;; erc-networks.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 68cccabd-f66b-456c-9abe-5f993a2dc91c diff --git a/lisp/erc-nick-notify.el b/lisp/erc-nick-notify.el new file mode 100644 index 0000000..c879730 --- /dev/null +++ b/lisp/erc-nick-notify.el @@ -0,0 +1,222 @@ +;;; erc-nick-notify.el --- Notify popup for ERC + +;; Filename: erc-nick-notify.el +;; Description: Notify popup for ERC +;; Author: Andy Stewart lazycat.manatee@gmail.com +;; Maintainer: Andy Stewart lazycat.manatee@gmail.com +;; Copyright (C) 2008, 2009, Andy Stewart, all rights reserved. +;; Created: 2008-12-04 12:47:28 +;; Version: 0.3 +;; Last-Updated: 2018-09-16 21:27:34 +;; By: Andy Stewart +;; URL: http://www.emacswiki.org/emacs/download/erc-nick-notify.el +;; Keywords: erc, notify +;; Compatibility: GNU Emacs 23.0.60.1 +;; +;; Features that might be required by this library: +;; +;; `erc' +;; + +;;; This file is NOT part of GNU Emacs + +;;; License +;; +;; This program 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 3, or (at your option) +;; any later version. + +;; This program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; Notify popup for ERC +;; +;; This extension use `notify-send' for notify. +;; So make you have install `notify-send' in your system. +;; + +;;; Installation: +;; +;; Put erc-nick-notify.el to your load-path. +;; The load-path is usually ~/elisp/. +;; It's set in your ~/.emacs like this: +;; (add-to-list 'load-path (expand-file-name "~/elisp")) +;; +;; And the following to your ~/.emacs startup file. +;; +;; (require 'erc-nick-notify) +;; +;; No need more. + +;;; Customize: +;; +;; `erc-nick-notify-delay' +;; The delay time that between two messages. +;; `erc-nick-notify-cmd' +;; The command that use for notify. +;; `erc-nick-notify-icon' +;; The file name of icon display. +;; `erc-nick-notify-timeout' +;; The timeout in milliseconds at which to expire the notification. +;; `erc-nick-notify' +;; The urgency level. +;; `erc-nick-notify-category' +;; The notification category. +;; +;; All of the above can be customize by: +;; M-x customize-group RET erc-nick-notify RET +;; + +;;; Change log: +;; +;; 2019/09/16 +;; * Support MacOS now. +;; +;; 2009/01/31 +;; * Fix doc. +;; +;; 2008/12/21 +;; * Fix `void-variable' bug. +;; +;; 2008/12/08 +;; * Add customize support. +;; +;; 2008/12/04 +;; * First released. +;; + +;;; Acknowledgements: +;; +;; +;; + +;;; TODO +;; +;; +;; + +;;; Require +(require 'erc) + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgroup erc-nick-notify nil + "Notify popup for ERC." + :group 'erc) + +(defcustom erc-nick-notify-delay '(0 5 0) + "The delay time that between two message. +Default is 5 minutes." + :type 'list + :group 'erc-nick-notify) + +(defcustom erc-nick-notify-cmd "notify-send" + "The command that use for notify. + +This option just for linux, MacOS user don't need this." + :type 'string + :group 'erc-nick-notify) + +(defcustom erc-nick-notify-icon "/usr/share/deepin-emacs/Image/Irc.png" + "Specifies an icon filename or stock icon to display. + +This option just for linux, MacOS user don't need this." + :type 'string + :group 'erc-nick-notify) + +(defcustom erc-nick-notify-timeout 10000 + "Specifies the timeout in milliseconds at which to expire the notification. + +This option just for linux, MacOS user don't need this." + :type 'number + :group 'erc-nick-notify) + +(defcustom erc-nick-notify-urgency "low" + "Specifies the urgency level (low, normal, critical). + +This option just for linux, MacOS user don't need this." + :type 'string + :group 'erc-nick-notify) + +(defcustom erc-nick-notify-category "im.received" + "Specifies the notification category. + +This option just for linux, MacOS user don't need this." + :type 'string + :group 'erc-nick-notify) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Variable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar erc-nick-notify-last '(0 0 0) + "The last time that receive message.") + +(defvar erc-nick-notify-buffer nil + "The buffer name of last notify me.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun erc-nick-notify-jump-last-channel () + "Jump to last channel that notify me." + (interactive) + (if erc-nick-notify-buffer + (switch-to-buffer erc-nick-notify-buffer) + (message "Nobody notify you in IRC."))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun erc-nick-notify () + "Notify me when my nick show up. +This function should be in the insert-post-hook." + (let ((now (current-time))) + (when (time-less-p erc-nick-notify-delay + (time-since erc-nick-notify-last)) + (setq erc-nick-notify-last now) + (goto-char (point-min)) + (when (re-search-forward + (concat "\\(" + "\\(<\\([^>]*\\)>\\)" ; + "\\|" + ;; Don't match if we're saying something + "\\(\\* " (regexp-quote (erc-current-nick)) "\\)" + "\\)" + "\\(.*" (regexp-quote (erc-current-nick)) ".*\\)") + nil t) + (let ((msg (concat + (when (> (length (match-string-no-properties 2)) 0) + (concat "<" (match-string-no-properties 3) + "> ")) + (match-string-no-properties 5)))) + (setq erc-nick-notify-buffer (buffer-name)) + (if (featurep 'cocoa) + (ns-do-applescript (format "display notification \"%s: %s\"" + (match-string-no-properties 2) + (match-string-no-properties 5))) + (shell-command (concat erc-nick-notify-cmd + " -i " erc-nick-notify-icon + " -t " (int-to-string + erc-nick-notify-timeout) + " -u " erc-nick-notify-urgency + " -c " erc-nick-notify-category + " -- " + " \"" erc-nick-notify-buffer "\"" + " \"" + (if (boundp 'msg) + msg "") + "\"")))))))) + +;; Add `erc-nick-notify' to `erc-insert-post-hook' +(add-hook 'erc-insert-post-hook 'erc-nick-notify) + +(provide 'erc-nick-notify) + +;;; erc-nick-notify.el ends here + +;;; LocalWords: erc cmd im msg lt diff --git a/lisp/erc-nicklist.el b/lisp/erc-nicklist.el new file mode 100644 index 0000000..5d2c721 --- /dev/null +++ b/lisp/erc-nicklist.el @@ -0,0 +1,416 @@ +;;; erc-nicklist.el --- Display channel nicknames in a side buffer. + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Filename: erc-nicklist.el +;; Author: Lawrence Mitchell +;; Created: 2004-04-30 +;; Keywords: IRC chat client Internet + +;; 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 3, 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 a minimal mIRC style nicklist buffer for ERC. To +;; activate, do M-x erc-nicklist RET in the channel buffer you want +;; the nicklist to appear for. To close and quit the nicklist +;; buffer, do M-x erc-nicklist-quit RET from within the nicklist buffer. +;; +;; TODO: +;; o Somehow associate nicklist windows with channel windows so they +;; appear together, and if one gets buried, then the other does. +;; +;; o Make "Query" and "Message" work. +;; +;; o Prettify the actual list of nicks in some way. +;; +;; o Add a proper erc-module that people can turn on and off, figure +;; out a way of creating the nicklist window at an appropriate time +;; --- probably in `erc-join-hook'. +;; +;; o Ensure XEmacs compatibility --- the mouse-menu support is likely +;; broken. +;; +;; o Add option to display in a separate frame --- will again need to +;; be able to associate the nicklist with the currently active +;; channel buffer or something similar. +;; +;; o Allow toggling of visibility of nicklist via ERC commands. + +;;; History: +;; + +;; Changes by Edgar Gonçalves +;; Jun 25 2005: +;; - images are changed to a standard set of names. +;; - /images now contain gaim's status icons. +;; May 31 2005: +;; - tooltips are improved. they try to access bbdb for a nice nick! +;; Apr 26 2005: +;; - erc-nicklist-channel-users-info was fixed (sorting bug) +;; - Away names don't need parenthesis when using icons +;; Apr 26 2005: +;; - nicks can display icons of their connection type (msn, icq, for now) +;; Mar 15 2005: +;; - nicks now are different for unvoiced and op users +;; - nicks now have tooltips displaying more info +;; Mar 18 2005: +;; - queries now work ok, both on menu and keyb shortcut RET. +;; - nicklist is now sorted ignoring the case. Voiced nicks will +;; appear according to `erc-nicklist-voiced-position'. + +;;; Code: + +(require 'erc) +(condition-case nil + (require 'erc-bbdb) + (error nil)) +(eval-when-compile (require 'cl)) + +(defgroup erc-nicklist nil + "Display a list of nicknames in a separate window." + :group 'erc) + +(defcustom erc-nicklist-use-icons t + "*If non-nil, display an icon instead of the name of the chat medium. +By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc." + :group 'erc-nicklist + :type 'boolean) + +(defcustom erc-nicklist-icons-directory + (let ((dir (locate-library "erc-nicklist.el"))) + (when dir + (concat (file-name-directory dir) "images/"))) + "*Directory of the PNG files for chat icons. +Icons are displayed if `erc-nicklist-use-icons' is non-nil." + :group 'erc-nicklist + :type 'directory) + +(defcustom erc-nicklist-voiced-position 'bottom + "*Position of voiced nicks in the nicklist. +The value can be `top', `bottom' or nil (don't sort)." + :group 'erc-nicklist + :type '(choice + (const :tag "Top" top) + (const :tag "Bottom" bottom) + (const :tag "Mixed" nil))) + +(defcustom erc-nicklist-window-size 20.0 + "*The size of the nicklist window. + +This specifies a percentage of the channel window width. + +A negative value means the nicklist window appears on the left of the +channel window, and vice versa." + :group 'erc-nicklist + :type 'float) + + +(defun erc-nicklist-buffer-name (&optional buffer) + "Return the buffer name for a nicklist associated with BUFFER. + +If BUFFER is nil, use the value of `current-buffer'." + (format " *%s-nicklist*" (buffer-name (or buffer (current-buffer))))) + +(defun erc-nicklist-make-window () + "Create an ERC nicklist window. + +See also `erc-nicklist-window-size'." + (let ((width (floor (* (window-width) (/ erc-nicklist-window-size 100.0)))) + (buffer (erc-nicklist-buffer-name)) + window) + (split-window-horizontally (- width)) + (setq window (next-window)) + (set-window-buffer window (get-buffer-create buffer)) + (with-current-buffer buffer + (set-window-dedicated-p window t)))) + + +(defvar erc-nicklist-images-alist '() + "Alist that maps a connection type to an icon.") + +(defun erc-nicklist-insert-medium-name-or-icon (host channel is-away) + "Inserts an icon or a string identifying the current host type. +This is configured using `erc-nicklist-use-icons' and +`erc-nicklist-icons-directory'." + ;; identify the network (for bitlebee usage): + (let ((bitlbee-p (save-match-data + (string-match "\\`&bitlbee\\b" + (buffer-name channel))))) + (cond ((and bitlbee-p + (string= "login.icq.com" host)) + (if erc-nicklist-use-icons + (if is-away + (insert-image (cdr (assoc 'icq-away + erc-nicklist-images-alist))) + (insert-image (cdr (assoc 'icq + erc-nicklist-images-alist)))) + (insert "ICQ"))) + (bitlbee-p + (if erc-nicklist-use-icons + (if is-away + (insert-image (cdr (assoc 'msn-away + erc-nicklist-images-alist))) + (insert-image (cdr (assoc 'msn + erc-nicklist-images-alist)))) + (insert "MSN"))) + (t + (if erc-nicklist-use-icons + (if is-away + (insert-image (cdr (assoc 'irc-away + erc-nicklist-images-alist))) + (insert-image (cdr (assoc 'irc + erc-nicklist-images-alist)))) + (insert "IRC")))) + (insert " "))) + +(defun erc-nicklist-search-for-nick (finger-host) + "Return the bitlbee-nick field for this contact given FINGER-HOST. +Seach for the BBDB record of this contact. If not found, return nil." + (when (boundp 'erc-bbdb-bitlbee-name-field) + (let ((record (car + (erc-member-if + #'(lambda (r) + (let ((fingers (bbdb-record-finger-host r))) + (when fingers + (string-match finger-host + (car (bbdb-record-finger-host r)))))) + (bbdb-records))))) + (when record + (bbdb-get-field record erc-bbdb-bitlbee-name-field))))) + +(defun erc-nicklist-insert-contents (channel) + "Insert the nicklist contents, with text properties and the optional images." + (setq buffer-read-only nil) + (erase-buffer) + (dolist (u (erc-nicklist-channel-users-info channel)) + (let* ((server-user (car u)) + (channel-user (cdr u)) + (nick (erc-server-user-nickname server-user)) + (host (erc-server-user-host server-user)) + (login (erc-server-user-login server-user)) + (full-name(erc-server-user-full-name server-user)) + (info (erc-server-user-info server-user)) + (channels (erc-server-user-buffers server-user)) + (op (erc-channel-user-op channel-user)) + (voice (erc-channel-user-voice channel-user)) + (bbdb-nick (or (erc-nicklist-search-for-nick + (concat login "@" host)) + "")) + (away-status (if voice "" "\n(Away)")) + (balloon-text (concat bbdb-nick (if (string= "" bbdb-nick) + "" "\n") + "Login: " login "@" host + away-status))) + (erc-nicklist-insert-medium-name-or-icon host channel (not voice)) + (unless (or voice erc-nicklist-use-icons) + (setq nick (concat "(" nick ")"))) + (when op + (setq nick (concat nick " (OP)"))) + (insert (erc-propertize nick + 'erc-nicklist-nick nick + 'mouse-face 'highlight + 'erc-nicklist-channel channel + 'help-echo balloon-text) + "\n"))) + (erc-nicklist-mode)) + + +(defun erc-nicklist () + "Create an ERC nicklist buffer." + (interactive) + (let ((channel (current-buffer))) + (unless (or (not erc-nicklist-use-icons) + erc-nicklist-images-alist) + (setq erc-nicklist-images-alist + `((msn . ,(create-image (concat erc-nicklist-icons-directory + "msn-online.png"))) + (msn-away . ,(create-image (concat erc-nicklist-icons-directory + "msn-offline.png"))) + (irc . ,(create-image (concat erc-nicklist-icons-directory + "irc-online.png"))) + (irc-away . ,(create-image (concat erc-nicklist-icons-directory + "irc-offline.png"))) + (icq . ,(create-image (concat erc-nicklist-icons-directory + "icq-online.png"))) + (icq-away . ,(create-image (concat erc-nicklist-icons-directory + "icq-offline.png")))))) + (erc-nicklist-make-window) + (with-current-buffer (get-buffer (erc-nicklist-buffer-name channel)) + (erc-nicklist-insert-contents channel))) + (add-hook 'erc-channel-members-changed-hook #'erc-nicklist-update)) + +(defun erc-nicklist-update () + "Update the ERC nicklist buffer." + (let ((b (get-buffer (erc-nicklist-buffer-name))) + (channel (current-buffer))) + (when b + (with-current-buffer b + (erc-nicklist-insert-contents channel))))) + +(defvar erc-nicklist-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "") 'erc-nicklist-menu) + (define-key map "\C-j" 'erc-nicklist-kbd-menu) + (define-key map "q" 'erc-nicklist-quit) + (define-key map (kbd "RET") 'erc-nicklist-kbd-cmd-QUERY) + map) + "Keymap for `erc-nicklist-mode'.") + +(define-derived-mode erc-nicklist-mode fundamental-mode + "Nicklist" + "Major mode for the ERC nicklist buffer." + (setq buffer-read-only t)) + +(defun erc-nicklist-call-erc-command (command point buffer window) + "Call an ERC COMMAND. + +Depending on what COMMAND is, it's called with one of POINT, BUFFER, +or WINDOW as arguments." + (when command + (let* ((p (text-properties-at point)) + (b (plist-get p 'erc-nicklist-channel))) + (if (memq command '(erc-nicklist-quit ignore)) + (funcall command window) + ;; EEEK! Horrble, but it's the only way we can ensure the + ;; response goes to the correct buffer. + (erc-set-active-buffer b) + (switch-to-buffer-other-window b) + (funcall command (plist-get p 'erc-nicklist-nick)))))) + +(defun erc-nicklist-cmd-QUERY (user &optional server) + "Opens a query buffer with USER." + ;; FIXME: find a way to switch to that buffer afterwards... + (let ((send (if server + (format "QUERY %s %s" user server) + (format "QUERY %s" user)))) + (erc-cmd-QUERY user) + t)) + +(defun erc-nicklist-kbd-cmd-QUERY (&optional window) + (interactive) + (let* ((p (text-properties-at (point))) + (server (plist-get p 'erc-nicklist-channel)) + (nick (plist-get p 'erc-nicklist-nick)) + (nick (or (and (string-match "(\\(.*\\))" nick) + (match-string 1 nick)) + nick)) + (nick (or (and (string-match "\\+\\(.*\\)" nick) + (match-string 1 nick)) + nick)) + (send (format "QUERY %s %s" nick server))) + (switch-to-buffer-other-window server) + (erc-cmd-QUERY nick))) + + +(defvar erc-nicklist-menu + (let ((map (make-sparse-keymap "Action"))) + (define-key map [erc-cmd-WHOIS] + '("Whois" . erc-cmd-WHOIS)) + (define-key map [erc-cmd-DEOP] + '("Deop" . erc-cmd-DEOP)) + (define-key map [erc-cmd-MSG] + '("Message" . erc-cmd-MSG)) ;; TODO! + (define-key map [erc-nicklist-cmd-QUERY] + '("Query" . erc-nicklist-kbd-cmd-QUERY)) + (define-key map [ignore] + '("Cancel" . ignore)) + (define-key map [erc-nicklist-quit] + '("Close nicklist" . erc-nicklist-quit)) + map) + "Menu keymap for the ERC nicklist.") + +(defun erc-nicklist-quit (&optional window) + "Delete the ERC nicklist. + +Deletes WINDOW and stops updating the nicklist buffer." + (interactive) + (let ((b (window-buffer window))) + (with-current-buffer b + (set-buffer-modified-p nil) + (kill-this-buffer) + (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update)))) + + +(defun erc-nicklist-kbd-menu () + "Show the ERC nicklist menu." + (interactive) + (let* ((point (point)) + (window (selected-window)) + (buffer (current-buffer))) + (with-current-buffer buffer + (erc-nicklist-call-erc-command + (car (x-popup-menu point + erc-nicklist-menu)) + point + buffer + window)))) + +(defun erc-nicklist-menu (&optional arg) + "Show the ERC nicklist menu. + +ARG is a parametrized event (see `interactive')." + (interactive "e") + (let* ((point (nth 1 (cadr arg))) + (window (car (cadr arg))) + (buffer (window-buffer window))) + (with-current-buffer buffer + (erc-nicklist-call-erc-command + (car (x-popup-menu arg + erc-nicklist-menu)) + point + buffer + window)))) + + +(defun erc-nicklist-channel-users-info (channel) + "Return a nick-sorted list of all users on CHANNEL. +Result are elements in the form (SERVER-USER . CHANNEL-USER). The +list has all the voiced users according to +`erc-nicklist-voiced-position'." + (let* ((nicks (erc-sort-channel-users-alphabetically + (with-current-buffer channel (erc-get-channel-user-list))))) + (if erc-nicklist-voiced-position + (let ((voiced-nicks (erc-remove-if-not + #'(lambda (x) + (null (erc-channel-user-voice (cdr x)))) + nicks)) + (devoiced-nicks (erc-remove-if-not + #'(lambda (x) + (erc-channel-user-voice + (cdr x))) + nicks))) + (cond ((eq erc-nicklist-voiced-position 'top) + (append devoiced-nicks voiced-nicks)) + ((eq erc-nicklist-voiced-position 'bottom) + (append voiced-nicks devoiced-nicks)))) + nicks))) + + + +(provide 'erc-nicklist) + +;;; erc-nicklist.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; coding: utf-8 +;; End: + +;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5 diff --git a/lisp/erc-notify.el b/lisp/erc-notify.el new file mode 100644 index 0000000..7f77730 --- /dev/null +++ b/lisp/erc-notify.el @@ -0,0 +1,254 @@ +;;; erc-notify.el --- Online status change notification + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm + +;; 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 3, 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 module defines a new command, /NOTIFY +;; See the docstring of `erc-cmd-NOTIFY' for details. + +;;; Code: + +(require 'erc) +(require 'erc-networks) +(eval-when-compile + (require 'cl) + (require 'pcomplete)) + +;;;; Customizable variables + +(defgroup erc-notify nil + "Track online status of certain nicknames." + :group 'erc) + +(defcustom erc-notify-list nil + "*List of nicknames you want to be notified about online/offline +status change." + :group 'erc-notify + :type '(repeat string)) + +(defcustom erc-notify-interval 60 + "*Time interval (in seconds) for checking online status of notificated +people." + :group 'erc-notify + :type 'integer) + +(defcustom erc-notify-signon-hook nil + "*Hook run after someone on `erc-notify-list' has signed on. +Two arguments are passed to the function, SERVER and NICK, both +strings." + :group 'erc-notify + :type 'hook + :options '(erc-notify-signon)) + +(defcustom erc-notify-signoff-hook nil + "*Hook run after someone on `erc-notify-list' has signed off. +Two arguments are passed to the function, SERVER and NICK, both +strings." + :group 'erc-notify + :type 'hook + :options '(erc-notify-signoff)) + +(defun erc-notify-signon (server nick) + (message "%s signed on at %s" nick server)) + +(defun erc-notify-signoff (server nick) + (message "%s signed off from %s" nick server)) + +;;;; Internal variables + +(defvar erc-last-ison nil + "Last ISON information received through `erc-notify-timer'.") +(make-variable-buffer-local 'erc-last-ison) + +(defvar erc-last-ison-time 0 + "Last time ISON was sent to the server in `erc-notify-timer'.") +(make-variable-buffer-local 'erc-last-ison-time) + +;;;; Setup + +(defun erc-notify-install-message-catalogs () + (erc-define-catalog + 'english + '((notify_current . "Notificated people online: %l") + (notify_list . "Current notify list: %l") + (notify_on . "Detected %n on IRC network %m") + (notify_off . "%n has left IRC network %m")))) + +;;;###autoload (autoload 'erc-notify-mode "erc-notify" nil t) +(define-erc-module notify nil + "Periodically check for the online status of certain users and report +changes." + ((add-hook 'erc-timer-hook 'erc-notify-timer) + (add-hook 'erc-server-JOIN-functions 'erc-notify-JOIN) + (add-hook 'erc-server-NICK-functions 'erc-notify-NICK) + (add-hook 'erc-server-QUIT-functions 'erc-notify-QUIT)) + ((remove-hook 'erc-timer-hook 'erc-notify-timer) + (remove-hook 'erc-server-JOIN-functions 'erc-notify-JOIN) + (remove-hook 'erc-server-NICK-functions 'erc-notify-NICK) + (remove-hook 'erc-server-QUIT-functions 'erc-notify-QUIT))) + +;;;; Timer handler + +(defun erc-notify-timer (now) + (when (and erc-server-connected + erc-notify-list + (> (erc-time-diff + erc-last-ison-time now) + erc-notify-interval)) + (erc-once-with-server-event + 303 + '(let* ((server (erc-response.sender parsed)) + (ison-list (delete "" (split-string + (erc-response.contents parsed)))) + (new-list ison-list) + (old-list (erc-with-server-buffer erc-last-ison))) + (while new-list + (when (not (erc-member-ignore-case (car new-list) old-list)) + (run-hook-with-args 'erc-notify-signon-hook server (car new-list)) + (erc-display-message + parsed 'notice proc + 'notify_on ?n (car new-list) ?m (erc-network-name))) + (setq new-list (cdr new-list))) + (while old-list + (when (not (erc-member-ignore-case (car old-list) ison-list)) + (run-hook-with-args 'erc-notify-signoff-hook server (car old-list)) + (erc-display-message + parsed 'notice proc + 'notify_off ?n (car old-list) ?m (erc-network-name))) + (setq old-list (cdr old-list))) + (setq erc-last-ison ison-list) + t)) + (erc-server-send + (concat "ISON " (mapconcat 'identity erc-notify-list " "))) + (setq erc-last-ison-time now))) + +(defun erc-notify-JOIN (proc parsed) + "Check if channel joiner is on `erc-notify-list' and not on `erc-last-ison'. +If this condition is satisfied, produce a notify_on message and add the nick +to `erc-last-ison' to prevent any further notifications." + (let ((nick (erc-extract-nick (erc-response.sender parsed)))) + (when (and (erc-member-ignore-case nick erc-notify-list) + (not (erc-member-ignore-case nick erc-last-ison))) + (add-to-list 'erc-last-ison nick) + (run-hook-with-args 'erc-notify-signon-hook + (or erc-server-announced-name erc-session-server) + nick) + (erc-display-message + parsed 'notice proc + 'notify_on ?n nick ?m (erc-network-name))) + nil)) + +(defun erc-notify-NICK (proc parsed) + "Check if new nick is on `erc-notify-list' and not on `erc-last-ison'. +If this condition is satisfied, produce a notify_on message and add the nick +to `erc-last-ison' to prevent any further notifications." + (let ((nick (erc-response.contents parsed))) + (when (and (erc-member-ignore-case nick erc-notify-list) + (not (erc-member-ignore-case nick erc-last-ison))) + (add-to-list 'erc-last-ison nick) + (run-hook-with-args 'erc-notify-signon-hook + (or erc-server-announced-name erc-session-server) + nick) + (erc-display-message + parsed 'notice proc + 'notify_on ?n nick ?m (erc-network-name))) + nil)) + +(defun erc-notify-QUIT (proc parsed) + "Check if quitter is on `erc-notify-list' and on `erc-last-ison'. +If this condition is satisfied, produce a notify_off message and remove the +nick from `erc-last-ison' to prevent any further notifications." + (let ((nick (erc-extract-nick (erc-response.sender parsed)))) + (when (and (erc-member-ignore-case nick erc-notify-list) + (erc-member-ignore-case nick erc-last-ison)) + (setq erc-last-ison (erc-delete-if `(lambda (el) + (string= ,(erc-downcase nick) + (erc-downcase el))) + erc-last-ison)) + (run-hook-with-args 'erc-notify-signoff-hook + (or erc-server-announced-name erc-session-server) + nick) + (erc-display-message + parsed 'notice proc + 'notify_off ?n nick ?m (erc-network-name))) + nil)) + +;;;; User level command + +;;;###autoload +(defun erc-cmd-NOTIFY (&rest args) + "Change `erc-notify-list' or list current notify-list members online. +Without args, list the current list of notificated people online, +with args, toggle notify status of people." + (cond + ((null args) + ;; Print current notificated people (online) + (let ((ison (erc-with-server-buffer erc-last-ison))) + (if (not ison) + (erc-display-message + nil 'notice 'active "No ison-list yet!") + (erc-display-message + nil 'notice 'active + 'notify_current ?l ison)))) + ((string= (car args) "-l") + (erc-display-message nil 'notice 'active + 'notify_list ?l (mapconcat 'identity erc-notify-list + " "))) + (t + (while args + (if (erc-member-ignore-case (car args) erc-notify-list) + (progn + (setq erc-notify-list (delete (car args) erc-notify-list)) + ;; Remove the nick from the value of erc-last-ison in + ;; every server buffer. This prevents seeing a signoff + ;; notification for a nick that you have just _removed_ + ;; from your notify list. + (dolist (buf (erc-buffer-list)) + (with-current-buffer buf + (if (erc-server-buffer-p) + (setq erc-last-ison (delete (car args) erc-last-ison)))))) + (setq erc-notify-list (cons (erc-string-no-properties (car args)) + erc-notify-list))) + (setq args (cdr args))) + (erc-display-message + nil 'notice 'active + 'notify_list ?l (mapconcat 'identity erc-notify-list " ")))) + t) + +;;;###autoload +(defun pcomplete/erc-mode/NOTIFY () + (pcomplete-here (pcomplete-erc-all-nicks))) + +(erc-notify-install-message-catalogs) + +(provide 'erc-notify) + +;;; erc-notify.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 0fb19dd0-1359-458a-89b7-81dc195a588e diff --git a/lisp/erc-page.el b/lisp/erc-page.el new file mode 100644 index 0000000..ff30bca --- /dev/null +++ b/lisp/erc-page.el @@ -0,0 +1,114 @@ +;; erc-page.el - CTCP PAGE support for ERC + +;; Copyright (C) 2002, 2004, 2006, 2007, 2008 Free Software Foundation + +;; 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 3, 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: + +;; Requiring this file will make ERC react to CTCP PAGE messages +;; received, and it will provide a new /PAGE command to send such +;; messages yourself. To enable it, customize the variable +;; `erc-page-mode'. + +;;; Code: + +(require 'erc) + +;;;###autoload (autoload 'erc-page-mode "erc-page") +(define-erc-module page ctcp-page + "Process CTCP PAGE requests from IRC." + nil nil) + +(erc-define-catalog-entry 'english 'CTCP-PAGE "Page from %n (%u@%h): %m") + +(defgroup erc-page nil + "React to CTCP PAGE messages." + :group 'erc) + +(defcustom erc-page-function nil + "A function to process a \"page\" request. +If nil, this prints the page message in the minibuffer and calls +`beep'. If non-nil, it must be a function that takes two arguments: +SENDER and MSG, both strings. + +Example for your ~/.emacs file: + +\(setq erc-page-function + (lambda (sender msg) + (play-sound-file \"/home/alex/elisp/erc/sounds/ni.wav\") + (message \"IRC Page from %s: %s\" sender msg)))" + :group 'erc-page + :type '(choice (const nil) + (function))) + +(defcustom erc-ctcp-query-PAGE-hook '(erc-ctcp-query-PAGE) + "List of functions to be called when a CTCP PAGE is received. +This is called from `erc-process-ctcp-query'. The functions are called +with six arguments: PROC NICK LOGIN HOST TO MSG. Note that you can +also set `erc-page-function' to a function, which only gets two arguments, +SENDER and MSG, so that might be easier to use." + :group 'erc-page + :type '(repeat function)) + +(defun erc-ctcp-query-PAGE (proc nick login host to msg) + "Deal with an CTCP PAGE query, if `erc-page-mode' is non-nil. +This will call `erc-page-function', if defined, or it will just print +a message and `beep'. In addition to that, the page message is also +inserted into the server buffer." + (when (and erc-page-mode + (string-match "PAGE\\(\\s-+.*\\)?$" msg)) + (let* ((m (match-string 1 msg)) + (page-msg (if m (erc-controls-interpret (substring m 1)) + "[no message]")) + text) + (if m (setq m (substring m 1))) + (setq text (erc-format-message 'CTCP-PAGE + ?n nick ?u login + ?h host ?m page-msg)) + (if erc-page-function + (funcall erc-page-function nick page-msg) + ;; if no function is defined + (message "%s" text) + (beep)) + ;; insert text into buffer + (erc-display-message + nil 'notice nil text))) + nil) + +(defun erc-cmd-PAGE (line &optional force) + "Send a CTCP page to the user given as the first word in LINE. +The rest of LINE is the message to send. Note that you will only +receive pages if `erc-page-mode' is on." + (when (string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line) + (let ((nick (match-string 1 line)) + (msg (match-string 2 line))) + (erc-cmd-CTCP nick "PAGE" msg)))) + +(put 'erc-cmd-PAGE 'do-not-parse-args t) + +(provide 'erc-page) + +;;; erc-page.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de diff --git a/lisp/erc-pcomplete.el b/lisp/erc-pcomplete.el new file mode 100644 index 0000000..9fdbd36 --- /dev/null +++ b/lisp/erc-pcomplete.el @@ -0,0 +1,284 @@ +;;; erc-pcomplete.el --- Provides programmable completion for ERC + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Sacha Chua +;; Keywords: comm, convenience +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion + +;; 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 3, 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 file replaces erc-complete.el. It provides nick completion +;; for ERC based on pcomplete. If you do not have pcomplete, you may +;; try to use erc-complete.el. +;; +;; To use, (require 'erc-auto) or (require 'erc-pcomplete), then +;; (erc-pcomplete-mode 1) +;; +;; If you want nickname completions ordered such that the most recent +;; speakers are listed first, set +;; `erc-pcomplete-order-nickname-completions' to `t'. +;; +;; See CREDITS for other contributors. +;; +;;; Code: + +(require 'pcomplete) +(require 'erc) +(require 'erc-compat) +(require 'time-date) +(eval-when-compile (require 'cl)) + +(defgroup erc-pcomplete nil + "Programmable completion for ERC" + :group 'erc) + +(defcustom erc-pcomplete-nick-postfix ": " + "*When `pcomplete' is used in the first word after the prompt, +add this string to nicks completed." + :group 'erc-pcomplete + :type 'string) + +(defcustom erc-pcomplete-order-nickname-completions t + "If t, channel nickname completions will be ordered such that +the most recent speakers are listed first." + :group 'erc-pcomplete + :type 'boolean) + +;;;###autoload (autoload 'erc-completion-mode "erc-pcomplete" nil t) +(define-erc-module pcomplete Completion + "In ERC Completion mode, the TAB key does completion whenever possible." + ((add-hook 'erc-mode-hook 'pcomplete-erc-setup) + (add-hook 'erc-complete-functions 'erc-pcomplete) + (erc-buffer-list #'pcomplete-erc-setup)) + ((remove-hook 'erc-mode-hook 'pcomplete-erc-setup) + (remove-hook 'erc-complete-functions 'erc-pcomplete))) + +(defun erc-pcomplete () + "Complete the nick before point." + (interactive) + (when (> (point) (erc-beg-of-input-line)) + (let ((last-command (if (eq last-command 'erc-complete-word) + 'pcomplete + last-command))) + (call-interactively 'pcomplete)) + t)) + +;;; Setup function + +(defun pcomplete-erc-setup () + "Setup `erc-mode' to use pcomplete." + (set (make-local-variable 'pcomplete-ignore-case) + t) + (set (make-local-variable 'pcomplete-use-paring) + nil) + (set (make-local-variable 'pcomplete-suffix-list) + '(? ?:)) + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'pcomplete-parse-erc-arguments) + (set (make-local-variable 'pcomplete-command-completion-function) + 'pcomplete/erc-mode/complete-command) + (set (make-local-variable 'pcomplete-command-name-function) + 'pcomplete-erc-command-name) + (set (make-local-variable 'pcomplete-default-completion-function) + (lambda () (pcomplete-here (pcomplete-erc-nicks))))) + +;;; Programmable completion logic + +(defun pcomplete/erc-mode/complete-command () + (pcomplete-here + (append + (pcomplete-erc-commands) + (pcomplete-erc-nicks erc-pcomplete-nick-postfix t)))) + +(defvar erc-pcomplete-ctcp-commands + '("ACTION" "CLIENTINFO" "ECHO" "FINGER" "PING" "TIME" "USERINFO" "VERSION")) + +(defun pcomplete/erc-mode/CTCP () + (pcomplete-here (pcomplete-erc-nicks)) + (pcomplete-here erc-pcomplete-ctcp-commands)) + +(defun pcomplete/erc-mode/CLEARTOPIC () + (pcomplete-here (pcomplete-erc-channels))) + +(defun pcomplete/erc-mode/DEOP () + (while (pcomplete-here (pcomplete-erc-ops)))) + +(defun pcomplete/erc-mode/DESCRIBE () + (pcomplete-here (pcomplete-erc-nicks))) + +(defun pcomplete/erc-mode/IDLE () + (while (pcomplete-here (pcomplete-erc-nicks)))) + +(defun pcomplete/erc-mode/KICK () + (pcomplete-here (pcomplete-erc-channels)) + (pcomplete-here (pcomplete-erc-nicks))) + +(defun pcomplete/erc-mode/LOAD () + (pcomplete-here (pcomplete-entries))) + +(defun pcomplete/erc-mode/MODE () + (pcomplete-here (pcomplete-erc-channels)) + (while (pcomplete-here (pcomplete-erc-nicks)))) + +(defun pcomplete/erc-mode/ME () + (while (pcomplete-here (pcomplete-erc-nicks)))) + +(defun pcomplete/erc-mode/SAY () + (pcomplete-here (pcomplete-erc-nicks)) + (pcomplete-here (pcomplete-erc-nicks)) + (while (pcomplete-here (pcomplete-erc-nicks)))) + +(defun pcomplete/erc-mode/MSG () + (pcomplete-here (append (pcomplete-erc-all-nicks) + (pcomplete-erc-channels))) + (while (pcomplete-here (pcomplete-erc-nicks)))) + +(defun pcomplete/erc-mode/NAMES () + (while (pcomplete-here (pcomplete-erc-channels)))) + +(defalias 'pcomplete/erc-mode/NOTICE 'pcomplete/erc-mode/MSG) + +(defun pcomplete/erc-mode/OP () + (while (pcomplete-here (pcomplete-erc-not-ops)))) + +(defun pcomplete/erc-mode/PART () + (pcomplete-here (pcomplete-erc-channels))) + +(defalias 'pcomplete/erc-mode/LEAVE 'pcomplete/erc-mode/PART) + +(defun pcomplete/erc-mode/QUERY () + (pcomplete-here (append (pcomplete-erc-all-nicks) + (pcomplete-erc-channels))) + (while (pcomplete-here (pcomplete-erc-nicks))) + ) + +(defun pcomplete/erc-mode/SOUND () + (while (pcomplete-here (pcomplete-entries)))) + +(defun pcomplete/erc-mode/TOPIC () + (pcomplete-here (pcomplete-erc-channels))) + +(defun pcomplete/erc-mode/WHOIS () + (while (pcomplete-here (pcomplete-erc-nicks)))) + +(defun pcomplete/erc-mode/UNIGNORE () + (pcomplete-here (erc-with-server-buffer erc-ignore-list))) + +;;; Functions that provide possible completions. + +(defun pcomplete-erc-commands () + "Returns a list of strings of the defined user commands." + (let ((case-fold-search nil)) + (mapcar (lambda (x) + (concat "/" (downcase (substring (symbol-name x) 8)))) + (apropos-internal "erc-cmd-[A-Z]+")))) + +(defun pcomplete-erc-ops () + "Returns a list of nicks with ops." + (let (ops) + (maphash (lambda (nick cdata) + (if (and (cdr cdata) + (erc-channel-user-op (cdr cdata))) + (setq ops (cons nick ops)))) + erc-channel-users) + ops)) + +(defun pcomplete-erc-not-ops () + "Returns a list of nicks without ops." + (let (not-ops) + (maphash (lambda (nick cdata) + (if (and (cdr cdata) + (not (erc-channel-user-op (cdr cdata)))) + (setq not-ops (cons nick not-ops)))) + erc-channel-users) + not-ops)) + + +(defun pcomplete-erc-nicks (&optional postfix ignore-self) + "Returns a list of nicks in the current channel. +Optional argument POSTFIX is something to append to the nickname. +If optional argument IGNORE-SELF is non-nil, don't return the current nick." + (let ((users (if erc-pcomplete-order-nickname-completions + (erc-sort-channel-users-by-activity + (erc-get-channel-user-list)) + (erc-get-channel-user-list))) + (nicks nil)) + (dolist (user users) + (unless (and ignore-self + (string= (erc-server-user-nickname (car user)) + (erc-current-nick))) + (setq nicks (cons (concat (erc-server-user-nickname (car user)) + postfix) + nicks)))) + (nreverse nicks))) + +(defun pcomplete-erc-all-nicks (&optional postfix) + "Returns a list of all nicks on the current server." + (let (nicks) + (erc-with-server-buffer + (maphash (lambda (nick user) + (setq nicks (cons (concat nick postfix) nicks))) + erc-server-users)) + nicks)) + +(defun pcomplete-erc-channels () + "Returns a list of channels associated with the current server." + (mapcar (lambda (buf) (with-current-buffer buf (erc-default-target))) + (erc-channel-list erc-server-process))) + +;;; Functions for parsing + +(defun pcomplete-erc-command-name () + "Returns the command name of the first argument." + (if (eq (elt (pcomplete-arg 'first) 0) ?/) + (upcase (substring (pcomplete-arg 'first) 1)) + "SAY")) + +(defun pcomplete-parse-erc-arguments () + "Returns a list of parsed whitespace-separated arguments. +These are the words from the beginning of the line after the prompt +up to where point is right now." + (let* ((start erc-input-marker) + (end (point)) + args beginnings) + (save-excursion + (if (< (skip-chars-backward " \t\n" start) 0) + (setq args '("") + beginnings (list end))) + (setq end (point)) + (while (< (skip-chars-backward "^ \t\n" start) 0) + (setq beginnings (cons (point) beginnings) + args (cons (buffer-substring-no-properties + (point) end) + args)) + (skip-chars-backward " \t\n" start) + (setq end (point)))) + (cons args beginnings))) + +(provide 'erc-pcomplete) + +;;; erc-pcomplete.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;; arch-tag: 32a7703b-be87-45a4-82f3-9eed5a628911 diff --git a/lisp/erc-replace.el b/lisp/erc-replace.el new file mode 100644 index 0000000..45ce20e --- /dev/null +++ b/lisp/erc-replace.el @@ -0,0 +1,99 @@ +;; erc-replace.el -- wash and massage messages inserted into the buffer + +;; Copyright (C) 2001, 2002, 2004, 2006, 2007, +;; 2008 Free Software Foundation, Inc. + +;; Author: Andreas Fuchs +;; Maintainer: Mario Lang (mlang@delysid.org) +;; Keywords: IRC, client, Internet + +;; 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 3, 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 module allows you to systematically replace text in incoming +;; messages. Load erc-replace, and customize `erc-replace-alist'. +;; Then add to your ~/.emacs: + +;; (require 'erc-replace) +;; (erc-replace-mode 1) + +;;; Code: + +(require 'erc) + +(defgroup erc-replace nil + "Replace text from incoming messages" + :group 'erc) + +(defcustom erc-replace-alist nil + "Alist describing text to be replaced in incoming messages. +This is useful for filters. + +The alist has elements of the form (FROM . TO). FROM can be a regular +expression or a variable, or any sexp, TO can be a string or a +function to call, or any sexp. If a function, it will be called with +one argument, the string to be replaced, and it should return a +replacement string." + :group 'erc-replace + :type '(repeat (cons :tag "Search & Replace" + (choice :tag "From" + regexp + variable + sexp) + (choice :tag "To" + string + function + sexp)))) + +(defun erc-replace-insert () + "Function to run from `erc-insert-modify-hook'. +It replaces text according to `erc-replace-alist'." + (mapcar (lambda (elt) + (goto-char (point-min)) + (let ((from (car elt)) + (to (cdr elt))) + (unless (stringp from) + (setq from (eval from))) + (while (re-search-forward from nil t) + (cond ((stringp to) + (replace-match to)) + ((and (symbolp to) (fboundp to)) + (replace-match (funcall to (match-string 0)))) + (t + (eval to)))))) + erc-replace-alist)) + +;;;###autoload (autoload 'erc-replace-mode "erc-replace") +(define-erc-module replace nil + "This mode replaces incoming text according to `erc-replace-alist'." + ((add-hook 'erc-insert-modify-hook + 'erc-replace-insert)) + ((remove-hook 'erc-insert-modify-hook + 'erc-replace-insert))) + +(provide 'erc-replace) + +;;; erc-replace.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18 diff --git a/lisp/erc-ring.el b/lisp/erc-ring.el new file mode 100644 index 0000000..00f1fca --- /dev/null +++ b/lisp/erc-ring.el @@ -0,0 +1,149 @@ +;; erc-ring.el -- Command history handling for erc using ring.el + +;; Copyright (C) 2001, 2002, 2003, 2004, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + +;; Author: Alex Schroeder +;; Keywords: comm +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcHistory + +;; 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 3, 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 file implements an input ring -- a history of the stuff you +;; wrote. To activate: +;; +;; (require 'erc-auto) or (require 'erc-ring) +;; (erc-ring-mode 1) +;; +;; Use M-n and M-p to navigate the ring + +;;; Code: + +(require 'erc) +(require 'comint) +(require 'ring) + +;;;###autoload (autoload 'erc-ring-mode "erc-ring" nil t) +(define-erc-module ring nil + "Stores input in a ring so that previous commands and messages can +be recalled using M-p and M-n." + ((add-hook 'erc-send-pre-hook 'erc-add-to-input-ring) + (define-key erc-mode-map "\M-p" 'erc-previous-command) + (define-key erc-mode-map "\M-n" 'erc-next-command)) + ((remove-hook 'erc-send-pre-hook 'erc-add-to-input-ring) + (define-key erc-mode-map "\M-p" 'undefined) + (define-key erc-mode-map "\M-n" 'undefined))) + +(defvar erc-input-ring nil "Input ring for erc.") +(make-variable-buffer-local 'erc-input-ring) + +(defvar erc-input-ring-index nil + "Position in the input ring for erc. +If nil, the input line is blank and the user is conceptually 'after' +the most recently added item in the ring. If an integer, the input +line is non-blank and displays the item from the ring indexed by this +variable.") +(make-variable-buffer-local 'erc-input-ring-index) + +(defun erc-input-ring-setup () + "Do the setup required so that we can use comint style input rings. +Call this function when setting up the mode." + (setq erc-input-ring (make-ring comint-input-ring-size)) + (setq erc-input-ring-index nil)) + +(defun erc-add-to-input-ring (s) + "Add string S to the input ring and reset history position." + (unless erc-input-ring (erc-input-ring-setup)) + (ring-insert erc-input-ring s) + (setq erc-input-ring-index nil)) + +(defun erc-clear-input-ring () + "Remove all entries from the input ring, then call garbage-collect. +You might use this for security purposes if you have typed a command +containing a password." + (interactive) + (setq erc-input-ring (make-ring comint-input-ring-size) + erc-input-ring-index nil) + (garbage-collect) + (message "ERC input ring cleared.")) + +(defun erc-previous-command () + "Replace current command with the previous one from the history." + (interactive) + (unless erc-input-ring (erc-input-ring-setup)) + ;; if the ring isn't empty + (when (> (ring-length erc-input-ring) 0) + (if (and erc-input-ring-index + (= (ring-length erc-input-ring) (1+ erc-input-ring-index))) + (progn + (erc-replace-current-command "") + (setq erc-input-ring-index nil)) + + ;; If we are not viewing old input and there's text in the input + ;; area, push it on the history ring before moving back through + ;; the input history, so it will be there when we return to the + ;; front. + (if (null erc-input-ring-index) + (when (> (point-max) erc-input-marker) + (erc-add-to-input-ring (buffer-substring erc-input-marker + (point-max))) + (setq erc-input-ring-index 0))) + + (setq erc-input-ring-index (if erc-input-ring-index + (ring-plus1 erc-input-ring-index + (ring-length erc-input-ring)) + 0)) + (erc-replace-current-command (ring-ref erc-input-ring + erc-input-ring-index))))) + +(defun erc-next-command () + "Replace current command with the next one from the history." + (interactive) + (unless erc-input-ring (erc-input-ring-setup)) + ;; if the ring isn't empty + (when (> (ring-length erc-input-ring) 0) + (if (and erc-input-ring-index + (= 0 erc-input-ring-index)) + (progn + (erc-replace-current-command "") + (setq erc-input-ring-index nil)) + (setq erc-input-ring-index (ring-minus1 (or erc-input-ring-index 0) + (ring-length erc-input-ring))) + (erc-replace-current-command (ring-ref erc-input-ring + erc-input-ring-index))))) + + +(defun erc-replace-current-command (s) + "Replace current command with string S." + ;; delete line + (let ((inhibit-read-only t)) + (delete-region + (progn (goto-char erc-insert-marker) (erc-bol)) + (goto-char (point-max))) + (insert s))) + +(provide 'erc-ring) + +;;; erc-ring.el ends here +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;; arch-tag: b77924a8-a80e-489d-84cd-b351761ea5c8 diff --git a/lisp/erc-sasl.el b/lisp/erc-sasl.el new file mode 100644 index 0000000..d1e7600 --- /dev/null +++ b/lisp/erc-sasl.el @@ -0,0 +1,95 @@ +;; erc-sasl.el -- handle SASL PLAIN authentication + +;; Copyright (C) 2012 Joseph Gay + +;; Author: Joseph Gay +;; Keywords: comm + +;; This file is NOT 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 3 of the License, 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. If not, see . + +;;; Commentary: + +;; This file implements SASL PLAIN authentication +;; To activate: +;; +;; (require 'erc-sasl) +;; +;; (add-to-list 'erc-sasl-server-regexp-list "host\\.server\\.com") +;; e.g. irc\\.freenode\\.net, or .* for any host +;; +;; To disable: +;; (setq erc-sasl-use-sasl nil) +;; +;; NOTE: requires passing a password initially to (erc) and variants + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defvar erc-sasl-use-sasl t + "Set to nil to disable SASL auth") + +(defvar erc-sasl-server-regexp-list '() + "List of regexps matching server host names for which sasl + should be used") + +(defun erc-sasl-use-sasl-p () + "Used internally to decide whether SASL should be used in the +current session" + (and erc-sasl-use-sasl + (boundp 'erc-session-server) + (loop for re in erc-sasl-server-regexp-list + thereis (integerp (string-match re erc-session-server))))) + +(define-erc-response-handler (CAP) + "Client capability framework is used to request SASL auth, need + to wait for ACK to begin" nil + (let ((msg (erc-response.contents parsed))) + (when (string-match " *sasl" msg) + (erc-server-send "AUTHENTICATE PLAIN") + ;; now wait for AUTHENTICATE + + ))) + +(define-erc-response-handler (AUTHENTICATE) + "Handling empty server response indicating ready to receive + authentication." nil + (if erc-session-password + (let ((msg (erc-response.contents parsed))) + (when (string= "+" msg) + ;; plain auth + (erc-server-send + (format "AUTHENTICATE %s" + (base64-encode-string + (concat "\0" (erc-current-nick) + "\0" erc-session-password) t))))) + (progn + (erc-display-message + parsed 'error + (if erc-server-connected 'active proc) + "You must set a password in order to use SASL authentication.") + ;; aborting SASL auth + (erc-server-send (erc-server-send "AUTHENTICATE *"))))) + +(define-erc-response-handler (903) + "Handling a successful SASL authentication." nil + (erc-server-send "CAP END")) + +(provide 'erc-sasl) + +;;; erc-sasl.el ends here +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/lisp/erc-services.el b/lisp/erc-services.el new file mode 100644 index 0000000..b25a10d --- /dev/null +++ b/lisp/erc-services.el @@ -0,0 +1,445 @@ +;;; erc-services.el --- Identify to NickServ + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; 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 3, 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: + +;; There are two ways to go about identifying yourself automatically to +;; NickServ with this module. The more secure way is to listen for identify +;; requests from the user NickServ. Another way is to identify yourself to +;; NickServ directly after a successful connection and every time you change +;; your nickname. This method is rather insecure, though, because no checks +;; are made to test if NickServ is the real NickServ for a given network or +;; server. + +;; As a default, ERC has the data for the official nickname services on +;; the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet, GRnet, +;; and Slashnet. You can add more by using M-x customize-variable RET +;; erc-nickserv-alist. + +;; Usage: +;; +;; Put into your .emacs: +;; +;; (require 'erc-services) +;; (erc-services-mode 1) +;; +;; Add your nickname and NickServ password to `erc-nickserv-passwords'. +;; Using the freenode network as an example: +;; +;; (setq erc-nickserv-passwords '((freenode (("nickname" "password"))))) +;; +;; The default automatic identification mode is autodetection of NickServ +;; identify requests. Set the variable `erc-nickserv-identify-mode' if +;; you'd like to change this behavior. You can also change the way +;; automatic identification is handled by using: +;; +;; M-x erc-nickserv-identify-mode +;; +;; If you'd rather not identify yourself automatically but would like access +;; to the functions contained in this file, just load this file without +;; enabling `erc-services-mode'. +;; + +;;; Code: + +(require 'erc) +(require 'erc-networks) +(eval-when-compile (require 'cl)) + +;; Customization: + +(defgroup erc-services nil + "Configuration for IRC services. + +On some networks, there exists a special type of automated irc bot, +called Services. Those usually allow you to register your nickname, +post/read memos to other registered users who are currently offline, +and do various other things. + +This group allows you to set variables to somewhat automate +communication with those Services." + :group 'erc) + +(defcustom erc-nickserv-identify-mode 'both + "The mode which is used when identifying to Nickserv. + +Possible settings are:. + +'autodetect - Identify when the real Nickserv sends an identify request. +'nick-change - Identify when you log in or change your nickname. +'both - Do the former if the network supports it, otherwise do the + latter. +nil - Disables automatic Nickserv identification. + +You can also use M-x erc-nickserv-identify-mode to change modes." + :group 'erc-services + :type '(choice (const autodetect) + (const nick-change) + (const both) + (const nil)) + :set (lambda (sym val) + (set sym val) + ;; avoid recursive load at startup + (when (featurep 'erc-services) + (erc-nickserv-identify-mode val)))) + +;;;###autoload (autoload 'erc-services-mode "erc-services" nil t) +(define-erc-module services nickserv + "This mode automates communication with services." + ((erc-nickserv-identify-mode erc-nickserv-identify-mode)) + ((remove-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identify-autodetect) + (remove-hook 'erc-after-connect + 'erc-nickserv-identify-on-connect) + (remove-hook 'erc-nick-changed-functions + 'erc-nickserv-identify-on-nick-change) + (remove-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identification-autodetect))) + +;;;###autoload +(defun erc-nickserv-identify-mode (mode) + "Set up hooks according to which MODE the user has chosen." + (interactive + (list (intern (completing-read + "Choose Nickserv identify mode (RET to disable): " + '(("autodetect") ("nick-change") ("both")) nil t)))) + (add-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identification-autodetect) + (unless erc-networks-mode + ;; Force-enable networks module, because we need it to set + ;; erc-network for us. + (erc-networks-enable)) + (cond ((eq mode 'autodetect) + (setq erc-nickserv-identify-mode 'autodetect) + (add-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identify-autodetect) + (remove-hook 'erc-nick-changed-functions + 'erc-nickserv-identify-on-nick-change) + (remove-hook 'erc-after-connect + 'erc-nickserv-identify-on-connect)) + ((eq mode 'nick-change) + (setq erc-nickserv-identify-mode 'nick-change) + (add-hook 'erc-after-connect + 'erc-nickserv-identify-on-connect) + (add-hook 'erc-nick-changed-functions + 'erc-nickserv-identify-on-nick-change) + (remove-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identify-autodetect)) + ((eq mode 'both) + (setq erc-nickserv-identify-mode 'both) + (add-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identify-autodetect) + (add-hook 'erc-after-connect + 'erc-nickserv-identify-on-connect) + (add-hook 'erc-nick-changed-functions + 'erc-nickserv-identify-on-nick-change)) + (t + (setq erc-nickserv-identify-mode nil) + (remove-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identify-autodetect) + (remove-hook 'erc-after-connect + 'erc-nickserv-identify-on-connect) + (remove-hook 'erc-nick-changed-functions + 'erc-nickserv-identify-on-nick-change) + (remove-hook 'erc-server-NOTICE-functions + 'erc-nickserv-identification-autodetect)))) + +(defcustom erc-prompt-for-nickserv-password t + "Ask for the password when identifying to NickServ." + :group 'erc-services + :type 'boolean) + +(defcustom erc-nickserv-passwords nil + "Passwords used when identifying to NickServ automatically. + +Example of use: + (setq erc-nickserv-passwords + '((freenode ((\"nick-one\" . \"password\") + (\"nick-two\" . \"password\"))) + (DALnet ((\"nick\" . \"password\")))))" + :group 'erc-services + :type '(repeat + (list :tag "Network" + (choice :tag "Network name" + (const Ars) + (const Austnet) + (const Azzurra) + (const BitlBee) + (const BRASnet) + (const DALnet) + (const freenode) + (const GalaxyNet) + (const GRnet) + (const iip) + (const OFTC) + (const QuakeNet) + (const Rizon) + (const SlashNET) + (symbol :tag "Network name")) + (repeat :tag "Nickname and password" + (cons :tag "Identity" + (string :tag "Nick") + (string :tag "Password")))))) + +;; Variables: + +(defcustom erc-nickserv-alist + '((Ars + nil nil + "Census" + "IDENTIFY" nil nil nil) + (Austnet + "NickOP!service@austnet.org" + "/msg\\s-NickOP@austnet.org\\s-identify\\s-" + "nickop@austnet.org" + "identify" nil nil nil) + (Azzurra + "NickServ!service@azzurra.org" + "/ns\\s-IDENTIFY\\s-password" + "NickServ" + "IDENTIFY" nil nil nil) + (BitlBee + nil nil + "&bitlbee" + "identify" nil nil nil) + (BRASnet + "NickServ!services@brasnet.org" + "/NickServ\\s-IDENTIFY\\s-senha" + "NickServ" + "IDENTIFY" nil "" nil) + (DALnet + "NickServ!service@dal.net" + "/msg\\s-NickServ@services.dal.net\\s-IDENTIFY\\s-" + "NickServ@services.dal.net" + "IDENTIFY" nil nil nil) + (freenode + "NickServ!NickServ@services." + ;; freenode also accepts a password at login, see the `erc' + ;; :password argument. + "/msg\\s-NickServ\\s-IDENTIFY\\s-" + "NickServ" + "IDENTIFY" nil nil + "Password\\s-accepted\\s--\\s-you\\s-are\\s-now\\s-recognized") + (GalaxyNet + "NS!nickserv@galaxynet.org" + "Please\\s-change\\s-nicks\\s-or\\s-authenticate." + "NS@services.galaxynet.org" + "AUTH" t nil nil) + (GRnet + "NickServ!service@irc.gr" + "This\\s-nickname\\s-is\\s-registered\\s-and\\s-protected." + "NickServ" + "IDENTIFY" nil nil + "Password\\s-accepted\\s--\\s-you\\s-are\\s-now\\s-recognized.") + (iip + "Trent@anon.iip" + "type\\s-/squery\\s-Trent\\s-identify\\s-" + "Trent@anon.iip" + "IDENTIFY" nil "SQUERY" nil) + (OFTC + "NickServ!services@services.oftc.net" + ;; OFTC's NickServ doesn't ask you to identify anymore. + nil + "NickServ" + "IDENTIFY" nil nil + "You\\s-are\\s-successfully\\s-identified\\s-as\\s-") + (Rizon + "NickServ!service@rizon.net" + "This\\s-nickname\\s-is\\s-registered\\s-and\\s-protected." + "NickServ" + "IDENTIFY" nil nil + "Password\\s-accepted\\s--\\s-you\\s-are\\s-now\\s-recognized.") + (QuakeNet + nil nil + "Q@CServe.quakenet.org" + "auth" t nil nil) + (SlashNET + "NickServ!services@services.slashnet.org" + "/msg\\s-NickServ\\s-IDENTIFY\\s-password" + "NickServ@services.slashnet.org" + "IDENTIFY" nil nil nil)) + "Alist of NickServer details, sorted by network. +Every element in the list has the form + \(SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER SUCCESS-REGEXP) + +SYMBOL is a network identifier, a symbol, as used in `erc-networks-alist'. +NICKSERV is the description of the nickserv in the form nick!user@host. +REGEXP is a regular expression matching the message from nickserv. +NICK is nickserv's nickname. Use nick@server where necessary/possible. +KEYWORD is the keyword to use in the reply message to identify yourself. +USE-CURRENT indicates whether the current nickname must be used when + identifying. +ANSWER is the command to use for the answer. The default is 'privmsg. +SUCCESS-REGEXP is a regular expression matching the message nickserv + sends when you've successfully identified. +The last two elements are optional." + :group 'erc-services + :type '(repeat + (list :tag "Nickserv data" + (symbol :tag "Network name") + (choice (string :tag "Nickserv's nick!user@host") + (const :tag "No message sent by Nickserv" nil)) + (choice (regexp :tag "Identify request sent by Nickserv") + (const :tag "No message sent by Nickserv" nil)) + (string :tag "Identify to") + (string :tag "Identify keyword") + (boolean :tag "Use current nick in identify message?") + (choice :tag "Command to use (optional)" + (string :tag "Command") + (const :tag "No special command necessary" nil))))) + +(defsubst erc-nickserv-alist-sender (network &optional entry) + (nth 1 (or entry (assoc network erc-nickserv-alist)))) + +(defsubst erc-nickserv-alist-regexp (network &optional entry) + (nth 2 (or entry (assoc network erc-nickserv-alist)))) + +(defsubst erc-nickserv-alist-nickserv (network &optional entry) + (nth 3 (or entry (assoc network erc-nickserv-alist)))) + +(defsubst erc-nickserv-alist-ident-keyword (network &optional entry) + (nth 4 (or entry (assoc network erc-nickserv-alist)))) + +(defsubst erc-nickserv-alist-use-nick-p (network &optional entry) + (nth 5 (or entry (assoc network erc-nickserv-alist)))) + +(defsubst erc-nickserv-alist-ident-command (network &optional entry) + (nth 6 (or entry (assoc network erc-nickserv-alist)))) + +(defsubst erc-nickserv-alist-identified-regexp (network &optional entry) + (nth 7 (or entry (assoc network erc-nickserv-alist)))) + +;; Functions: + +(defcustom erc-nickserv-identified-hook nil + "Run this hook when NickServ acknowledged successful identification. +Hooks are called with arguments (NETWORK NICK)." + :group 'erc-services + :type 'hook) + +(defun erc-nickserv-identification-autodetect (proc parsed) + "Check for NickServ's successful identification notice. +Make sure it is the real NickServ for this network and that it has +specifically confirmed a successful identification attempt. +If this is the case, run `erc-nickserv-identified-hook'." + (let* ((network (erc-network)) + (sender (erc-nickserv-alist-sender network)) + (success-regex (erc-nickserv-alist-identified-regexp network)) + (sspec (erc-response.sender parsed)) + (nick (car (erc-response.command-args parsed))) + (msg (erc-response.contents parsed))) + ;; continue only if we're sure it's the real nickserv for this network + ;; and it's told us we've successfully identified + (when (and sender (equal sspec sender) + success-regex + (string-match success-regex msg)) + (erc-log "NickServ IDENTIFY success notification detected") + (run-hook-with-args 'erc-nickserv-identified-hook network nick) + nil))) + +(defun erc-nickserv-identify-autodetect (proc parsed) + "Identify to NickServ when an identify request is received. +Make sure it is the real NickServ for this network. +If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the +password for this nickname, otherwise try to send it automatically." + (unless (and (null erc-nickserv-passwords) + (null erc-prompt-for-nickserv-password)) + (let* ((network (erc-network)) + (sender (erc-nickserv-alist-sender network)) + (identify-regex (erc-nickserv-alist-regexp network)) + (sspec (erc-response.sender parsed)) + (nick (car (erc-response.command-args parsed))) + (msg (erc-response.contents parsed))) + ;; continue only if we're sure it's the real nickserv for this network + ;; and it's asked us to identify + (when (and sender (equal sspec sender) + identify-regex + (string-match identify-regex msg)) + (erc-log "NickServ IDENTIFY request detected") + (erc-nickserv-call-identify-function nick) + nil)))) + +(defun erc-nickserv-identify-on-connect (server nick) + "Identify to Nickserv after the connection to the server is established." + (unless (or (and (null erc-nickserv-passwords) + (null erc-prompt-for-nickserv-password)) + (and (eq erc-nickserv-identify-mode 'both) + (erc-nickserv-alist-regexp (erc-network)))) + (erc-nickserv-call-identify-function nick))) + +(defun erc-nickserv-identify-on-nick-change (nick old-nick) + "Identify to Nickserv whenever your nick changes." + (unless (or (and (null erc-nickserv-passwords) + (null erc-prompt-for-nickserv-password)) + (and (eq erc-nickserv-identify-mode 'both) + (erc-nickserv-alist-regexp (erc-network)))) + (erc-nickserv-call-identify-function nick))) + +(defun erc-nickserv-call-identify-function (nickname) + "Call `erc-nickserv-identify' interactively or run it with NICKNAME's +password. +The action is determined by the value of `erc-prompt-for-nickserv-password'." + (if erc-prompt-for-nickserv-password + (call-interactively 'erc-nickserv-identify) + (when erc-nickserv-passwords + (erc-nickserv-identify + (cdr (assoc nickname + (nth 1 (assoc (erc-network) + erc-nickserv-passwords)))))))) + +;;;###autoload +(defun erc-nickserv-identify (password) + "Send an \"identify \" message to NickServ. +When called interactively, read the password using `read-passwd'." + (interactive + (list (read-passwd + (format "NickServ password for %s on %s (RET to cancel): " + (erc-current-nick) + (or (and (erc-network) + (symbol-name (erc-network))) + "Unknown network"))))) + (when (and password (not (string= "" password))) + (let* ((erc-auto-discard-away nil) + (network (erc-network)) + (nickserv-info (assoc network erc-nickserv-alist)) + (nickserv (or (erc-nickserv-alist-nickserv nil nickserv-info) + "NickServ")) + (identify-word (or (erc-nickserv-alist-ident-keyword + nil nickserv-info) + "IDENTIFY")) + (nick (if (erc-nickserv-alist-use-nick-p nil nickserv-info) + (concat (erc-current-nick) " ") + "")) + (msgtype (or (erc-nickserv-alist-ident-command nil nickserv-info) + "PRIVMSG"))) + (erc-message msgtype + (concat nickserv " " identify-word " " nick password))))) + +(provide 'erc-services) + +;;; erc-services.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: d401c8aa-d938-4255-96a9-3efb64c47e58 diff --git a/lisp/erc-sound.el b/lisp/erc-sound.el new file mode 100644 index 0000000..1ee8fbf --- /dev/null +++ b/lisp/erc-sound.el @@ -0,0 +1,152 @@ +;;; erc-sound.el --- CTCP SOUND support for ERC + +;; Copyright (C) 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; 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 3, 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: + +;; Play sounds when users send you CTCP SOUND messages. + +;; This file also defines the command /sound so that you can send +;; sound requests to other users. + +;;; Usage: + +;; Add the following to your .emacs if you want to play sounds. +;; +;; (require 'erc-sound) +;; (erc-sound-enable) +;; +;; To send requests to other users from within query buffers, type the +;; following: +;; +;; /sound filename optional-message-text +;; +;; You can also type the following: +;; +;; /ctcp nickname sound filename optional-message + +;;; Code: + +(require 'erc) + +;;;###autoload (autoload 'erc-sound-mode "erc-sound") +(define-erc-module sound ctcp-sound + "In ERC sound mode, the client will respond to CTCP SOUND requests +and play sound files as requested." + ;; Enable: + ((add-hook 'erc-ctcp-query-SOUND-hook 'erc-ctcp-query-SOUND) + (define-key erc-mode-map "\C-c\C-s" 'erc-toggle-sound)) + ;; Disable: + ((remove-hook 'erc-ctcp-query-SOUND-hook 'erc-ctcp-query-SOUND) + (define-key erc-mode-map "\C-c\C-s" 'undefined))) + +(erc-define-catalog-entry 'english 'CTCP-SOUND "%n (%u@%h) plays %s:%m") + +(defgroup erc-sound nil + "Make ERC play bells and whistles while chatting with people." + :group 'erc) + +(defcustom erc-play-sound t + "*Play sounds when you receive CTCP SOUND requests." + :group 'erc-sound + :type 'boolean) + +(defcustom erc-sound-path nil + "List of directories that contain sound samples to play on SOUND events." + :group 'erc-sound + :type '(repeat directory)) + +(defcustom erc-default-sound nil + "Play this sound if the requested file was not found. +If this is set to nil or the file doesn't exist a beep will sound." + :group 'erc-sound + :type '(choice (const nil) + file)) + +(defvar erc-ctcp-query-SOUND-hook nil + "Hook to run after receiving a CTCP SOUND request.") + +(defun erc-cmd-SOUND (line &optional force) + "Send a CTCP SOUND message to the default target. +If `erc-play-sound' is non-nil, play the sound as well. + +/sound filename optional-message-text + +LINE is the text entered, including the command." + (cond + ((string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*\\)?$" line) + (let ((file (match-string 1 line)) + (msg (match-string 2 line)) + (tgt (erc-default-target))) + (if (null msg) + (setq msg "") + ;; remove the first white space + (setq msg (substring msg 1))) + (if tgt + (progn + (erc-send-ctcp-message tgt (format "SOUND %s %s" file msg) force) + (if erc-play-sound (erc-play-sound file))) + (erc-display-message nil 'error (current-buffer) 'no-target)) + t)) + (t nil))) + +(defun erc-ctcp-query-SOUND (proc nick login host to msg) + "Display a CTCP SOUND message and play sound if `erc-play-sound' is non-nil." + (when (string-match "^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg) + (let ((sound (match-string 1 msg)) + (comment (match-string 2 msg))) + (when erc-play-sound (erc-play-sound sound)) + (erc-display-message + nil 'notice nil + 'CTCP-SOUND ?n nick ?u login ?h host ?s sound ?m comment))) + nil) + +(defun erc-play-sound (file) + "Play a sound file located in one of the directories in `erc-sound-path'. +See also `play-sound-file'." + (let ((filepath (erc-find-file file erc-sound-path))) + (if (and (not filepath) erc-default-sound) + (setq filepath erc-default-sound)) + (cond ((and filepath (file-exists-p filepath)) + (play-sound-file filepath)) + (t (beep))) + (erc-log (format "Playing sound file %S" filepath)))) + +(defun erc-toggle-sound (&optional arg) + "Toggles playing sounds on and off. With positive argument, + turns them on. With any other argument turns sounds off." + (interactive "P") + (cond ((and (numberp arg) (> arg 0)) + (setq erc-play-sound t)) + (arg (setq erc-play-sound nil)) + (t (setq erc-play-sound (not erc-play-sound)))) + (message "ERC sound is %s" (if erc-play-sound "ON" "OFF"))) + + +(provide 'erc-sound) + +;;; erc-sound.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 53657d1d-007f-4a20-91c1-588e71cf0cee diff --git a/lisp/erc-speak.el b/lisp/erc-speak.el new file mode 100644 index 0000000..d830f1e --- /dev/null +++ b/lisp/erc-speak.el @@ -0,0 +1,230 @@ +;;; erc-speak.el --- Speech-enable the ERC chat client + +;; Copyright 2001, 2002, 2003, 2004, 2007, +;; 2008 Free Software Foundation, Inc. + +;; 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 3, 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 file contains code to speech enable ERC using Emacspeak's functionality +;; to access a speech synthesizer. +;; +;; It tries to be intelligent and produce actually understandable +;; audio streams :). Hopefully it does. I use it on #debian at irc.debian.org +;; with about 200 users, and I am amazed how easy it works. +;; +;; Currently, erc-speak is only written to listen to channels. +;; There is no special functionality for interaction in the erc buffers. +;; Although this shouldn't be hard. Look at the Todo list, there are +;; definitely many things this script could do nicely to make a better +;; IRC experience for anyone. +;; +;; More info? Read the code. It isn't that complicated. +;; + +;;; Installation: + +;; Put erc.el and erc-speak.el somewhere in your load-path and +;; (require 'erc-speak) in your .emacs. Remember to require only erc-speak +;; because otherwise you get conflicts with emacspeak. + +;;; Bugs: + +;; erc-speak-rate doesn't seem to work here on outloud. Can anyone enlighten +;; me on the use of dtk-interp-queue-set-rate or equivalent? + +;;; Code: + +(require 'emacspeak) +(provide 'emacspeak-erc) +(require 'erc) +(require 'erc-button) + +(defgroup erc-speak nil + "Enable speech synthesis with the ERC chat client using Emacspeak" + :group 'erc) + +(defcustom erc-speak-personalities '((erc-default-face paul) + (erc-direct-msg-face paul-animated) + (erc-input-face paul-smooth) + (erc-bold-face paul-bold) + (erc-inverse-face betty) + (erc-underline-face ursula) + (erc-prompt-face harry) + (erc-notice-face paul-italic) + (erc-action-face paul-monotone) + (erc-error-face kid) + (erc-dangerous-host-face paul-surprized) + (erc-pal-face paul-animated) + (erc-fool-face paul-angry) + (erc-keyword-face paul-animated)) + "Maps faces used in erc to speaker personalities in emacspeak." + :group 'erc-speak + :type '(repeat + (list :tag "mapping" + (symbol :tag "face") + (symbol :tag "personality")))) + +(add-hook 'erc-mode-hook (lambda () (setq voice-lock-mode t))) + +;; Override the definition in erc.el +(defun erc-put-text-property (start end property value &optional object) + "This function sets the appropriate personality on the specified +region in addition to setting the requested face." + (put-text-property start end property value object) + (when (eq property 'face) + (put-text-property start end + 'personality + (cadr (assq value erc-speak-personalities)) + object))) + +(add-hook 'erc-insert-post-hook 'erc-speak-region) +(add-hook 'erc-send-post-hook 'erc-speak-region) + +(defcustom erc-speak-filter-host t + "Set to t if you want to filter out user@host constructs." + :group 'erc-speak + :type 'bool) + +(defcustom erc-speak-filter-timestamp t + "If non-nil, try to filter out the timestamp when speaking arriving messages. + +Note, your erc-timestamp-format variable needs to start with a [ +and end with ]." + :group 'erc-speak + :type 'bool) + +(defcustom erc-speak-acronyms '(("brb" "be right back") + ("btw" "by the way") + ("wtf" "what the fuck") + ("rotfl" "rolling on the floor and laughing") + ("afaik" "as far as I know") + ("afaics" "as far as I can see") + ("iirc" "if I remember correctly")) + "List of acronyms to expand." + :group 'erc-speak + :type '(repeat sexp)) + +(defun erc-speak-acronym-replace (string) + "Replace acronyms in the current buffer." + (let ((case-fold-search nil)) + (dolist (ac erc-speak-acronyms string) + (while (string-match (car ac) string) + (setq string (replace-match (cadr ac) nil t string)))))) + +(defcustom erc-speak-smileys '((":-)" "smiling face") + (":)" "smiling face") + (":-(" "sad face") + (":(" "sad face")) +;; please add more, send me patches, mlang@home.delysid.org tnx + "List of smileys and their textual description." + :group 'erc-speak + :type '(repeat (list 'symbol 'symbol))) + +(defcustom erc-speak-smiley-personality 'harry + "Personality used for smiley announcements." + :group 'erc-speak + :type 'symbol) + +(defun erc-speak-smiley-replace (string) + "Replace smileys with textual description." + (let ((case-fold-search nil)) + (dolist (smiley erc-speak-smileys string) + (while (string-match (car smiley) string) + (let ((repl (cadr smiley))) + (put-text-property 0 (length repl) 'personality + erc-speak-smiley-personality repl) + (setq string (replace-match repl nil t string))))))) + +(defcustom erc-speak-channel-personality 'harry + "*Personality to announce channel names with." + :group 'erc-speak + :type 'symbol) + +(defun erc-speak-region () + "Speak a region containing one IRC message using Emacspeak. +This function tries to translate common IRC forms into +intelligent speech." + (let ((target (if (erc-channel-p (erc-default-target)) + (erc-propertize + (erc-default-target) + 'personality erc-speak-channel-personality) + "")) + (dtk-stop-immediately nil)) + (emacspeak-auditory-icon 'progress) + (when erc-speak-filter-timestamp + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^\\[[a-zA-Z:,;.0-9 \t-]+\\]" nil t) + (narrow-to-region (point) (point-max))))) + (save-excursion + (goto-char (point-min)) + (cond ((re-search-forward (concat "^<\\([^>]+\\)> " + (concat "\\(" + erc-valid-nick-regexp + "\\)[;,:]")) nil t) + (let ((from (match-string 1)) + (to (match-string 2)) + (text (buffer-substring (match-end 2) (point-max)))) + (tts-with-punctuations + "some" + (dtk-speak (concat (erc-propertize + (concat target " " from " to " to) + 'personality erc-speak-channel-personality) + (erc-speak-smiley-replace + (erc-speak-acronym-replace text))))))) + ((re-search-forward "^<\\([^>]+\\)> " nil t) + (let ((from (match-string 1)) + (msg (buffer-substring (match-end 0) (point-max)))) + (tts-with-punctuations + "some" + (dtk-speak (concat target " " from " " + (erc-speak-smiley-replace + (erc-speak-acronym-replace msg))))))) + ((re-search-forward (concat "^" (regexp-quote erc-notice-prefix) + "\\(.+\\)") + (point-max) t) + (let ((notice (buffer-substring (match-beginning 1) (point-max)))) + (tts-with-punctuations + "all" + (dtk-speak + (with-temp-buffer + (insert notice) + (when erc-speak-filter-host + (goto-char (point-min)) + (when (re-search-forward "([^)@]+@[^)@]+)" nil t) + (replace-match ""))) + (buffer-string)))))) + (t (let ((msg (buffer-substring (point-min) (point-max)))) + (tts-with-punctuations + "some" + (dtk-speak (concat target " " + (erc-speak-smiley-replace + (erc-speak-acronym-replace msg))))))))))) + +(provide 'erc-speak) + +;;; erc-speak.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 4499cd13-2829-43b8-83de-d313481531c4 diff --git a/lisp/erc-speedbar.el b/lisp/erc-speedbar.el new file mode 100644 index 0000000..cc8a085 --- /dev/null +++ b/lisp/erc-speedbar.el @@ -0,0 +1,371 @@ +;;; erc-speedbar.el --- Speedbar support for ERC + +;; Copyright (C) 2001, 2002, 2003, 2004, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Contributor: Eric M. Ludlam + +;; 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 3, 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 module provides integration of ERC into the Speedbar. + +;;; TODO / ideas: + +;; * Write intelligent update function: +;; update-channel, update-nick, remove-nick-from-channel, ... +;; * Use indicator-strings for op/voice +;; * Extract/convert face notes field from bbdb if available and show +;; it using sb-image.el +;; +;;; Code: + +(require 'erc) +(require 'speedbar) +(condition-case nil (require 'dframe) (error nil)) +(eval-when-compile (require 'cl)) + +;;; Customization: + +(defgroup erc-speedbar nil + "Integration of ERC in the Speedbar" + :group 'erc) + +(defcustom erc-speedbar-sort-users-type 'activity + "How channel nicknames are sorted. + +'activity - Sort users by channel activity +'alphabetical - Sort users alphabetically +nil - Do not sort users" + :group 'erc-speedbar + :type '(choice (const :tag "Sort users by channel activity" activity) + (const :tag "Sort users alphabetically" alphabetical) + (const :tag "Do not sort users" nil))) + +(defvar erc-speedbar-key-map nil + "Keymap used when in erc display mode.") + +(defun erc-install-speedbar-variables () + "Install those variables used by speedbar to enhance ERC." + (if erc-speedbar-key-map + nil + (setq erc-speedbar-key-map (speedbar-make-specialized-keymap)) + + ;; Basic tree features + (define-key erc-speedbar-key-map "e" 'speedbar-edit-line) + (define-key erc-speedbar-key-map "\C-m" 'speedbar-edit-line) + (define-key erc-speedbar-key-map "+" 'speedbar-expand-line) + (define-key erc-speedbar-key-map "=" 'speedbar-expand-line) + (define-key erc-speedbar-key-map "-" 'speedbar-contract-line)) + + (speedbar-add-expansion-list '("ERC" erc-speedbar-menu-items + erc-speedbar-key-map + erc-speedbar-server-buttons)) + (speedbar-add-mode-functions-list + '("ERC" (speedbar-item-info . erc-speedbar-item-info)))) + +(defvar erc-speedbar-menu-items + '(["Goto buffer" speedbar-edit-line t] + ["Expand Node" speedbar-expand-line + (save-excursion (beginning-of-line) + (looking-at "[0-9]+: *.\\+. "))] + ["Contract Node" speedbar-contract-line + (save-excursion (beginning-of-line) + (looking-at "[0-9]+: *.-. "))]) + "Additional menu-items to add to speedbar frame.") + +;; Make sure our special speedbar major mode is loaded +(if (featurep 'speedbar) + (erc-install-speedbar-variables) + (add-hook 'speedbar-load-hook 'erc-install-speedbar-variables)) + +;;; ERC hierarchy display method +;;;###autoload +(defun erc-speedbar-browser () + "Initialize speedbar to display an ERC browser. +This will add a speedbar major display mode." + (interactive) + (require 'speedbar) + ;; Make sure that speedbar is active + (speedbar-frame-mode 1) + ;; Now, throw us into Info mode on speedbar. + (speedbar-change-initial-expansion-list "ERC") + (speedbar-get-focus)) + +(defun erc-speedbar-buttons (buffer) + "Create buttons for speedbar in BUFFER." + (erase-buffer) + (let (serverp chanp queryp) + (with-current-buffer buffer + (setq serverp (erc-server-buffer-p)) + (setq chanp (erc-channel-p (erc-default-target))) + (setq queryp (erc-query-buffer-p))) + (cond (serverp + (erc-speedbar-channel-buttons nil 0 buffer)) + (chanp + (erc-speedbar-insert-target buffer 0) + (forward-line -1) + (erc-speedbar-expand-channel "+" buffer 0)) + (queryp + (erc-speedbar-insert-target buffer 0)) + (t (ignore))))) + +(defun erc-speedbar-server-buttons (directory depth) + "Insert the initial list of servers you are connected to." + (let ((servers (erc-buffer-list + (lambda () + (eq (current-buffer) + (process-buffer erc-server-process)))))) + (when servers + (speedbar-with-writable + (dolist (server servers) + (speedbar-make-tag-line + 'bracket ?+ 'erc-speedbar-expand-server server + (buffer-name server) 'erc-speedbar-goto-buffer server nil + depth)) + t)))) + +(defun erc-speedbar-expand-server (text server indent) + (cond ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (if (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (erc-speedbar-channel-buttons nil (1+ indent) server))) + (speedbar-change-expand-button-char ?-) + (speedbar-change-expand-button-char ??))) + ((string-match "-" text) ;we have to contract this node + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)) + (t (error "Ooops... not sure what to do"))) + (speedbar-center-buffer-smartly)) + +(defun erc-speedbar-channel-buttons (directory depth server-buffer) + (when (get-buffer server-buffer) + (let* ((proc (with-current-buffer server-buffer erc-server-process)) + (targets (erc-buffer-list + (lambda () + (not (eq (process-buffer erc-server-process) + (current-buffer)))) + proc))) + (when targets + (speedbar-with-writable + (dolist (target targets) + (erc-speedbar-insert-target target depth)) + t))))) + +(defun erc-speedbar-insert-target (buffer depth) + (if (with-current-buffer buffer + (erc-channel-p (erc-default-target))) + (speedbar-make-tag-line + 'bracket ?+ 'erc-speedbar-expand-channel buffer + (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil + depth) + ;; Query target + (speedbar-make-tag-line + nil nil nil nil + (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil + depth))) + +(defun erc-speedbar-expand-channel (text channel indent) + "For the line matching TEXT, in CHANNEL, expand or contract a line. +INDENT is the current indentation level." + (cond + ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (let ((modes (with-current-buffer channel + (concat (apply 'concat + erc-channel-modes) + (cond + ((and erc-channel-user-limit + erc-channel-key) + (if erc-show-channel-key-p + (format "lk %.0f %s" + erc-channel-user-limit + erc-channel-key) + (format "kl %.0f" erc-channel-user-limit))) + (erc-channel-user-limit + ;; Emacs has no bignums + (format "l %.0f" erc-channel-user-limit)) + (erc-channel-key + (if erc-show-channel-key-p + (format "k %s" erc-channel-key) + "k")) + (t ""))))) + (topic (erc-controls-interpret + (with-current-buffer channel erc-channel-topic)))) + (speedbar-make-tag-line + 'angle ?i nil nil + (concat "Modes: +" modes) nil nil nil + (1+ indent)) + (unless (string= topic "") + (speedbar-make-tag-line + 'angle ?i nil nil + (concat "Topic: " topic) nil nil nil + (1+ indent))) + (let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical) + (erc-sort-channel-users-alphabetically + (with-current-buffer channel + (erc-get-channel-user-list)))) + ((eq erc-speedbar-sort-users-type 'activity) + (erc-sort-channel-users-by-activity + (with-current-buffer channel + (erc-get-channel-user-list)))) + (t (with-current-buffer channel + (erc-get-channel-user-list)))))) + (when names + (speedbar-with-writable + (dolist (entry names) + (erc-speedbar-insert-user entry ?+ (1+ indent)))))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)) + (t (error "Ooops... not sure what to do"))) + (speedbar-center-buffer-smartly)) + +(defun erc-speedbar-insert-user (entry exp-char indent) + "Insert one user based on the channel member list ENTRY. +EXP-CHAR is the expansion character to use. +INDENT is the current indentation level." + (let* ((user (car entry)) + (cuser (cdr entry)) + (nick (erc-server-user-nickname user)) + (host (erc-server-user-host user)) + (info (erc-server-user-info user)) + (login (erc-server-user-login user)) + (name (erc-server-user-full-name user)) + (voice (and cuser (erc-channel-user-voice cuser))) + (op (and cuser (erc-channel-user-op cuser))) + (nick-str (concat (if op "@" "") (if voice "+" "") nick)) + (finger (concat login (when (or login host) "@") host)) + (sbtoken (list finger name info))) + (if (or login host name info) ; we want to be expandable + (speedbar-make-tag-line + 'bracket ?+ 'erc-speedbar-expand-user sbtoken + nick-str nil sbtoken nil + indent) + (when (equal exp-char ?-) + (forward-line -1) + (erc-speedbar-expand-user "+" (list finger name info) indent)) + (speedbar-make-tag-line + 'statictag ?? nil nil + nick-str nil nil nil + indent)))) + +(defun erc-speedbar-update-channel (buffer) + "Update the speedbar information about a ERC buffer. The update +is only done when the channel is actually expanded already." + ;; This is only a rude hack and doesn't care about multiserver usage + ;; yet, consider this a brain storming, better ideas? + (with-current-buffer speedbar-buffer + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "^1: *.+. *" + (regexp-quote (buffer-name buffer))) + nil t) + (beginning-of-line) + (speedbar-delete-subblock 1) + (erc-speedbar-expand-channel "+" buffer 1))))) + +(defun erc-speedbar-expand-user (text token indent) + (cond ((string-match "+" text) + (speedbar-change-expand-button-char ?-) + (speedbar-with-writable + (save-excursion + (end-of-line) (forward-char 1) + (let ((finger (nth 0 token)) + (name (nth 1 token)) + (info (nth 2 token))) + (when finger + (speedbar-make-tag-line + nil nil nil nil + finger nil nil nil + (1+ indent))) + (when name + (speedbar-make-tag-line + nil nil nil nil + name nil nil nil + (1+ indent))) + (when info + (speedbar-make-tag-line + nil nil nil nil + info nil nil nil + (1+ indent))))))) + ((string-match "-" text) + (speedbar-change-expand-button-char ?+) + (speedbar-delete-subblock indent)) + (t (error "Ooops... not sure what to do"))) + (speedbar-center-buffer-smartly)) + +(defun erc-speedbar-goto-buffer (text buffer indent) + "When user clicks on TEXT, goto an ERC buffer. +The INDENT level is ignored." + (if (featurep 'dframe) + (progn + (dframe-select-attached-frame speedbar-frame) + (let ((bwin (get-buffer-window buffer 0))) + (if bwin + (progn + (select-window bwin) + (raise-frame (window-frame bwin))) + (if dframe-power-click + (let ((pop-up-frames t)) + (select-window (display-buffer buffer))) + (dframe-select-attached-frame speedbar-frame) + (switch-to-buffer buffer))))) + (let ((bwin (get-buffer-window buffer 0))) + (if bwin + (progn + (select-window bwin) + (raise-frame (window-frame bwin))) + (if speedbar-power-click + (let ((pop-up-frames t)) (select-window (display-buffer buffer))) + (dframe-select-attached-frame speedbar-frame) + (switch-to-buffer buffer)))))) + +(defun erc-speedbar-line-text () + "Return the text for the item on the current line." + (beginning-of-line) + (when (re-search-forward "[]>] " nil t) + (buffer-substring-no-properties (point) (point-at-eol)))) + +(defun erc-speedbar-item-info () + "Display information about the current buffer on the current line." + (let ((data (speedbar-line-token)) + (txt (erc-speedbar-line-text))) + (cond ((and data (listp data)) + (message "%s: %s" txt (car data))) + ((bufferp data) + (message "Channel: %s" txt)) + (t + (message "%s" txt))))) + +(provide 'erc-speedbar) +;;; erc-speedbar.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 7a6558a4-3308-4bf5-a284-e1d042c933c6 diff --git a/lisp/erc-spelling.el b/lisp/erc-spelling.el new file mode 100644 index 0000000..55cb213 --- /dev/null +++ b/lisp/erc-spelling.el @@ -0,0 +1,112 @@ +;;; erc-spelling.el --- use flyspell in ERC + +;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Jorgen Schaefer +;; Keywords: irc +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcSpelling + +;; 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 3, 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 is an ERC module to enable flyspell mode in ERC buffers. This +;; ensures correct behavior of flyspell, and even sets up a +;; channel-local dictionary if so required. + +;;; Code: + +(require 'erc) +(require 'flyspell) + +;;;###autoload (autoload 'erc-spelling-mode "erc-spelling" nil t) +(define-erc-module spelling nil + "Enable flyspell mode in ERC buffers." + ;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is + ;; called AFTER the server buffer is initialized. + ((add-hook 'erc-connect-pre-hook 'erc-spelling-init) + (dolist (buffer (erc-buffer-list)) + (erc-spelling-init buffer))) + ((remove-hook 'erc-connect-pre-hook 'erc-spelling-init) + (dolist (buffer (erc-buffer-list)) + (with-current-buffer buffer (flyspell-mode 0))))) + +(defcustom erc-spelling-dictionaries nil + "An alist mapping buffer names to dictionaries. +The `car' of every cell is a buffer name, the `cadr' is the +string name of an associated dictionary. +The dictionary is inherited from server buffers, so if you want a +default dictionary for some server, you can use a server buffer +name here." + :type '(choice (const nil) + (repeat (cons (string :tag "Buffer name") + (string :tag "Dictionary")))) + :group 'erc-spelling) + +(defun erc-spelling-init (buffer) + "Enable flyspell mode in an ERC buffer. +The current buffer is given by BUFFER." + (with-current-buffer buffer + (let ((name (downcase (buffer-name))) + (dicts erc-spelling-dictionaries)) + (when dicts + (while (and dicts + (not (string= name (downcase (caar dicts))))) + (setq dicts (cdr dicts))) + (setq ispell-local-dictionary + (if dicts + (cadr (car dicts)) + (erc-with-server-buffer ispell-local-dictionary))))) + (setq flyspell-generic-check-word-p 'erc-spelling-flyspell-verify) + (flyspell-mode 1))) + +(defun erc-spelling-unhighlight-word (word) + "Unhighlight the given WORD. +The cadr is the beginning and the caddr is the end." + (let ((beg (nth 1 word)) + (end (nth 2 word))) + (flyspell-unhighlight-at beg) + (when (> end beg) + (flyspell-unhighlight-at (1- end))))) + +(defun erc-spelling-flyspell-verify () + "Flyspell only the input line, nothing else." + (let ((word-data (and (boundp 'flyspell-word) + flyspell-word))) + (when word-data + (cond ((< (point) erc-input-marker) + nil) + ;; don't spell-check names of users + ((and erc-channel-users + (erc-get-channel-user (car word-data))) + (erc-spelling-unhighlight-word word-data) + nil) + ;; if '/' occurs before the word, don't spell-check it + ((eq (char-before (nth 1 word-data)) ?/) + (erc-spelling-unhighlight-word word-data) + nil) + (t t))))) + +(put 'erc-mode + 'flyspell-mode-predicate + 'erc-spelling-flyspell-verify) + +(provide 'erc-spelling) + +;; arch-tag: 04ae1c46-0fd1-4e1a-8b80-55bfa471c945 +;;; erc-spelling.el ends here diff --git a/lisp/erc-stamp.el b/lisp/erc-stamp.el new file mode 100644 index 0000000..d3a05ee --- /dev/null +++ b/lisp/erc-stamp.el @@ -0,0 +1,427 @@ +;;; erc-stamp.el --- Timestamping for ERC messages + +;; Copyright (C) 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm, processes, timestamp +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcStamp + +;; 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 3, 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: + +;; The code contained in this module is responsible for inserting +;; timestamps into ERC buffers. In order to actually activate this, +;; you must call `erc-timestamp-mode'. + +;; You can choose between two different ways of inserting timestamps. +;; Customize `erc-insert-timestamp-function' and +;; `erc-insert-away-timestamp-function'. + +;;; Code: + +(require 'erc) +(require 'erc-compat) + +(defgroup erc-stamp nil + "For long conversation on IRC it is sometimes quite +useful to have individual messages timestamp. This +group provides settings related to the format and display +of timestamp information in `erc-mode' buffer. + +For timestamping to be activated, you just need to load `erc-stamp' +in your .emacs file or interactively using `load-library'." + :group 'erc) + +(defcustom erc-timestamp-format "[%H:%M]" + "*If set to a string, messages will be timestamped. +This string is processed using `format-time-string'. +Good examples are \"%T\" and \"%H:%M\". + +If nil, timestamping is turned off." + :group 'erc-stamp + :type '(choice (const nil) + (string))) + +(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" + "*If set to a string, messages will be timestamped. +This string is processed using `format-time-string'. +Good examples are \"%T\" and \"%H:%M\". + +This timestamp is used for timestamps on the left side of the +screen when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. + +If nil, timestamping is turned off." + :group 'erc-stamp + :type '(choice (const nil) + (string))) + +(defcustom erc-timestamp-format-right " [%H:%M]" + "*If set to a string, messages will be timestamped. +This string is processed using `format-time-string'. +Good examples are \"%T\" and \"%H:%M\". + +This timestamp is used for timestamps on the right side of the +screen when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. + +If nil, timestamping is turned off." + :group 'erc-stamp + :type '(choice (const nil) + (string))) + +(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right + "*Function to use to insert timestamps. + +It takes a single argument STRING which is the final string +which all text-properties already appended. This function only cares about +inserting this string at the right position. Narrowing is in effect +while it is called, so (point-min) and (point-max) determine the region to +operate on. + +You will probably want to set +`erc-insert-away-timestamp-function' to the same value." + :group 'erc-stamp + :type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right) + (const :tag "Right" erc-insert-timestamp-right) + (const :tag "Left" erc-insert-timestamp-left) + function)) + +(defcustom erc-away-timestamp-format "<%H:%M>" + "*Timestamp format used when marked as being away. + +If nil, timestamping is turned off when away unless `erc-timestamp-format' +is set. + +If `erc-timestamp-format' is set, this will not be used." + :group 'erc-stamp + :type '(choice (const nil) + (string))) + +(defcustom erc-insert-away-timestamp-function + 'erc-insert-timestamp-left-and-right + "*Function to use to insert the away timestamp. + +See `erc-insert-timestamp-function' for details." + :group 'erc-stamp + :type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right) + (const :tag "Right" erc-insert-timestamp-right) + (const :tag "Left" erc-insert-timestamp-left) + function)) + +(defcustom erc-hide-timestamps nil + "*If non-nil, timestamps will be invisible. + +This is useful for logging, because, although timestamps will be +hidden, they will still be present in the logs." + :group 'erc-stamp + :type 'boolean) + +(defcustom erc-echo-timestamps nil + "*If non-nil, print timestamp in the minibuffer when point is moved. +Using this variable, you can turn off normal timestamping, +and simply move point to an irc message to see its timestamp +printed in the minibuffer." + :group 'erc-stamp + :type 'boolean) + +(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S" + "*Format string to be used when `erc-echo-timestamps' is non-nil. +This string specifies the format of the timestamp being echoed in +the minibuffer." + :group 'erc-stamp + :type 'string) + +(defcustom erc-timestamp-intangible t + "*Whether the timestamps should be intangible, i.e. prevent the point +from entering them and instead jump over them." + :group 'erc-stamp + :type 'boolean) + +(defface erc-timestamp-face '((t (:bold t :foreground "green"))) + "ERC timestamp face." + :group 'erc-faces) + +;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t) +(define-erc-module stamp timestamp + "This mode timestamps messages in the channel buffers." + ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec) + (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t) + (add-hook 'erc-send-modify-hook 'erc-add-timestamp t)) + ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec) + (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp) + (remove-hook 'erc-send-modify-hook 'erc-add-timestamp))) + +(defun erc-add-timestamp () + "Add timestamp and text-properties to message. + +This function is meant to be called from `erc-insert-modify-hook' +or `erc-send-modify-hook'." + (unless (get-text-property (point) 'invisible) + (let ((ct (current-time))) + (if (fboundp erc-insert-timestamp-function) + (funcall erc-insert-timestamp-function + (erc-format-timestamp ct erc-timestamp-format)) + (error "Timestamp function unbound")) + (when (and (fboundp erc-insert-away-timestamp-function) + erc-away-timestamp-format + (erc-away-time) + (not erc-timestamp-format)) + (funcall erc-insert-away-timestamp-function + (erc-format-timestamp ct erc-away-timestamp-format))) + (add-text-properties (point-min) (point-max) + (list 'timestamp ct)) + (add-text-properties (point-min) (point-max) + (list 'point-entered 'erc-echo-timestamp))))) + +(defvar erc-timestamp-last-inserted nil + "Last timestamp inserted into the buffer.") +(make-variable-buffer-local 'erc-timestamp-last-inserted) + +(defvar erc-timestamp-last-inserted-left nil + "Last timestamp inserted into the left side of the buffer. +This is used when `erc-insert-timestamp-function' is set to +`erc-timestamp-left-and-right'") +(make-variable-buffer-local 'erc-timestamp-last-inserted-left) + +(defvar erc-timestamp-last-inserted-right nil + "Last timestamp inserted into the right side of the buffer. +This is used when `erc-insert-timestamp-function' is set to +`erc-timestamp-left-and-right'") +(make-variable-buffer-local 'erc-timestamp-last-inserted-right) + +(defcustom erc-timestamp-only-if-changed-flag t + "*Insert timestamp only if its value changed since last insertion. +If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a +string of spaces which is the same size as the timestamp is added to +the beginning of the line in its place. If you use +`erc-insert-timestamp-right', nothing gets inserted in place of the +timestamp." + :group 'erc-stamp + :type 'boolean) + +(defcustom erc-timestamp-right-column nil + "*If non-nil, the column at which the timestamp is inserted, +if the timestamp is to be printed to the right. If nil, +`erc-insert-timestamp-right' will use other means to determine +the correct column." + :group 'erc-stamp + :type '(choice + (integer :tag "Column number") + (const :tag "Unspecified" nil))) + +(defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs)) + (>= emacs-major-version 22) + (eq window-system 'x)) + "*If non-nil, use the :align-to display property to align the stamp. +This gives better results when variable-width characters (like +Asian language characters and math symbols) precede a timestamp. +Unfortunately, it only works in Emacs 22 and when using the X +Window System. + +A side effect of enabling this is that there will only be one +space before a right timestamp in any saved logs." + :group 'erc-stamp + :type 'boolean) + +(defun erc-insert-timestamp-left (string) + "Insert timestamps at the beginning of the line." + (goto-char (point-min)) + (let* ((ignore-p (and erc-timestamp-only-if-changed-flag + (string-equal string erc-timestamp-last-inserted))) + (len (length string)) + (s (if ignore-p (make-string len ? ) string))) + (unless ignore-p (setq erc-timestamp-last-inserted string)) + (erc-put-text-property 0 len 'field 'erc-timestamp s) + (erc-put-text-property 0 len 'invisible 'timestamp s) + (insert s))) + +(defun erc-insert-aligned (string pos) + "Insert STRING at the POSth column. + +If `erc-timestamp-use-align-to' is t, use the :align-to display +property to get to the POSth column." + (if (not erc-timestamp-use-align-to) + (indent-to pos) + (insert " ") + (put-text-property (1- (point)) (point) 'display + (list 'space ':align-to pos))) + (insert string)) + +;; Silence byte-compiler +(eval-when-compile + (defvar erc-fill-column)) + +(defun erc-insert-timestamp-right (string) + "Insert timestamp on the right side of the screen. +STRING is the timestamp to insert. The function is a possible value +for `erc-insert-timestamp-function'. + +If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always +printed. If this variable is non-nil, a timestamp is only printed if +it is different from the last. + +If `erc-timestamp-right-column' is set, its value will be used as the +column at which the timestamp is to be printed. If it is nil, and +`erc-fill-mode' is active, then the timestamp will be printed just +before `erc-fill-column'. Otherwise, if the current buffer is +shown in a window, that window's width is used. If the buffer is +not shown, and `fill-column' is set, then the timestamp will be +printed just `fill-column'. As a last resort, the timestamp will +be printed just before the window-width." + (unless (and erc-timestamp-only-if-changed-flag + (string-equal string erc-timestamp-last-inserted)) + (setq erc-timestamp-last-inserted string) + (goto-char (point-max)) + (forward-char -1);; before the last newline + (let* ((current-window (get-buffer-window (current-buffer))) + (str-width (string-width string)) + (pos (cond + (erc-timestamp-right-column erc-timestamp-right-column) + ((and (boundp 'erc-fill-mode) + erc-fill-mode + (boundp 'erc-fill-column) + erc-fill-column) + (1+ (- erc-fill-column str-width))) + (fill-column + (1+ (- fill-column str-width))) + (t + (- (window-width) str-width 1)))) + (from (point)) + (col (current-column)) + indent) + ;; The following is a kludge used to calculate whether to move + ;; to the next line before inserting a stamp. It allows for + ;; some margin of error if what is displayed on the line differs + ;; from the number of characters on the line. + (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6)))) + (if (< col pos) + (erc-insert-aligned string pos) + (newline) + (indent-to pos) + (setq from (point)) + (insert string)) + (erc-put-text-property from (point) 'field 'erc-timestamp) + (erc-put-text-property from (point) 'rear-nonsticky t) + (when erc-timestamp-intangible + (erc-put-text-property from (1+ (point)) 'intangible t))))) + +(defun erc-insert-timestamp-left-and-right (string) + "This is another function that can be assigned to +`erc-insert-timestamp-function'. If the date is changed, it will +print a blank line, the date, and another blank line. If the time is +changed, it will then print it off to the right." + (let* ((ct (current-time)) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + (ts-right (erc-format-timestamp ct erc-timestamp-format-right))) + ;; insert left timestamp + (unless (string-equal ts-left erc-timestamp-last-inserted-left) + (goto-char (point-min)) + (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) + (insert ts-left) + (setq erc-timestamp-last-inserted-left ts-left)) + ;; insert right timestamp + (let ((erc-timestamp-only-if-changed-flag t) + (erc-timestamp-last-inserted erc-timestamp-last-inserted-right)) + (erc-insert-timestamp-right ts-right) + (setq erc-timestamp-last-inserted-right ts-right)))) + +;; for testing: (setq erc-timestamp-only-if-changed-flag nil) + +(defun erc-format-timestamp (time format) + "Return TIME formatted as string according to FORMAT. +Return the empty string if FORMAT is nil." + (if format + (let ((ts (format-time-string format time))) + (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts) + (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) + (erc-put-text-property 0 (length ts) + 'isearch-open-invisible 'timestamp ts) + ;; N.B. Later use categories instead of this harmless, but + ;; inelegant, hack. -- BPT + (when erc-timestamp-intangible + (erc-put-text-property 0 (length ts) 'intangible t ts)) + ts) + "")) + +;; This function is used to munge `buffer-invisibility-spec to an +;; appropriate value. Currently, it only handles timestamps, thus its +;; location. If you add other features which affect invisibility, +;; please modify this function and move it to a more appropriate +;; location. +(defun erc-munge-invisibility-spec () + (if erc-hide-timestamps + (setq buffer-invisibility-spec + (if (listp buffer-invisibility-spec) + (cons 'timestamp buffer-invisibility-spec) + (list 't 'timestamp))) + (setq buffer-invisibility-spec + (if (listp buffer-invisibility-spec) + (remove 'timestamp buffer-invisibility-spec) + (list 't))))) + +(defun erc-hide-timestamps () + "Hide timestamp information from display." + (interactive) + (setq erc-hide-timestamps t) + (erc-munge-invisibility-spec)) + +(defun erc-show-timestamps () + "Show timestamp information on display. +This function only works if `erc-timestamp-format' was previously +set, and timestamping is already active." + (interactive) + (setq erc-hide-timestamps nil) + (erc-munge-invisibility-spec)) + +(defun erc-toggle-timestamps () + "Hide or show timestamps in ERC buffers. + +Note that timestamps can only be shown for a message using this +function if `erc-timestamp-format' was set and timestamping was +enabled when the message was inserted." + (interactive) + (if erc-hide-timestamps + (setq erc-hide-timestamps nil) + (setq erc-hide-timestamps t)) + (mapc (lambda (buffer) + (with-current-buffer buffer + (erc-munge-invisibility-spec))) + (erc-buffer-list))) + +(defun erc-echo-timestamp (before now) + "Print timestamp text-property of an IRC message. +Argument BEFORE is where point was before it got moved and +NOW is position of point currently." + (when erc-echo-timestamps + (let ((stamp (get-text-property now 'timestamp))) + (when stamp + (message "%s" (format-time-string erc-echo-timestamp-format + stamp)))))) + +(provide 'erc-stamp) + +;;; erc-stamp.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 57aefab4-63e0-4c48-91d5-6efa145487e0 diff --git a/lisp/erc-track.el b/lisp/erc-track.el new file mode 100644 index 0000000..360d92c --- /dev/null +++ b/lisp/erc-track.el @@ -0,0 +1,1074 @@ +;;; erc-track.el --- Track modified channel buffers + +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm, faces +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking + +;; 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 3, 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: + +;; Highlights keywords and pals (friends), and hides or highlights fools +;; (using a dark color). Add to your ~/.emacs: + +;; (require 'erc-track) +;; (erc-track-mode 1) + +;; Todo: +;; * Add extensibility so that custom functions can track +;; custom modification types. + +(eval-when-compile (require 'cl)) +(require 'erc) +(require 'erc-compat) +(require 'erc-match) + +;;; Code: + +(defgroup erc-track nil + "Track active buffers and show activity in the modeline." + :group 'erc) + +(defcustom erc-track-enable-keybindings 'ask + "Whether to enable the ERC track keybindings, namely: +`C-c C-SPC' and `C-c C-@', which both do the same thing. + +The default is to check to see whether these keys are used +already: if not, then enable the ERC track minor mode, which +provides these keys. Otherwise, do not touch the keys. + +This can alternatively be set to either t or nil, which indicate +respectively always to enable ERC track minor mode or never to +enable ERC track minor mode. + +The reason for using this default value is to both (1) adhere to +the Emacs development guidelines which say not to touch keys of +the form C-c C- and also (2) to meet the expectations +of long-time ERC users, many of whom rely on these keybindings." + :group 'erc-track + :type '(choice (const :tag "Ask, if used already" ask) + (const :tag "Enable" t) + (const :tag "Disable" nil))) + +(defcustom erc-track-visibility t + "Where do we look for buffers to determine their visibility? +The value of this variable determines, when a buffer is considered +visible or invisible. New messages in invisible buffers are tracked, +while switching to visible buffers when they are tracked removes them +from the list. See also `erc-track-when-inactive'. + +Possible values are: + +t - all frames +visible - all visible frames +nil - only the selected frame +selected-visible - only the selected frame if it is visible + +Activity means that there was no user input in the last 10 seconds." + :group 'erc-track + :type '(choice (const :tag "All frames" t) + (const :tag "All visible frames" visible) + (const :tag "Only the selected frame" nil) + (const :tag "Only the selected frame if it was active" + active))) + +(defcustom erc-track-exclude nil + "A list targets (channel names or query targets) which should not be tracked." + :group 'erc-track + :type '(repeat string)) + +(defcustom erc-track-remove-disconnected-buffers nil + "*If true, remove buffers associated with a server that is +disconnected from `erc-modified-channels-alist'." + :group 'erc-track + :type 'boolean) + +(defcustom erc-track-exclude-types '("NICK" "333" "353") + "*List of message types to be ignored. +This list could look like '(\"JOIN\" \"PART\"). + +By default, exclude changes of nicknames (NICK), display of who +set the channel topic (333), and listing of users on the current +channel (353)." + :group 'erc-track + :type 'erc-message-type) + +(defcustom erc-track-exclude-server-buffer nil + "*If true, don't perform tracking on the server buffer; this is +useful for excluding all the things like MOTDs from the server and +other miscellaneous functions." + :group 'erc-track + :type 'boolean) + +(defcustom erc-track-shorten-start 1 + "This number specifies the minimum number of characters a channel name in +the mode-line should be reduced to." + :group 'erc-track + :type 'number) + +(defcustom erc-track-shorten-cutoff 4 + "All channel names longer than this value will be shortened." + :group 'erc-track + :type 'number) + +(defcustom erc-track-shorten-aggressively nil + "*If non-nil, channel names will be shortened more aggressively. +Usually, names are not shortened if this will save only one character. +Example: If there are two channels, #linux-de and #linux-fr, then +normally these will not be shortened. When shortening aggressively, +however, these will be shortened to #linux-d and #linux-f. + +If this variable is set to `max', then channel names will be shortened +to the max. Usually, shortened channel names will remain unique for a +given set of existing channels. When shortening to the max, the shortened +channel names will be unique for the set of active channels only. +Example: If there are two active channels #emacs and #vi, and two inactive +channels #electronica and #folk, then usually the active channels are +shortened to #em and #v. When shortening to the max, however, #emacs is +not compared to #electronica -- only to #vi, therefore it can be shortened +even more and the result is #e and #v. + +This setting is used by `erc-track-shorten-names'." + :group 'erc-track + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Max" max))) + +(defcustom erc-track-shorten-function 'erc-track-shorten-names + "*This function will be used to reduce the channel names before display. +It takes one argument, CHANNEL-NAMES which is a list of strings. +It should return a list of strings of the same number of elements. +If nil instead of a function, shortening is disabled." + :group 'erc-track + :type '(choice (const :tag "Disabled") + function)) + +(defcustom erc-track-list-changed-hook nil + "Hook that is run whenever the contents of +`erc-modified-channels-alist' changes. + +This is useful for people that don't use the default mode-line +notification but instead use a separate mechanism to provide +notification of channel activity." + :group 'erc-track + :type 'hook) + +(defcustom erc-track-use-faces t + "*Use faces in the mode-line. +The faces used are the same as used for text in the buffers. +\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)" + :group 'erc-track + :type 'boolean) + +(defcustom erc-track-faces-priority-list + '(erc-error-face + (erc-nick-default-face erc-current-nick-face) + erc-current-nick-face + erc-keyword-face + (erc-nick-default-face erc-pal-face) + erc-pal-face + erc-nick-msg-face + erc-direct-msg-face + (erc-button erc-default-face) + (erc-nick-default-face erc-dangerous-host-face) + erc-dangerous-host-face + erc-nick-default-face + (erc-nick-default-face erc-default-face) + erc-default-face + erc-action-face + (erc-nick-default-face erc-fool-face) + erc-fool-face + erc-notice-face + erc-input-face + erc-prompt-face) + "A list of faces used to highlight active buffer names in the modeline. +If a message contains one of the faces in this list, the buffer name will +be highlighted using that face. The first matching face is used." + :group 'erc-track + :type '(repeat (choice face + (repeat :tag "Combination" face)))) + +(defcustom erc-track-priority-faces-only nil + "Only track text highlighted with a priority face. +If you would like to ignore changes in certain channels where there +are no faces corresponding to your `erc-track-faces-priority-list', set +this variable. You can set a list of channel name strings, so those +will be ignored while all other channels will be tracked as normal. +Other options are 'all, to apply this to all channels or nil, to disable +this feature. + +Note: If you have a lot of faces listed in `erc-track-faces-priority-list', +setting this variable might not be very useful." + :group 'erc-track + :type '(choice (const nil) + (repeat string) + (const all))) + +(defcustom erc-track-faces-normal-list + '((erc-button erc-default-face) + (erc-nick-default-face erc-dangerous-host-face) + erc-dangerous-host-face + erc-nick-default-face + (erc-nick-default-face erc-default-face) + erc-default-face + erc-action-face) + "A list of faces considered to be part of normal conversations. +This list is used to highlight active buffer names in the modeline. + +If a message contains one of the faces in this list, and the +previous modeline face for this buffer is also in this list, then +the buffer name will be highlighted using the face from the +message. This gives a rough indication that active conversations +are occurring in these channels. + +The effect may be disabled by setting this variable to nil." + :group 'erc-track + :type '(repeat (choice face + (repeat :tag "Combination" face)))) + +(defcustom erc-track-position-in-mode-line 'before-modes + "Where to show modified channel information in the mode-line. + +Setting this variable only has effects in GNU Emacs versions above 21.3. + +Choices are: +'before-modes - add to the beginning of `mode-line-modes', +'after-modes - add to the end of `mode-line-modes', +t - add to the end of `global-mode-string', +nil - don't add to mode line." + :group 'erc-track + :type '(choice (const :tag "Just before mode information" before-modes) + (const :tag "Just after mode information" after-modes) + (const :tag "After all other information" t) + (const :tag "Don't display in mode line" nil)) + :set (lambda (sym val) + (set sym val) + (when (and (boundp 'erc-track-mode) + erc-track-mode) + (erc-track-remove-from-mode-line) + (erc-track-add-to-mode-line val)))) + +(defun erc-modified-channels-object (strings) + "Generate a new `erc-modified-channels-object' based on STRINGS. +If STRINGS is nil, we initialize `erc-modified-channels-object' to +an appropriate initial value for this flavor of Emacs." + (if strings + (if (featurep 'xemacs) + (let ((e-m-c-s '("["))) + (push (cons (extent-at 0 (car strings)) (car strings)) + e-m-c-s) + (dolist (string (cdr strings)) + (push "," e-m-c-s) + (push (cons (extent-at 0 string) string) + e-m-c-s)) + (push "] " e-m-c-s) + (reverse e-m-c-s)) + (concat (if (eq erc-track-position-in-mode-line 'after-modes) + "[" " [") + (mapconcat 'identity (nreverse strings) ",") + (if (eq erc-track-position-in-mode-line 'before-modes) + "] " "]"))) + (if (featurep 'xemacs) '() ""))) + +(defvar erc-modified-channels-object (erc-modified-channels-object nil) + "Internal object used for displaying modified channels in the mode line.") + +(put 'erc-modified-channels-object 'risky-local-variable t); allow properties + +(defvar erc-modified-channels-alist nil + "An ALIST used for tracking channel modification activity. +Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer +object of the channel the entry corresponds to, COUNT is a number +indicating how often activity was noticed, and FACE is the face to use +when displaying the buffer's name. See `erc-track-faces-priority-list', +and `erc-track-showcount'. + +Entries in this list should only happen for buffers where activity occurred +while the buffer was not visible.") + +(defcustom erc-track-showcount nil + "If non-nil, count of unseen messages will be shown for each channel." + :type 'boolean + :group 'erc-track) + +(defcustom erc-track-showcount-string ":" + "The string to display between buffer name and the count in the mode line. +The default is a colon, resulting in \"#emacs:9\"." + :type 'string + :group 'erc-track) + +(defcustom erc-track-switch-from-erc t + "If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer +when there are no more active channels." + :type 'boolean + :group 'erc-track) + +(defcustom erc-track-switch-direction 'oldest + "Direction `erc-track-switch-buffer' should switch. + + importance - find buffer with the most important message + oldest - find oldest active buffer + newest - find newest active buffer + leastactive - find buffer with least unseen messages + mostactive - find buffer with most unseen messages. + +If set to 'importance, the importance is determined by position +in `erc-track-faces-priority-list', where first is most +important." + :group 'erc-track + :type '(choice (const importance) + (const oldest) + (const newest) + (const leastactive) + (const mostactive))) + + +(defun erc-track-remove-from-mode-line () + "Remove `erc-track-modified-channels' from the mode-line" + (when (boundp 'mode-line-modes) + (setq mode-line-modes + (remove '(t erc-modified-channels-object) mode-line-modes))) + (when (consp global-mode-string) + (setq global-mode-string + (delq 'erc-modified-channels-object global-mode-string)))) + +(defun erc-track-add-to-mode-line (position) + "Add `erc-track-modified-channels' to POSITION in the mode-line. +See `erc-track-position-in-mode-line' for possible values." + ;; CVS Emacs has a new format string, and global-mode-string + ;; is very far to the right. + (cond ((and (eq position 'before-modes) + (boundp 'mode-line-modes)) + (add-to-list 'mode-line-modes + '(t erc-modified-channels-object))) + ((and (eq position 'after-modes) + (boundp 'mode-line-modes)) + (add-to-list 'mode-line-modes + '(t erc-modified-channels-object) t)) + ((eq position t) + (when (not global-mode-string) + (setq global-mode-string '(""))) ; Padding for mode-line wart + (add-to-list 'global-mode-string + 'erc-modified-channels-object + t)))) + +;;; Shortening of names + +(defun erc-track-shorten-names (channel-names) + "Call `erc-unique-channel-names' with the correct parameters. +This function is a good value for `erc-track-shorten-function'. +The list of all channels is returned by `erc-all-buffer-names'. +CHANNEL-NAMES is the list of active channel names. +Only channel names longer than `erc-track-shorten-cutoff' are +actually shortened, and they are only shortened to a minimum +of `erc-track-shorten-start' characters." + (erc-unique-channel-names + (erc-all-buffer-names) + channel-names + (lambda (s) + (> (length s) erc-track-shorten-cutoff)) + erc-track-shorten-start)) + +(defvar erc-default-recipients) + +(defun erc-all-buffer-names () + "Return all channel or query buffer names. +Note that we cannot use `erc-channel-list' with a nil argument, +because that does not return query buffers." + (save-excursion + (let (result) + (dolist (buf (buffer-list)) + (set-buffer buf) + (when (or (eq major-mode 'erc-mode) (eq major-mode 'erc-dcc-chat-mode)) + (setq result (cons (buffer-name) result)))) + result))) + +(defun erc-unique-channel-names (all active &optional predicate start) + "Return a list of unique channel names. +ALL is the list of all channel and query buffer names. +ACTIVE is the list of active buffer names. +PREDICATE is a predicate that should return non-nil if a name needs + no shortening. +START is the minimum length of the name used." + (if (eq 'max erc-track-shorten-aggressively) + ;; Return the unique substrings of all active channels. + (erc-unique-substrings active predicate start) + ;; Otherwise, determine the unique substrings of all channels, and + ;; for every active channel, return the corresponding substring. + ;; Given the names of the active channels, we now need to find the + ;; corresponding short name from the list of all substrings. To + ;; avoid problems when there are two channels and one is a + ;; substring of the other (notorious examples are #hurd and + ;; #hurd-bunny), every candidate gets the longest possible + ;; substring. + (let ((all-substrings (sort + (erc-unique-substrings all predicate start) + (lambda (a b) (> (length a) (length b))))) + result) + (dolist (channel active) + (let ((substrings all-substrings) + candidate + winner) + (while (and substrings (not winner)) + (setq candidate (car substrings) + substrings (cdr substrings)) + (when (and (string= candidate + (substring channel + 0 + (min (length candidate) + (length channel)))) + (not (member candidate result))) + (setq winner candidate))) + (setq result (cons winner result)))) + (nreverse result)))) + +(defun erc-unique-substrings (strings &optional predicate start) + "Return a list of unique substrings of STRINGS." + (if (or (not (numberp start)) + (< start 0)) + (setq start 2)) + (mapcar + (lambda (str) + (let* ((others (delete str (copy-sequence strings))) + (maxlen (length str)) + (i (min start + (length str))) + candidate + done) + (if (and (functionp predicate) (not (funcall predicate str))) + ;; do not shorten if a predicate exists and it returns nil + str + ;; Start with smallest substring candidate, ie. length 1. + ;; Then check all the others and see whether any of them starts + ;; with the same substring. While there is such another + ;; element in the list, increase the length of the candidate. + (while (not done) + (if (> i maxlen) + (setq done t) + (setq candidate (substring str 0 i) + done (not (erc-unique-substring-1 candidate others)))) + (setq i (1+ i))) + (if (and (= (length candidate) (1- maxlen)) + (not erc-track-shorten-aggressively)) + str + candidate)))) + strings)) + +(defun erc-unique-substring-1 (candidate others) + "Return non-nil when any string in OTHERS starts with CANDIDATE." + (let (result other (maxlen (length candidate))) + (while (and others + (not result)) + (setq other (car others) + others (cdr others)) + (when (and (>= (length other) maxlen) + (string= candidate (substring other 0 maxlen))) + (setq result other))) + result)) + +;;; Test: + +(assert + (and + ;; verify examples from the doc strings + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi"))) + '("#em" "#vi")) ; emacs is different from electronica + (equal (let ((erc-track-shorten-aggressively t)) + (erc-unique-channel-names + '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi"))) + '("#em" "#v")) ; vi is shortened by one letter + (equal (let ((erc-track-shorten-aggressively 'max)) + (erc-unique-channel-names + '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi"))) + '("#e" "#v")) ; emacs need not be different from electronica + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("#linux-de" "#linux-fr") + '("#linux-de" "#linux-fr"))) + '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive + (equal (let ((erc-track-shorten-aggressively t)) + (erc-unique-channel-names + '("#linux-de" "#linux-fr") + '("#linux-de" "#linux-fr"))) + '("#linux-d" "#linux-f")); now we want to be aggressive + ;; specific problems + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile" + "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny" + "#emacs") + '("#hurd-bunny" "#hurd" "#sawfish" "#lisp"))) + '("#hurd-" "#hurd" "#s" "#l")) + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-substrings + '("#emacs" "#vi" "#electronica" "#folk"))) + '("#em" "#vi" "#el" "#f")) + (equal (let ((erc-track-shorten-aggressively t)) + (erc-unique-substrings + '("#emacs" "#vi" "#electronica" "#folk"))) + '("#em" "#v" "#el" "#f")) + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("#emacs" "#burse" "+linux.de" "#starwars" + "#bitlbee" "+burse" "#ratpoison") + '("+linux.de" "#starwars" "#burse"))) + '("+l" "#s" "#bu")) + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("fsbot" "#emacs" "deego") + '("fsbot"))) + '("fs")) + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("fsbot" "#emacs" "deego") + '("fsbot") + (lambda (s) + (> (length s) 4)) + 1)) + '("f")) + (equal (let ((erc-track-shorten-aggressively nil)) + (erc-unique-channel-names + '("fsbot" "#emacs" "deego") + '("fsbot") + (lambda (s) + (> (length s) 4)) + 2)) + '("fs")) + (let ((erc-track-shorten-aggressively nil)) + (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs") + '("#hurd" "#hurd-bunny")) + '("#hurd" "#hurd-"))) + ;; general examples + (let ((erc-track-shorten-aggressively t)) + (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") + (not (erc-unique-substring-1 "a" '("xyz" "xab"))) + (equal (erc-unique-substrings '("abc" "xyz" "xab")) + '("ab" "xy" "xa")) + (equal (erc-unique-substrings '("abc" "abcdefg")) + '("abc" "abcd")))) + (let ((erc-track-shorten-aggressively nil)) + (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") + (not (erc-unique-substring-1 "a" '("xyz" "xab"))) + (equal (erc-unique-substrings '("abc" "xyz" "xab")) + '("abc" "xyz" "xab")) + (equal (erc-unique-substrings '("abc" "abcdefg")) + '("abc" "abcd")))))) + +;;; Minor mode + +;; Play nice with other IRC clients (and Emacs development rules) by +;; making this a minor mode + +(defvar erc-track-minor-mode-map (make-sparse-keymap) + "Keymap for rcirc track minor mode.") + +(define-key erc-track-minor-mode-map (kbd "C-c C-@") 'erc-track-switch-buffer) +(define-key erc-track-minor-mode-map (kbd "C-c C-SPC") + 'erc-track-switch-buffer) + +;;;###autoload +(define-minor-mode erc-track-minor-mode + "Global minor mode for tracking ERC buffers and showing activity in the +mode line. + +This exists for the sole purpose of providing the C-c C-SPC and +C-c C-@ keybindings. Make sure that you have enabled the track +module, otherwise the keybindings will not do anything useful." + :init-value nil + :lighter "" + :keymap erc-track-minor-mode-map + :global t + :group 'erc-track) + +(defun erc-track-minor-mode-maybe (&optional buffer) + "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'." + (when (and (not erc-track-minor-mode) + ;; don't start the minor mode until we have an ERC + ;; process running, because we don't want to prompt the + ;; user while starting Emacs + (or (and (buffer-live-p buffer) + (with-current-buffer buffer (eq major-mode 'erc-mode))) + (erc-buffer-list))) + (cond ((eq erc-track-enable-keybindings 'ask) + (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC") + (and (key-binding (kbd "C-c C-@")) "C-@")))) + (if key + (if (y-or-n-p + (concat "The C-c " key " binding is in use;" + " override it for tracking? ")) + (progn + (message (concat "Will change it; set" + " `erc-track-enable-keybindings'" + " to disable this message")) + (sleep-for 3) + (erc-track-minor-mode 1)) + (message (concat "Not changing it; set" + " `erc-track-enable-keybindings'" + " to disable this message")) + (sleep-for 3)) + (erc-track-minor-mode 1)))) + ((eq erc-track-enable-keybindings t) + (erc-track-minor-mode 1)) + (t nil)))) + +;;; Module + +;;;###autoload (autoload 'erc-track-mode "erc-track" nil t) +(define-erc-module track nil + "This mode tracks ERC channel buffers with activity." + ;; Enable: + ((when (boundp 'erc-track-when-inactive) + (if erc-track-when-inactive + (progn + (if (featurep 'xemacs) + (defadvice switch-to-buffer (after erc-update-when-inactive + (&rest args) activate) + (erc-user-is-active)) + (add-hook 'window-configuration-change-hook 'erc-user-is-active)) + (add-hook 'erc-send-completed-hook 'erc-user-is-active) + (add-hook 'erc-server-001-functions 'erc-user-is-active)) + (erc-track-add-to-mode-line erc-track-position-in-mode-line) + (setq erc-modified-channels-object (erc-modified-channels-object nil)) + (erc-update-mode-line) + (if (featurep 'xemacs) + (defadvice switch-to-buffer (after erc-update (&rest args) activate) + (erc-modified-channels-update)) + (add-hook 'window-configuration-change-hook + 'erc-modified-channels-update)) + (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) + (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) + ;; enable the tracking keybindings + (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) + (erc-track-minor-mode-maybe))) + ;; Disable: + ((when (boundp 'erc-track-when-inactive) + (erc-track-remove-from-mode-line) + (if erc-track-when-inactive + (progn + (if (featurep 'xemacs) + (ad-disable-advice 'switch-to-buffer 'after + 'erc-update-when-inactive) + (remove-hook 'window-configuration-change-hook + 'erc-user-is-active)) + (remove-hook 'erc-send-completed-hook 'erc-user-is-active) + (remove-hook 'erc-server-001-functions 'erc-user-is-active) + (remove-hook 'erc-timer-hook 'erc-user-is-active)) + (if (featurep 'xemacs) + (ad-disable-advice 'switch-to-buffer 'after 'erc-update) + (remove-hook 'window-configuration-change-hook + 'erc-modified-channels-update)) + (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) + (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) + ;; disable the tracking keybindings + (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) + (when erc-track-minor-mode + (erc-track-minor-mode -1))))) + +(defcustom erc-track-when-inactive nil + "Enable channel tracking even for visible buffers, if you are +inactive." + :group 'erc-track + :type 'boolean + :set (lambda (sym val) + (if erc-track-mode + (progn + (erc-track-disable) + (set sym val) + (erc-track-enable)) + (set sym val)))) + +;;; Visibility + +(defvar erc-buffer-activity nil + "Last time the user sent something.") + +(defvar erc-buffer-activity-timeout 10 + "How many seconds of inactivity by the user +to consider when `erc-track-visibility' is set to +only consider active buffers visible.") + +(defun erc-user-is-active (&rest ignore) + "Set `erc-buffer-activity'." + (when erc-server-connected + (setq erc-buffer-activity (erc-current-time)) + (erc-track-modified-channels))) + +(defun erc-track-get-buffer-window (buffer frame-param) + (if (eq frame-param 'selected-visible) + (if (eq (frame-visible-p (selected-frame)) t) + (get-buffer-window buffer nil) + nil) + (get-buffer-window buffer frame-param))) + +(defun erc-buffer-visible (buffer) + "Return non-nil when the buffer is visible." + (if erc-track-when-inactive + (when erc-buffer-activity; could be nil + (and (erc-track-get-buffer-window buffer erc-track-visibility) + (<= (erc-time-diff erc-buffer-activity (erc-current-time)) + erc-buffer-activity-timeout))) + (erc-track-get-buffer-window buffer erc-track-visibility))) + +;;; Tracking the channel modifications + +(defvar erc-modified-channels-update-inside nil + "Variable to prevent running `erc-modified-channels-update' multiple +times. Without it, you cannot debug `erc-modified-channels-display', +because the debugger also cases changes to the window-configuration.") + +(defun erc-modified-channels-update (&rest args) + "This function updates the information in `erc-modified-channels-alist' +according to buffer visibility. It calls +`erc-modified-channels-display' at the end. This should usually be +called via `window-configuration-change-hook'. +ARGS are ignored." + (interactive) + (unless erc-modified-channels-update-inside + (let ((erc-modified-channels-update-inside t) + (removed-channel nil)) + (mapc (lambda (elt) + (let ((buffer (car elt))) + (when (or (not (bufferp buffer)) + (not (buffer-live-p buffer)) + (erc-buffer-visible buffer) + (and erc-track-remove-disconnected-buffers + (not (with-current-buffer buffer + erc-server-connected)))) + (setq removed-channel t) + (erc-modified-channels-remove-buffer buffer)))) + erc-modified-channels-alist) + (when removed-channel + (erc-modified-channels-display) + (force-mode-line-update t))))) + +(defvar erc-track-mouse-face (if (featurep 'xemacs) + 'modeline-mousable + 'mode-line-highlight) + "The face to use when mouse is over channel names in the mode line.") + +(defun erc-make-mode-line-buffer-name (string buffer &optional faces count) + "Return STRING as a button that switches to BUFFER when clicked. +If FACES are provided, color STRING with them." + ;; We define a new sparse keymap every time, because 1. this data + ;; structure is very small, the alternative would require us to + ;; defvar a keymap, 2. the user is not interested in customizing it + ;; (really?), 3. the defun needs to switch to BUFFER, so we would + ;; need to save that value somewhere. + (let ((map (make-sparse-keymap)) + (name (if erc-track-showcount + (concat string + erc-track-showcount-string + (int-to-string count)) + (copy-sequence string)))) + (define-key map (vector 'mode-line 'mouse-2) + `(lambda (e) + (interactive "e") + (save-selected-window + (select-window + (posn-window (event-start e))) + (switch-to-buffer ,buffer)))) + (define-key map (vector 'mode-line 'mouse-3) + `(lambda (e) + (interactive "e") + (save-selected-window + (select-window + (posn-window (event-start e))) + (switch-to-buffer-other-window ,buffer)))) + (put-text-property 0 (length name) 'local-map map name) + (put-text-property + 0 (length name) + 'help-echo (concat "mouse-2: switch to buffer, " + "mouse-3: switch to buffer in other window") + name) + (put-text-property 0 (length name) 'mouse-face erc-track-mouse-face name) + (when (and faces erc-track-use-faces) + (put-text-property 0 (length name) 'face faces name)) + name)) + +(defun erc-modified-channels-display () + "Set `erc-modified-channels-object' +according to `erc-modified-channels-alist'. +Use `erc-make-mode-line-buffer-name' to create buttons." + (cond ((or (eq 'mostactive erc-track-switch-direction) + (eq 'leastactive erc-track-switch-direction)) + (erc-track-sort-by-activest)) + ((eq 'importance erc-track-switch-direction) + (erc-track-sort-by-importance))) + (run-hooks 'erc-track-list-changed-hook) + (unless (eq erc-track-position-in-mode-line nil) + (if (null erc-modified-channels-alist) + (setq erc-modified-channels-object (erc-modified-channels-object nil)) + ;; erc-modified-channels-alist contains all the data we need. To + ;; better understand what is going on, we split things up into + ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These + ;; four lists we use to create a new + ;; `erc-modified-channels-object' using + ;; `erc-make-mode-line-buffer-name'. + (let* ((buffers (mapcar 'car erc-modified-channels-alist)) + (counts (mapcar 'cadr erc-modified-channels-alist)) + (faces (mapcar 'cddr erc-modified-channels-alist)) + (long-names (mapcar #'(lambda (buf) + (or (buffer-name buf) + "")) + buffers)) + (short-names (if (functionp erc-track-shorten-function) + (funcall erc-track-shorten-function + long-names) + long-names)) + strings) + (while buffers + (when (car short-names) + (setq strings (cons (erc-make-mode-line-buffer-name + (car short-names) + (car buffers) + (car faces) + (car counts)) + strings))) + (setq short-names (cdr short-names) + buffers (cdr buffers) + counts (cdr counts) + faces (cdr faces))) + (when (featurep 'xemacs) + (erc-modified-channels-object nil)) + (setq erc-modified-channels-object + (erc-modified-channels-object strings)))))) + +(defun erc-modified-channels-remove-buffer (buffer) + "Remove BUFFER from `erc-modified-channels-alist'." + (interactive "bBuffer: ") + (setq erc-modified-channels-alist + (delete (assq buffer erc-modified-channels-alist) + erc-modified-channels-alist)) + (when (interactive-p) + (erc-modified-channels-display))) + +(defun erc-track-find-face (faces) + "Return the face to use in the modeline from the faces in FACES. +If `erc-track-faces-priority-list' is set, the one from FACES who is +first in that list will be used. + +If `erc-track-faces-normal-list' is non-nil, use it to produce a +blinking effect that indicates channel activity when the first +element in FACES and the highest-ranking face among the rest of +FACES are both members of `erc-track-faces-normal-list'. + +If `erc-track-faces-priority-list' is not set, the first element +in FACES will be used. + +If one of the faces is a list, then it will be ranked according +to its highest-tanking face member. A list of faces including +that member will take priority over just the single member +element." + (let ((choice (catch 'face + (dolist (candidate erc-track-faces-priority-list) + (when (member candidate faces) + (throw 'face candidate))))) + (no-first (and erc-track-faces-normal-list + (catch 'face + (dolist (candidate erc-track-faces-priority-list) + (when (member candidate (cdr faces)) + (throw 'face candidate))))))) + (cond ((null choice) + (car faces)) + ((and (member choice erc-track-faces-normal-list) + (member no-first erc-track-faces-normal-list)) + no-first) + (t + choice)))) + +(defun erc-track-modified-channels () + "Hook function for `erc-insert-post-hook' to check if the current +buffer should be added to the modeline as a hidden, modified +channel. Assumes it will only be called when current-buffer +is in `erc-mode'." + (let ((this-channel (or (erc-default-target) + (buffer-name (current-buffer))))) + (if (and (not (erc-buffer-visible (current-buffer))) + (not (member this-channel erc-track-exclude)) + (not (and erc-track-exclude-server-buffer + (erc-server-buffer-p))) + (not (erc-message-type-member + (or (erc-find-parsed-property) + (point-min)) + erc-track-exclude-types))) + ;; If the active buffer is not visible (not shown in a + ;; window), and not to be excluded, determine the kinds of + ;; faces used in the current message, and unless the user + ;; wants to ignore changes in certain channels where there + ;; are no faces corresponding to `erc-track-faces-priority-list', + ;; and the faces in the current message are found in said + ;; priority list, add the buffer to the erc-modified-channels-alist, + ;; if it is not already there. If the buffer is already on the list + ;; (in the car), change its face attribute (in the cddr) if + ;; necessary. See `erc-modified-channels-alist' for the + ;; exact data structure used. + (let ((faces (erc-faces-in (buffer-string)))) + (unless (and + (or (eq erc-track-priority-faces-only 'all) + (member this-channel erc-track-priority-faces-only)) + (not (catch 'found + (dolist (f faces) + (when (member f erc-track-faces-priority-list) + (throw 'found t)))))) + (if (not (assq (current-buffer) erc-modified-channels-alist)) + ;; Add buffer, faces and counts + (setq erc-modified-channels-alist + (cons (cons (current-buffer) + (cons 1 (erc-track-find-face faces))) + erc-modified-channels-alist)) + ;; Else modify the face for the buffer, if necessary. + (when faces + (let* ((cell (assq (current-buffer) + erc-modified-channels-alist)) + (old-face (cddr cell)) + (new-face (erc-track-find-face + (if old-face + (cons old-face faces) + faces)))) + (setcdr cell (cons (1+ (cadr cell)) new-face))))) + ;; And display it + (erc-modified-channels-display))) + ;; Else if the active buffer is the current buffer, remove it + ;; from our list. + (when (and (or (erc-buffer-visible (current-buffer)) + (and this-channel + (member this-channel erc-track-exclude))) + (assq (current-buffer) erc-modified-channels-alist)) + ;; Remove it from mode-line if buffer is visible or + ;; channel was added to erc-track-exclude recently. + (erc-modified-channels-remove-buffer (current-buffer)) + (erc-modified-channels-display))))) + +(defun erc-faces-in (str) + "Return a list of all faces used in STR." + (let ((i 0) + (m (length str)) + (faces (erc-list (get-text-property 0 'face str))) + cur) + (while (and (setq i (next-single-property-change i 'face str m)) + (not (= i m))) + (when (setq cur (get-text-property i 'face str)) + (add-to-list 'faces cur))) + faces)) + +(assert + (let ((str "is bold")) + (put-text-property 3 (length str) + 'face '(bold erc-current-nick-face) + str) + (erc-faces-in str))) + +;;; Buffer switching + +(defvar erc-track-last-non-erc-buffer nil + "Stores the name of the last buffer you were in before activating +`erc-track-switch-buffers'") + +(defun erc-track-sort-by-activest () + "Sort erc-modified-channels-alist by activity. +That means the number of unseen messages in a channel." + (setq erc-modified-channels-alist + (sort erc-modified-channels-alist + (lambda (a b) (> (nth 1 a) (nth 1 b)))))) + +(defun erc-track-face-priority (face) + "Return a number indicating the priority of FACE in +`erc-track-faces-priority-list'. Lower number means higher +priority. + +If face is not in `erc-track-faces-priority-list', it will have a +higher number than any other face in that list." + (let ((count 0)) + (catch 'done + (dolist (item erc-track-faces-priority-list) + (if (equal item face) + (throw 'done t) + (setq count (1+ count))))) + count)) + +(defun erc-track-sort-by-importance () + "Sort erc-modified-channels-alist by importance. +That means the position of the face in `erc-track-faces-priority-list'." + (setq erc-modified-channels-alist + (sort erc-modified-channels-alist + (lambda (a b) (< (erc-track-face-priority (cddr a)) + (erc-track-face-priority (cddr b))))))) + +(defun erc-track-get-active-buffer (arg) + "Return the buffer name of ARG in `erc-modified-channels-alist'. +Negative arguments index in the opposite direction. This direction is +relative to `erc-track-switch-direction'" + (let ((dir erc-track-switch-direction) + offset) + (when (< arg 0) + (setq dir (case dir + (oldest 'newest) + (newest 'oldest) + (mostactive 'leastactive) + (leastactive 'mostactive) + (importance 'oldest))) + (setq arg (- arg))) + (setq offset (case dir + ((oldest leastactive) + (- (length erc-modified-channels-alist) arg)) + (t (1- arg)))) + ;; normalise out of range user input + (cond ((>= offset (length erc-modified-channels-alist)) + (setq offset (1- (length erc-modified-channels-alist)))) + ((< offset 0) + (setq offset 0))) + (car (nth offset erc-modified-channels-alist)))) + +(defun erc-track-switch-buffer (arg) + "Switch to the next active ERC buffer, or if there are no active buffers, +switch back to the last non-ERC buffer visited. Next is defined by +`erc-track-switch-direction', a negative argument will reverse this." + (interactive "p") + (if (not erc-track-mode) + (message (concat "Enable the ERC track module if you want to use the" + " tracking minor mode")) + (cond (erc-modified-channels-alist + ;; if we're not in erc-mode, set this buffer to return to + (unless (eq major-mode 'erc-mode) + (setq erc-track-last-non-erc-buffer (current-buffer))) + ;; and jump to the next active channel + (switch-to-buffer (erc-track-get-active-buffer arg))) + ;; if no active channels, switch back to what we were doing before + ((and erc-track-last-non-erc-buffer + erc-track-switch-from-erc + (buffer-live-p erc-track-last-non-erc-buffer)) + (switch-to-buffer erc-track-last-non-erc-buffer))))) + +(provide 'erc-track) + +;;; erc-track.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 11b439f5-e5d7-4c6c-bb3f-eda98f9b0ac1 diff --git a/lisp/erc-truncate.el b/lisp/erc-truncate.el new file mode 100644 index 0000000..ab712b7 --- /dev/null +++ b/lisp/erc-truncate.el @@ -0,0 +1,121 @@ +;;; erc-truncate.el --- Functions for truncating ERC buffers + +;; Copyright (C) 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Andreas Fuchs +;; Keywords: IRC, chat, client, Internet, logging + +;; 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 3, 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 implements buffer truncation (and optional log file writing +;; support for the Emacs IRC client. Use `erc-truncate-mode' to switch +;; on. Use `erc-enable-logging' to enable logging of the stuff which +;; is getting truncated. + +;;; Code: + +(require 'erc) + +(defgroup erc-truncate nil + "Truncate buffers when they reach a certain size" + :group 'erc) + +(defcustom erc-max-buffer-size 30000 + "*Maximum size in chars of each ERC buffer. +Used only when auto-truncation is enabled. +\(see `erc-truncate-buffer' and `erc-insert-post-hook')." + :group 'erc-truncate + :type 'integer) + +;;;###autoload (autoload 'erc-truncate-mode "erc-truncate" nil t) +(define-erc-module truncate nil + "Truncate a query buffer if it gets too large. +This prevents the query buffer from getting too large, which can +bring any grown Emacs to its knees after a few days worth of +tracking heavy-traffic channels." + ;;enable + ((add-hook 'erc-insert-post-hook 'erc-truncate-buffer)) + ;; disable + ((remove-hook 'erc-insert-post-hook 'erc-truncate-buffer))) + +;;;###autoload +(defun erc-truncate-buffer-to-size (size &optional buffer) + "Truncates the buffer to the size SIZE. +If BUFFER is not provided, the current buffer is assumed. The deleted +region is logged if `erc-logging-enabled' returns non-nil." + ;; If buffer is non-nil, but get-buffer does not return anything, + ;; then this is a bug. If buffer is a buffer name, get the buffer + ;; object. If buffer is nil, use the current buffer. + (if (not buffer) + (setq buffer (current-buffer)) + (unless (get-buffer buffer) + (error "erc-truncate-buffer-to-size: %S is not a buffer" buffer))) + (when (> (buffer-size buffer) (+ size 512)) + (save-excursion + (set-buffer buffer) + ;; Note that when erc-insert-post-hook runs, the buffer is + ;; narrowed to the new message. So do this delicate widening. + ;; I am not sure, I think this was not recommended behaviour in + ;; Emacs 20. + (save-restriction + (widen) + (let ((end (- erc-insert-marker size))) + ;; truncate at line boundaries + (goto-char end) + (beginning-of-line) + (setq end (point)) + ;; try to save the current buffer using + ;; `erc-save-buffer-in-logs'. We use this, in case the + ;; user has both `erc-save-buffer-in-logs' and + ;; `erc-truncate-buffer' in `erc-insert-post-hook'. If + ;; this is the case, only the non-saved part of the current + ;; buffer should be saved. Rather than appending the + ;; deleted part of the buffer to the log file. + ;; + ;; Alternatively this could be made conditional on: + ;; (not (memq 'erc-save-buffer-in-logs + ;; erc-insert-post-hook)) + ;; Comments? + (when (and (boundp 'erc-enable-logging) + erc-enable-logging + (erc-logging-enabled buffer)) + (erc-save-buffer-in-logs)) + ;; disable undoing for the truncating + (buffer-disable-undo) + (let ((inhibit-read-only t)) + (delete-region (point-min) end))) + (buffer-enable-undo))))) + +;;;###autoload +(defun erc-truncate-buffer () + "Truncates the current buffer to `erc-max-buffer-size'. +Meant to be used in hooks, like `erc-insert-post-hook'." + (interactive) + (erc-truncate-buffer-to-size erc-max-buffer-size)) + +(provide 'erc-truncate) +;;; erc-truncate.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: 22a2ea78-871f-4870-8f1e-efe534170311 diff --git a/lisp/erc-viper.el b/lisp/erc-viper.el new file mode 100644 index 0000000..3739b50 --- /dev/null +++ b/lisp/erc-viper.el @@ -0,0 +1,74 @@ +;;; erc-viper.el --- Viper compatibility hacks for ERC + +;; Copyright (C) 2005, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Edward O'Connor +;; Keywords: emulation + +;; 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 3, 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: + +;; Viper is a VI emulation mode for Emacs. ERC and Viper don't quite get +;; along by default; the code in this file fixes that. A simple +;; (require 'erc-viper) +;; in your ~/.ercrc.el should be all it takes for you to use ERC and +;; Viper together happily. + +;;; Code: + +(require 'viper) + +;; We need this for `erc-mode-hook' and `erc-buffer-list'. Perhaps it +;; would be better to use an `eval-after-load', so that there could be +;; some autodetection / loading of this file from within erc.el? +(require 'erc) + +;; Fix RET in ERC buffers, by telling Viper to pass RET through to the +;; normal keymap. Do this conditionally, as this version of Viper may +;; already do this for us. +(unless (assoc 'erc-mode viper-major-mode-modifier-list) + (add-to-list 'viper-major-mode-modifier-list + '(erc-mode insert-state viper-comint-mode-modifier-map)) + (add-to-list 'viper-major-mode-modifier-list + '(erc-mode vi-state viper-comint-mode-modifier-map)) + (viper-apply-major-mode-modifiers)) + +;; Ensure that ERC buffers come up in insert state. +(add-to-list 'viper-insert-state-mode-list 'erc-mode) + +;; Fix various local variables in Viper. +(add-hook 'erc-mode-hook 'viper-comint-mode-hook) + +;; Fix ERC buffers that already exist (buffers in which `erc-mode-hook' +;; has already been run). +(mapc (lambda (buf) + (with-current-buffer buf + (viper-comint-mode-hook) + ;; If there *is* a final newline in this buffer, delete it, as + ;; it interferes with ERC /-commands. + (let ((last (1- (point-max)))) + (when (eq (char-after last) ?\n) + (goto-char last) + (delete-char 1))))) + (erc-buffer-list)) + +(provide 'erc-viper) + +;; arch-tag: 659fa645-e9ad-428c-ad53-8304d9f900f6 +;;; erc-viper.el ends here diff --git a/lisp/erc-xdcc.el b/lisp/erc-xdcc.el new file mode 100644 index 0000000..b58a7b6 --- /dev/null +++ b/lisp/erc-xdcc.el @@ -0,0 +1,141 @@ +;;; erc-xdcc.el --- XDCC file-server support for ERC + +;; Copyright (C) 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Mario Lang +;; Keywords: comm, processes + +;; 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 3, 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 file provides a very simple XDCC file server for ERC. + +;;; Code: + +(require 'erc-dcc) + +(defcustom erc-xdcc-files nil + "*List of files to offer via XDCC. +Your friends should issue \"/ctcp yournick XDCC list\" to see this." + :group 'erc-dcc + :type '(repeat file)) + +(defcustom erc-xdcc-verbose-flag t + "*Report XDCC CTCP requests in the server buffer." + :group 'erc-dcc + :type 'boolean) + +(defcustom erc-xdcc-handler-alist + '(("help" . erc-xdcc-help) + ("list" . erc-xdcc-list) + ("send" . erc-xdcc-send)) + "*Sub-command handler alist for XDCC CTCP queries." + :group 'erc-dcc + :type '(alist :key-type (string :tag "Sub-command") :value-type function)) + +(defcustom erc-xdcc-help-text + '(("Hey " nick ", wondering how this works? Pretty easy.") + ("Available commands: XDCC [" + (mapconcat 'car erc-xdcc-handler-alist "|") "]") + ("Type \"/ctcp " (erc-current-nick) + " XDCC list\" to see the list of offered files, then type \"/ctcp " + (erc-current-nick) " XDCC send #\" to get a particular file number.")) + "*Help text sent in response to XDCC help command. +A list of messages, each consisting of strings and expressions, expressions +being evaluated and should return stings." + :group 'erc-dcc + :type '(repeat (repeat :tag "Message" (choice string sexp)))) + +;;;###autoload (autoload 'erc-xdcc-mode "erc-xdcc") +(define-erc-module xdcc nil + "Act as an XDCC file-server." + nil nil) + +;;;###autoload +(defun erc-xdcc-add-file (file) + "Add a file to `erc-xdcc-files'." + (interactive "fFilename to add to XDCC: ") + (if (file-exists-p file) + (add-to-list 'erc-xdcc-files file))) + +(defun erc-xdcc-reply (proc nick msg) + (process-send-string proc + (format "PRIVMSG %s :%s\n" nick msg))) + +;; CTCP query handlers + +(defvar erc-ctcp-query-XDCC-hook '(erc-xdcc) + "Hook called whenever a CTCP XDCC message is received.") + +(defun erc-xdcc (proc nick login host to query) + "Handle incoming CTCP XDCC queries." + (when erc-xdcc-verbose-flag + (erc-display-message nil 'notice proc + (format "XDCC %s (%s@%s) sends %S" nick login host query))) + (let* ((args (cdr (delete "" (split-string query " ")))) + (handler (cdr (assoc (downcase (car args)) erc-xdcc-handler-alist)))) + (if (and handler (functionp handler)) + (funcall handler proc nick login host (cdr args)) + (erc-xdcc-reply + proc nick + (format "Unknown XDCC sub-command, try \"/ctcp %s XDCC help\"" + (erc-current-nick)))))) + +(defun erc-xdcc-help (proc nick login host args) + "Send basic help information to NICK." + (mapc + (lambda (msg) + (erc-xdcc-reply proc nick + (mapconcat (lambda (elt) (if (stringp elt) elt (eval elt))) msg ""))) + erc-xdcc-help-text)) + +(defun erc-xdcc-list (proc nick login host args) + "Show the contents of `erc-xdcc-files' via privmsg to NICK." + (if (null erc-xdcc-files) + (erc-xdcc-reply proc nick "No files offered, sorry") + (erc-xdcc-reply proc nick "Num Filename") + (erc-xdcc-reply proc nick "--- -------------") + (let ((n 0)) + (dolist (file erc-xdcc-files) + (erc-xdcc-reply proc nick + (format "%02d. %s" + (setq n (1+ n)) + (erc-dcc-file-to-name file))))))) + +(defun erc-xdcc-send (proc nick login host args) + "Send a file to NICK." + (let ((n (string-to-number (car args))) + (len (length erc-xdcc-files))) + (cond + ((= len 0) + (erc-xdcc-reply proc nick "No files offered, sorry")) + ((or (< n 1) (> n len)) + (erc-xdcc-reply proc nick (format "%d out of range" n))) + (t (erc-dcc-send-file nick (nth (1- n) erc-xdcc-files) proc))))) + +(provide 'erc-xdcc) + +;;; erc-xdcc.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8 diff --git a/lisp/erc.el b/lisp/erc.el new file mode 100644 index 0000000..8b289a8 --- /dev/null +++ b/lisp/erc.el @@ -0,0 +1,6520 @@ +;; erc.el --- An Emacs Internet Relay Chat client + +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Alexander L. Belikoff (alexander@belikoff.net) +;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu), +;; Mario Lang (mlang@delysid.org), +;; Alex Schroeder (alex@gnu.org) +;; Andreas Fuchs (afs@void.at) +;; Gergely Nagy (algernon@midgard.debian.net) +;; David Edmondson (dme@dme.org) +;; Maintainer: Michael Olson (mwolson@gnu.org) +;; Keywords: IRC, chat, client, Internet + +;; 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 3, 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: + +;; ERC is a powerful, modular, and extensible IRC client for Emacs. + +;; For more information, see the following URLs: +;; * http://sv.gnu.org/projects/erc/ +;; * http://www.emacswiki.org/cgi-bin/wiki/ERC + +;; As of 2006-06-13, ERC development is now hosted on Savannah +;; (http://sv.gnu.org/projects/erc). I invite everyone who wants to +;; hack on it to contact me in order to get write +;; access to the shared Arch archive. + +;; Installation: + +;; Put erc.el in your load-path, and put (require 'erc) in your .emacs. + +;; Configuration: + +;; Use M-x customize-group RET erc RET to get an overview +;; of all the variables you can tweak. + +;; Usage: + +;; To connect to an IRC server, do +;; +;; M-x erc RET +;; +;; After you are connected to a server, you can use C-h m or have a look at +;; the ERC menu. + +;;; History: +;; + +;;; Code: + +(defconst erc-version-string "Version 5.3" + "ERC version. This is used by function `erc-version'.") + +(eval-when-compile (require 'cl)) +(require 'font-lock) +(require 'pp) +(require 'thingatpt) +(require 'erc-compat) + +(defvar erc-official-location + "http://emacswiki.org/cgi-bin/wiki/ERC (mailing list: erc-discuss@gnu.org)" + "Location of the ERC client on the Internet.") + +(defgroup erc nil + "Emacs Internet Relay Chat client." + :link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/ERC") + :prefix "erc-" + :group 'applications) + +(defgroup erc-buffers nil + "Creating new ERC buffers" + :group 'erc) + +(defgroup erc-display nil + "Settings for how various things are displayed" + :group 'erc) + +(defgroup erc-mode-line-and-header nil + "Displaying information in the mode-line and header" + :group 'erc-display) + +(defgroup erc-ignore nil + "Ignoring certain messages" + :group 'erc) + +(defgroup erc-query nil + "Using separate buffers for private discussions" + :group 'erc) + +(defgroup erc-quit-and-part nil + "Quitting and parting channels" + :group 'erc) + +(defgroup erc-paranoia nil + "Know what is sent and received; control the display of sensitive data." + :group 'erc) + +(defgroup erc-scripts nil + "Running scripts at startup and with /LOAD" + :group 'erc) + +(require 'erc-backend) + +;; compatibility with older ERC releases + +(if (fboundp 'defvaralias) + (progn + (defvaralias 'erc-announced-server-name 'erc-server-announced-name) + (erc-make-obsolete-variable 'erc-announced-server-name + 'erc-server-announced-name + "ERC 5.1") + (defvaralias 'erc-process 'erc-server-process) + (erc-make-obsolete-variable 'erc-process 'erc-server-process "ERC 5.1") + (defvaralias 'erc-default-coding-system 'erc-server-coding-system) + (erc-make-obsolete-variable 'erc-default-coding-system + 'erc-server-coding-system + "ERC 5.1")) + (message (concat "ERC: The function `defvaralias' is not bound. See the " + "NEWS file for variable name changes since ERC 5.0.4."))) + +(defalias 'erc-send-command 'erc-server-send) +(erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1") + +;; tunable connection and authentication parameters + +(defcustom erc-server nil + "IRC server to use if one is not provided. +See function `erc-compute-server' for more details on connection +parameters and authentication." + :group 'erc + :type '(choice (const :tag "None" nil) + (string :tag "Server"))) + +(defcustom erc-port nil + "IRC port to use if not specified. + +This can be either a string or a number." + :group 'erc + :type '(choice (const :tag "None" nil) + (integer :tag "Port number") + (string :tag "Port string"))) + +(defcustom erc-nick nil + "Nickname to use if one is not provided. + +This can be either a string, or a list of strings. +In the latter case, if the first nick in the list is already in use, +other nicks are tried in the list order. + +See function `erc-compute-nick' for more details on connection +parameters and authentication." + :group 'erc + :type '(choice (const :tag "None" nil) + (string :tag "Nickname") + (repeat (string :tag "Nickname")))) + +(defcustom erc-nick-uniquifier "`" + "The string to append to the nick if it is already in use." + :group 'erc + :type 'string) + +(defcustom erc-try-new-nick-p t + "If the nickname you chose isn't available, and this option is non-nil, +ERC should automatically attempt to connect with another nickname. + +You can manually set another nickname with the /NICK command." + :group 'erc + :type 'boolean) + +(defcustom erc-user-full-name nil + "User full name. + +This can be either a string or a function to call. + +See function `erc-compute-full-name' for more details on connection +parameters and authentication." + :group 'erc + :type '(choice (const :tag "No name" nil) + (string :tag "Name") + (function :tag "Get from function")) + :set (lambda (sym val) + (if (functionp val) + (set sym (funcall val)) + (set sym val)))) + +(defvar erc-password nil + "Password to use when authenticating to an IRC server. +It is not strictly necessary to provide this, since ERC will +prompt you for it.") + +(defcustom erc-user-mode nil + "Initial user modes to be set after a connection is established." + :group 'erc + :type '(choice (const nil) string function)) + + +(defcustom erc-prompt-for-password t + "Asks before using the default password, or whether to enter a new one." + :group 'erc + :type 'boolean) + +(defcustom erc-warn-about-blank-lines t + "Warn the user if they attempt to send a blank line." + :group 'erc + :type 'boolean) + +(defcustom erc-send-whitespace-lines nil + "If set to non-nil, send lines consisting of only whitespace." + :group 'erc + :type 'boolean) + +(defcustom erc-hide-prompt nil + "If non-nil, do not display the prompt for commands. + +\(A command is any input starting with a '/'). + +See also the variables `erc-prompt' and `erc-command-indicator'." + :group 'erc-display + :type 'boolean) + +;; tunable GUI stuff + +(defcustom erc-show-my-nick t + "If non-nil, display one's own nickname when sending a message. + +If non-nil, \"\" will be shown. +If nil, only \"> \" will be shown." + :group 'erc-display + :type 'boolean) + +(define-widget 'erc-message-type 'set + "A set of standard IRC Message types." + :args '((const "JOIN") + (const "KICK") + (const "NICK") + (const "PART") + (const "QUIT") + (const "MODE") + (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) + +(defcustom erc-hide-list nil + "*List of IRC type messages to hide. +A typical value would be '(\"JOIN\" \"PART\" \"QUIT\")." + :group 'erc-ignore + :type 'erc-message-type) + +(defvar erc-session-password nil + "The password used for the current session.") +(make-variable-buffer-local 'erc-session-password) + +(defcustom erc-disconnected-hook nil + "Run this hook with arguments (NICK IP REASON) when disconnected. +This happens before automatic reconnection. Note, that +`erc-server-QUIT-functions' might not be run when we disconnect, +simply because we do not necessarily receive the QUIT event." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-complete-functions nil + "These functions get called when the user hits TAB in ERC. +Each function in turn is called until one returns non-nil to +indicate it has handled the input." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-join-hook nil + "Hook run when we join a channel. Hook functions are called +without arguments, with the current buffer set to the buffer of +the new channel. + +See also `erc-server-JOIN-functions', `erc-part-hook'." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-quit-hook nil + "Hook run when processing a quit command directed at our nick. + +The hook receives one argument, the current PROCESS. +See also `erc-server-QUIT-functions' and `erc-disconnected-hook'." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-part-hook nil + "Hook run when processing a PART message directed at our nick. + +The hook receives one argument, the current BUFFER. +See also `erc-server-QUIT-functions', `erc-quit-hook' and +`erc-disconnected-hook'." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-kick-hook nil + "Hook run when processing a KICK message directed at our nick. + +The hook receives one argument, the current BUFFER. +See also `erc-server-PART-functions' and `erc-part-hook'." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-nick-changed-functions nil + "List of functions run when your nick was successfully changed. + +Each function should accept two arguments, NEW-NICK and OLD-NICK." + :group 'erc-hooks + :type 'hook) + +(defcustom erc-connect-pre-hook '(erc-initialize-log-marker) + "Hook called just before `erc' calls `erc-connect'. +Functions are passed a buffer as the first argument." + :group 'erc-hooks + :type 'hook) + + +(defvar erc-channel-users nil + "A hash table of members in the current channel, which +associates nicknames with cons cells of the form: +\(USER . MEMBER-DATA) where USER is a pointer to an +erc-server-user struct, and MEMBER-DATA is a pointer to an +erc-channel-user struct.") +(make-variable-buffer-local 'erc-channel-users) + +(defvar erc-server-users nil + "A hash table of users on the current server, which associates +nicknames with erc-server-user struct instances.") +(make-variable-buffer-local 'erc-server-users) + +(defun erc-downcase (string) + "Convert STRING to IRC standard conforming downcase." + (let ((s (downcase string)) + (c '((?\[ . ?\{) + (?\] . ?\}) + (?\\ . ?\|) + (?~ . ?^)))) + (save-match-data + (while (string-match "[]\\[~]" s) + (aset s (match-beginning 0) + (cdr (assq (aref s (match-beginning 0)) c))))) + s)) + +(defmacro erc-with-server-buffer (&rest body) + "Execute BODY in the current ERC server buffer. +If no server buffer exists, return nil." + (let ((buffer (make-symbol "buffer"))) + `(let ((,buffer (erc-server-buffer))) + (when (buffer-live-p ,buffer) + (with-current-buffer ,buffer + ,@body))))) +(put 'erc-with-server-buffer 'lisp-indent-function 0) +(put 'erc-with-server-buffer 'edebug-form-spec '(body)) + +(defstruct (erc-server-user (:type vector) :named) + ;; User data + nickname host login full-name info + ;; Buffers + ;; + ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where + ;; CHANNEL-DATA is either nil or an erc-channel-user struct. + (buffers nil) + ) + +(defstruct (erc-channel-user (:type vector) :named) + op voice + ;; Last message time (in the form of the return value of + ;; (current-time) + ;; + ;; This is useful for ordered name completion. + (last-message-time nil)) + +(defsubst erc-get-channel-user (nick) + "Finds the (USER . CHANNEL-DATA) element corresponding to NICK +in the current buffer's `erc-channel-users' hash table." + (gethash (erc-downcase nick) erc-channel-users)) + +(defsubst erc-get-server-user (nick) + "Finds the USER corresponding to NICK in the current server's +`erc-server-users' hash table." + (erc-with-server-buffer + (gethash (erc-downcase nick) erc-server-users))) + +(defsubst erc-add-server-user (nick user) + "This function is for internal use only. + +Adds USER with nickname NICK to the `erc-server-users' hash table." + (erc-with-server-buffer + (puthash (erc-downcase nick) user erc-server-users))) + +(defsubst erc-remove-server-user (nick) + "This function is for internal use only. + +Removes the user with nickname NICK from the `erc-server-users' +hash table. This user is not removed from the +`erc-channel-users' lists of other buffers. + +See also: `erc-remove-user'." + (erc-with-server-buffer + (remhash (erc-downcase nick) erc-server-users))) + +(defun erc-change-user-nickname (user new-nick) + "This function is for internal use only. + +Changes the nickname of USER to NEW-NICK in the +`erc-server-users' hash table. The `erc-channel-users' lists of +other buffers are also changed." + (let ((nick (erc-server-user-nickname user))) + (setf (erc-server-user-nickname user) new-nick) + (erc-with-server-buffer + (remhash (erc-downcase nick) erc-server-users) + (puthash (erc-downcase new-nick) user erc-server-users)) + (dolist (buf (erc-server-user-buffers user)) + (if (buffer-live-p buf) + (with-current-buffer buf + (let ((cdata (erc-get-channel-user nick))) + (remhash (erc-downcase nick) erc-channel-users) + (puthash (erc-downcase new-nick) cdata + erc-channel-users))))))) + +(defun erc-remove-channel-user (nick) + "This function is for internal use only. + +Removes the user with nickname NICK from the `erc-channel-users' +list for this channel. If this user is not in the +`erc-channel-users' list of any other buffers, the user is also +removed from the server's `erc-server-users' list. + +See also: `erc-remove-server-user' and `erc-remove-user'." + (let ((channel-data (erc-get-channel-user nick))) + (when channel-data + (let ((user (car channel-data))) + (setf (erc-server-user-buffers user) + (delq (current-buffer) + (erc-server-user-buffers user))) + (remhash (erc-downcase nick) erc-channel-users) + (if (null (erc-server-user-buffers user)) + (erc-remove-server-user nick)))))) + +(defun erc-remove-user (nick) + "This function is for internal use only. + +Removes the user with nickname NICK from the `erc-server-users' +list as well as from all `erc-channel-users' lists. + +See also: `erc-remove-server-user' and +`erc-remove-channel-user'." + (let ((user (erc-get-server-user nick))) + (when user + (let ((buffers (erc-server-user-buffers user))) + (dolist (buf buffers) + (if (buffer-live-p buf) + (with-current-buffer buf + (remhash (erc-downcase nick) erc-channel-users) + (run-hooks 'erc-channel-members-changed-hook))))) + (erc-remove-server-user nick)))) + +(defun erc-remove-channel-users () + "This function is for internal use only. + +Removes all users in the current channel. This is called by +`erc-server-PART' and `erc-server-QUIT'." + (when (and erc-server-connected + (erc-server-process-alive) + (hash-table-p erc-channel-users)) + (maphash (lambda (nick cdata) + (erc-remove-channel-user nick)) + erc-channel-users) + (clrhash erc-channel-users))) + +(defsubst erc-channel-user-op-p (nick) + "Return t if NICK is an operator in the current channel." + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-op (cdr cdata)))))) + +(defsubst erc-channel-user-voice-p (nick) + "Return t if NICK has voice in the current channel." + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-voice (cdr cdata)))))) + +(defun erc-get-channel-user-list () + "Returns a list of users in the current channel. Each element +of the list is of the form (USER . CHANNEL-DATA), where USER is +an erc-server-user struct, and CHANNEL-DATA is either `nil' or an +erc-channel-user struct. + +See also: `erc-sort-channel-users-by-activity'" + (let (users) + (if (hash-table-p erc-channel-users) + (maphash (lambda (nick cdata) + (setq users (cons cdata users))) + erc-channel-users)) + users)) + +(defun erc-get-server-nickname-list () + "Returns a list of known nicknames on the current server." + (erc-with-server-buffer + (let (nicks) + (when (hash-table-p erc-server-users) + (maphash (lambda (n user) + (setq nicks + (cons (erc-server-user-nickname user) + nicks))) + erc-server-users) + nicks)))) + +(defun erc-get-channel-nickname-list () + "Returns a list of known nicknames on the current channel." + (let (nicks) + (when (hash-table-p erc-channel-users) + (maphash (lambda (n cdata) + (setq nicks + (cons (erc-server-user-nickname (car cdata)) + nicks))) + erc-channel-users) + nicks))) + +(defun erc-get-server-nickname-alist () + "Returns an alist of known nicknames on the current server." + (erc-with-server-buffer + (let (nicks) + (when (hash-table-p erc-server-users) + (maphash (lambda (n user) + (setq nicks + (cons (cons (erc-server-user-nickname user) nil) + nicks))) + erc-server-users) + nicks)))) + +(defun erc-get-channel-nickname-alist () + "Returns an alist of known nicknames on the current channel." + (let (nicks) + (when (hash-table-p erc-channel-users) + (maphash (lambda (n cdata) + (setq nicks + (cons (cons (erc-server-user-nickname (car cdata)) nil) + nicks))) + erc-channel-users) + nicks))) + +(defun erc-sort-channel-users-by-activity (list) + "Sorts LIST such that users which have spoken most recently are +listed first. LIST must be of the form (USER . CHANNEL-DATA). + +See also: `erc-get-channel-user-list'." + (sort list + (lambda (x y) + (when (and + (cdr x) (cdr y)) + (let ((tx (erc-channel-user-last-message-time (cdr x))) + (ty (erc-channel-user-last-message-time (cdr y)))) + (if tx + (if ty + (time-less-p ty tx) + t) + nil)))))) + +(defun erc-sort-channel-users-alphabetically (list) + "Sort LIST so that users' nicknames are in alphabetical order. +LIST must be of the form (USER . CHANNEL-DATA). + +See also: `erc-get-channel-user-list'." + (sort list + (lambda (x y) + (when (and + (cdr x) (cdr y)) + (let ((nickx (downcase (erc-server-user-nickname (car x)))) + (nicky (downcase (erc-server-user-nickname (car y))))) + (if nickx + (if nicky + (string-lessp nickx nicky) + t) + nil)))))) + +(defvar erc-channel-topic nil + "A topic string for the channel. Should only be used in channel-buffers.") +(make-variable-buffer-local 'erc-channel-topic) + +(defvar erc-channel-modes nil + "List of strings representing channel modes. +E.g. '(\"i\" \"m\" \"s\" \"b Quake!*@*\") +\(not sure the ban list will be here, but why not)") +(make-variable-buffer-local 'erc-channel-modes) + +(defvar erc-insert-marker nil + "The place where insertion of new text in erc buffers should happen.") +(make-variable-buffer-local 'erc-insert-marker) + +(defvar erc-input-marker nil + "The marker where input should be inserted.") +(make-variable-buffer-local 'erc-input-marker) + +(defun erc-string-no-properties (string) + "Return a copy of STRING will all text-properties removed." + (let ((newstring (copy-sequence string))) + (set-text-properties 0 (length newstring) nil newstring) + newstring)) + +(defcustom erc-prompt "ERC>" + "Prompt used by ERC. Trailing whitespace is not required." + :group 'erc-display + :type '(choice string function)) + +(defun erc-prompt () + "Return the input prompt as a string. + +See also the variable `erc-prompt'." + (let ((prompt (if (functionp erc-prompt) + (funcall erc-prompt) + erc-prompt))) + (if (> (length prompt) 0) + (concat prompt " ") + prompt))) + +(defcustom erc-command-indicator nil + "Indicator used by ERC for showing commands. + +If non-nil, this will be used in the ERC buffer to indicate +commands (i.e., input starting with a '/'). + +If nil, the prompt will be constructed from the variable `erc-prompt'." + :group 'erc-display + :type '(choice (const nil) string function)) + +(defun erc-command-indicator () + "Return the command indicator prompt as a string. + +This only has any meaning if the variable `erc-command-indicator' is non-nil." + (and erc-command-indicator + (let ((prompt (if (functionp erc-command-indicator) + (funcall erc-command-indicator) + erc-command-indicator))) + (if (> (length prompt) 0) + (concat prompt " ") + prompt)))) + +(defcustom erc-notice-prefix "*** " + "*Prefix for all notices." + :group 'erc-display + :type 'string) + +(defcustom erc-notice-highlight-type 'all + "*Determines how to highlight notices. +See `erc-notice-prefix'. + +The following values are allowed: + + 'prefix - highlight notice prefix only + 'all - highlight the entire notice + +Any other value disables notice's highlighting altogether." + :group 'erc-display + :type '(choice (const :tag "highlight notice prefix only" prefix) + (const :tag "highlight the entire notice" all) + (const :tag "don't highlight notices at all" nil))) + +(defcustom erc-echo-notice-hook nil + "*Specifies a list of functions to call to echo a private +notice. Each function is called with four arguments, the string +to display, the parsed server message, the target buffer (or +nil), and the sender. The functions are called in order, until a +function evaluates to non-nil. These hooks are called after +those specified in `erc-echo-notice-always-hook'. + +See also: `erc-echo-notice-always-hook', +`erc-echo-notice-in-default-buffer', +`erc-echo-notice-in-target-buffer', +`erc-echo-notice-in-minibuffer', +`erc-echo-notice-in-server-buffer', +`erc-echo-notice-in-active-non-server-buffer', +`erc-echo-notice-in-active-buffer', +`erc-echo-notice-in-user-buffers', +`erc-echo-notice-in-user-and-target-buffers', +`erc-echo-notice-in-first-user-buffer'" + :group 'erc-hooks + :type 'hook + :options '(erc-echo-notice-in-default-buffer + erc-echo-notice-in-target-buffer + erc-echo-notice-in-minibuffer + erc-echo-notice-in-server-buffer + erc-echo-notice-in-active-non-server-buffer + erc-echo-notice-in-active-buffer + erc-echo-notice-in-user-buffers + erc-echo-notice-in-user-and-target-buffers + erc-echo-notice-in-first-user-buffer)) + +(defcustom erc-echo-notice-always-hook + '(erc-echo-notice-in-default-buffer) + "*Specifies a list of functions to call to echo a private +notice. Each function is called with four arguments, the string +to display, the parsed server message, the target buffer (or +nil), and the sender. The functions are called in order, and all +functions are called. These hooks are called before those +specified in `erc-echo-notice-hook'. + +See also: `erc-echo-notice-hook', +`erc-echo-notice-in-default-buffer', +`erc-echo-notice-in-target-buffer', +`erc-echo-notice-in-minibuffer', +`erc-echo-notice-in-server-buffer', +`erc-echo-notice-in-active-non-server-buffer', +`erc-echo-notice-in-active-buffer', +`erc-echo-notice-in-user-buffers', +`erc-echo-notice-in-user-and-target-buffers', +`erc-echo-notice-in-first-user-buffer'" + :group 'erc-hooks + :type 'hook + :options '(erc-echo-notice-in-default-buffer + erc-echo-notice-in-target-buffer + erc-echo-notice-in-minibuffer + erc-echo-notice-in-server-buffer + erc-echo-notice-in-active-non-server-buffer + erc-echo-notice-in-active-buffer + erc-echo-notice-in-user-buffers + erc-echo-notice-in-user-and-target-buffers + erc-echo-notice-in-first-user-buffer)) + +;; other tunable parameters + +(defcustom erc-whowas-on-nosuchnick nil + "*If non-nil, do a whowas on a nick if no such nick." + :group 'erc + :type 'boolean) + +(defcustom erc-verbose-server-ping nil + "*If non-nil, show every time you get a PING or PONG from the server." + :group 'erc-paranoia + :type 'boolean) + +(defcustom erc-public-away-p nil + "*Let others know you are back when you are no longer marked away. +This happens in this form: +* is back (gone for