Added new lisp files

This commit is contained in:
Carolyn Grey Bridgette Knight-Serrano 2019-12-17 10:26:11 -08:00
parent 9637101ff7
commit e2813fbd7b
Signed by: gigavinyl
GPG Key ID: 50858748146544CB
53 changed files with 22991 additions and 41 deletions

View File

@ -1 +1 @@
737385
737408

5
afew/config Normal file
View File

@ -0,0 +1,5 @@
[MailMover]
folders = Defunct/INBOX
# rules
Defunct/INBOX = 'tag:archive':Defunct/Archiv 'tag:cforum':Defunct/Lists.cforum 'tag:deleted':Defunct/Trash

3
diary Normal file
View File

@ -0,0 +1,3 @@
Dec 16, 2019
Drove home with Mom. Pretty good/uneventful. Looked at clojure and emacs stuff.

316
init.el
View File

@ -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 "<f5>") #'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 @@
("\\<PEP[- ]?\\([0-9]+\\)" 0 lui-button-pep 1)
("\\<xkcd[ #]*\\([0-9]+\\)" 0 "https://xkcd.com/%s" 1)
("\\([0-9a-zA-Z_.-]+/[0-9a-zA-Z_.-]+\\)#\\([0-9]+\\)" 0 "https://github.com/%s/issues/%s" 1 2))))
'(mml-secure-openpgp-encrypt-to-self t)
'(org-journal-date-format "%A, %d %B %Y")
'(org-journal-dir "~/org/journal/")
'(package-selected-packages
(quote
(weehcat git-gutter doom-modeline clj-refactor paredit yascroll yaml-mode writeroom-mode which-key w3m use-package toml-mode smartparens smart-mode-line rainbow-delimiters racer projectile parinfer org-plus-contrib org-journal neotree multiple-cursors minimap lsp-ui lsp-haskell inflections hydra general focus flycheck-rust flycheck-pos-tip flycheck-clojure flx exec-path-from-shell evil-org evil-magit evil-escape evil-commentary emidje edn editorconfig counsel company-quickhelp company-math company-lsp company-auctex bug-hunter auto-package-update all-the-icons aggressive-indent)))
(gopher gorepl-mode go-flycheck go-mode alchemist Alchemist elixir-mode erc-nicklist lsp-treemacs helm-lsp erc-yt erc-youtube multi-term erc-sasl elfeed auto-compile smex weehcat git-gutter doom-modeline clj-refactor paredit yascroll yaml-mode writeroom-mode which-key w3m use-package toml-mode smartparens smart-mode-line rainbow-delimiters racer projectile parinfer org-plus-contrib org-journal neotree multiple-cursors minimap lsp-ui lsp-haskell inflections hydra general focus flycheck-rust flycheck-pos-tip flycheck-clojure flx exec-path-from-shell evil-org evil-magit evil-escape evil-commentary emidje edn editorconfig counsel company-quickhelp company-math company-lsp company-auctex bug-hunter auto-package-update all-the-icons aggressive-indent)))
'(send-mail-function (quote smtpmail-send-it))
'(smtpmail-smtp-server "smtp.riseup.net")
'(smtpmail-smtp-service 587))

555
lisp/erc-auto.el Normal file
View File

@ -0,0 +1,555 @@
;;; -*-emacs-lisp-*-
;; Copyright (C) 2002, 2007, 2008 Free Software Foundation, Inc.
(defvar generated-autoload-file)
(defvar command-line-args-left)
(defun erc-generate-autoloads ()
(interactive)
(require 'autoload)
(setq generated-autoload-file (car command-line-args-left))
(setq command-line-args-left (cdr command-line-args-left))
(batch-update-autoloads))
(provide 'erc-auto)
;;; Generated autoloads follow (made by autoload.el).
;;;### (autoloads (erc-handle-irc-url erc erc-select-read-args) "erc"
;;;;;; "erc.el" (18331 43816))
;;; Generated autoloads from erc.el
(autoload 'erc-select-read-args "erc" "\
Prompt the user for values of nick, server, port, and password.
\(fn)" nil nil)
(autoload 'erc "erc" "\
ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
It permits you to select connection parameters, and then starts ERC.
Non-interactively, it takes the keyword arguments
(server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
password
(full-name (erc-compute-full-name)))
That is, if called with
(erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\")
then the server and full-name will be set to those values, whereas
`erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
be invoked for the values of the other parameters.
\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)))" t nil)
(defalias 'erc-select 'erc)
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
\(fn HOST PORT CHANNEL USER PASSWORD)" nil nil)
;;;***
;;;### (autoloads nil "erc-bbdb" "erc-bbdb.el" (18329 17849))
;;; Generated autoloads from erc-bbdb.el
(autoload 'erc-bbdb-mode "erc-bbdb")
;;;***
;;;### (autoloads nil "erc-button" "erc-button.el" (18331 42201))
;;; Generated autoloads from erc-button.el
(autoload 'erc-button-mode "erc-button" nil t)
;;;***
;;;### (autoloads nil "erc-capab" "erc-capab.el" (18331 42201))
;;; Generated autoloads from erc-capab.el
(autoload 'erc-capab-identify-mode "erc-capab" nil t)
;;;***
;;;### (autoloads (erc-chess-ctcp-query-handler erc-cmd-CHESS) "erc-chess"
;;;;;; "erc-chess.el" (18309 38189))
;;; Generated autoloads from erc-chess.el
(defvar erc-ctcp-query-CHESS-hook '(erc-chess-ctcp-query-handler))
(autoload 'erc-cmd-CHESS "erc-chess" "\
Initiate a chess game via CTCP to NICK.
NICK should be the first and only arg to /chess
\(fn LINE &optional FORCE)" nil nil)
(autoload 'erc-chess-ctcp-query-handler "erc-chess" "\
Not documented
\(fn PROC NICK LOGIN HOST TO MSG)" nil nil)
;;;***
;;;### (autoloads nil "erc-compat" "erc-compat.el" (18331 43816))
;;; Generated autoloads from erc-compat.el
(autoload 'erc-define-minor-mode "erc-compat")
;;;***
;;;### (autoloads (erc-ctcp-query-DCC pcomplete/erc-mode/DCC erc-cmd-DCC)
;;;;;; "erc-dcc" "erc-dcc.el" (18331 42202))
;;; Generated autoloads from erc-dcc.el
(autoload 'erc-dcc-mode "erc-dcc")
(autoload 'erc-cmd-DCC "erc-dcc" "\
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.
\(fn CMD &rest ARGS)" nil nil)
(autoload 'pcomplete/erc-mode/DCC "erc-dcc" "\
Provides completion for the /DCC command.
\(fn)" nil nil)
(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC) "\
Hook variable for CTCP DCC queries")
(autoload 'erc-ctcp-query-DCC "erc-dcc" "\
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.
\(fn PROC NICK LOGIN HOST TO QUERY)" nil nil)
;;;***
;;;### (autoloads (erc-ezb-initialize erc-ezb-select-session erc-ezb-select
;;;;;; erc-ezb-add-session erc-ezb-end-of-session-list erc-ezb-init-session-list
;;;;;; erc-ezb-identify erc-ezb-notice-autodetect erc-ezb-lookup-action
;;;;;; erc-ezb-get-login erc-cmd-ezb) "erc-ezbounce" "erc-ezbounce.el"
;;;;;; (18331 42201))
;;; Generated autoloads from erc-ezbounce.el
(autoload 'erc-cmd-ezb "erc-ezbounce" "\
Send EZB commands to the EZBouncer verbatim.
\(fn LINE &optional FORCE)" nil nil)
(autoload 'erc-ezb-get-login "erc-ezbounce" "\
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.
\(fn SERVER PORT)" nil nil)
(autoload 'erc-ezb-lookup-action "erc-ezbounce" "\
Not documented
\(fn MESSAGE)" nil nil)
(autoload 'erc-ezb-notice-autodetect "erc-ezbounce" "\
React on an EZBounce NOTICE request.
\(fn PROC PARSED)" nil nil)
(autoload 'erc-ezb-identify "erc-ezbounce" "\
Identify to the EZBouncer server.
\(fn MESSAGE)" nil nil)
(autoload 'erc-ezb-init-session-list "erc-ezbounce" "\
Reset the EZBounce session list to nil.
\(fn MESSAGE)" nil nil)
(autoload 'erc-ezb-end-of-session-list "erc-ezbounce" "\
Indicate the end of the EZBounce session listing.
\(fn MESSAGE)" nil nil)
(autoload 'erc-ezb-add-session "erc-ezbounce" "\
Add an EZBounce session to the session list.
\(fn MESSAGE)" nil nil)
(autoload 'erc-ezb-select "erc-ezbounce" "\
Select an IRC server to use by EZBounce, in ERC style.
\(fn MESSAGE)" nil nil)
(autoload 'erc-ezb-select-session "erc-ezbounce" "\
Select a detached EZBounce session.
\(fn)" nil nil)
(autoload 'erc-ezb-initialize "erc-ezbounce" "\
Add EZBouncer convenience functions to ERC.
\(fn)" nil nil)
;;;***
;;;### (autoloads (erc-fill) "erc-fill" "erc-fill.el" (18331 42202))
;;; Generated autoloads from erc-fill.el
(autoload 'erc-fill-mode "erc-fill" nil t)
(autoload 'erc-fill "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'.
\(fn)" nil nil)
;;;***
;;;### (autoloads nil "erc-hecomplete" "erc-hecomplete.el" (18331
;;;;;; 42202))
;;; Generated autoloads from erc-hecomplete.el
(autoload 'erc-hecomplete-mode "erc-hecomplete" nil t)
;;;***
;;;### (autoloads (erc-identd-stop erc-identd-start) "erc-identd"
;;;;;; "erc-identd.el" (18331 43816))
;;; Generated autoloads from erc-identd.el
(autoload 'erc-identd-mode "erc-identd")
(autoload 'erc-identd-start "erc-identd" "\
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.
\(fn &optional PORT)" t nil)
(autoload 'erc-identd-stop "erc-identd" "\
Not documented
\(fn &rest IGNORE)" t nil)
;;;***
;;;### (autoloads (erc-create-imenu-index) "erc-imenu" "erc-imenu.el"
;;;;;; (18331 42201))
;;; Generated autoloads from erc-imenu.el
(autoload 'erc-create-imenu-index "erc-imenu" "\
Not documented
\(fn)" nil nil)
;;;***
;;;### (autoloads nil "erc-join" "erc-join.el" (18331 42201))
;;; Generated autoloads from erc-join.el
(autoload 'erc-autojoin-mode "erc-join" nil t)
;;;***
;;;### (autoloads nil "erc-list" "erc-list.el" (18331 42282))
;;; Generated autoloads from erc-list.el
(autoload 'erc-list-mode "erc-list")
;;;***
;;;### (autoloads (erc-chanlist erc-list-channels) "erc-list-old"
;;;;;; "erc-list-old.el" (18329 17849))
;;; Generated autoloads from erc-list-old.el
(autoload 'erc-list-old-mode "erc-list-old")
(autoload 'erc-list-channels "erc-list-old" "\
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).
\(fn &rest CHANNEL)" t nil)
(autoload 'erc-chanlist "erc-list-old" "\
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.
\(fn &optional CHANNELS)" t nil)
;;;***
;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log"
;;;;;; "erc-log.el" (18331 42202))
;;; Generated autoloads from erc-log.el
(autoload 'erc-log-mode "erc-log" nil t)
(autoload 'erc-logging-enabled "erc-log" "\
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.
\(fn &optional BUFFER)" nil nil)
(autoload 'erc-save-buffer-in-logs "erc-log" "\
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'.
\(fn &optional BUFFER)" t nil)
;;;***
;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host
;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool
;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc-match.el" (18331
;;;;;; 42201))
;;; Generated autoloads from erc-match.el
(autoload 'erc-match-mode "erc-match")
(autoload 'erc-add-pal "erc-match" "\
Add pal interactively to `erc-pals'.
\(fn)" t nil)
(autoload 'erc-delete-pal "erc-match" "\
Delete pal interactively to `erc-pals'.
\(fn)" t nil)
(autoload 'erc-add-fool "erc-match" "\
Add fool interactively to `erc-fools'.
\(fn)" t nil)
(autoload 'erc-delete-fool "erc-match" "\
Delete fool interactively to `erc-fools'.
\(fn)" t nil)
(autoload 'erc-add-keyword "erc-match" "\
Add keyword interactively to `erc-keywords'.
\(fn)" t nil)
(autoload 'erc-delete-keyword "erc-match" "\
Delete keyword interactively to `erc-keywords'.
\(fn)" t nil)
(autoload 'erc-add-dangerous-host "erc-match" "\
Add dangerous-host interactively to `erc-dangerous-hosts'.
\(fn)" t nil)
(autoload 'erc-delete-dangerous-host "erc-match" "\
Delete dangerous-host interactively to `erc-dangerous-hosts'.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "erc-menu" "erc-menu.el" (18331 42201))
;;; Generated autoloads from erc-menu.el
(autoload 'erc-menu-mode "erc-menu" nil t)
;;;***
;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc-netsplit.el"
;;;;;; (18331 42201))
;;; Generated autoloads from erc-netsplit.el
(autoload 'erc-netsplit-mode "erc-netsplit")
(autoload 'erc-cmd-WHOLEFT "erc-netsplit" "\
Show who's gone.
\(fn)" nil nil)
;;;***
;;;### (autoloads (erc-server-select erc-determine-network) "erc-networks"
;;;;;; "erc-networks.el" (18331 42201))
;;; Generated autoloads from erc-networks.el
(autoload 'erc-determine-network "erc-networks" "\
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'.
\(fn)" nil nil)
(autoload 'erc-server-select "erc-networks" "\
Interactively select a server to connect to using `erc-server-alist'.
\(fn)" t nil)
;;;***
;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify"
;;;;;; "erc-notify.el" (18331 42201))
;;; Generated autoloads from erc-notify.el
(autoload 'erc-notify-mode "erc-notify" nil t)
(autoload 'erc-cmd-NOTIFY "erc-notify" "\
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.
\(fn &rest ARGS)" nil nil)
(autoload 'pcomplete/erc-mode/NOTIFY "erc-notify" "\
Not documented
\(fn)" nil nil)
;;;***
;;;### (autoloads nil "erc-page" "erc-page.el" (18331 42201))
;;; Generated autoloads from erc-page.el
(autoload 'erc-page-mode "erc-page")
;;;***
;;;### (autoloads nil "erc-pcomplete" "erc-pcomplete.el" (18331 42201))
;;; Generated autoloads from erc-pcomplete.el
(autoload 'erc-completion-mode "erc-pcomplete" nil t)
;;;***
;;;### (autoloads nil "erc-replace" "erc-replace.el" (18331 42201))
;;; Generated autoloads from erc-replace.el
(autoload 'erc-replace-mode "erc-replace")
;;;***
;;;### (autoloads nil "erc-ring" "erc-ring.el" (18331 42202))
;;; Generated autoloads from erc-ring.el
(autoload 'erc-ring-mode "erc-ring" nil t)
;;;***
;;;### (autoloads (erc-nickserv-identify erc-nickserv-identify-mode)
;;;;;; "erc-services" "erc-services.el" (18331 42201))
;;; Generated autoloads from erc-services.el
(autoload 'erc-services-mode "erc-services" nil t)
(autoload 'erc-nickserv-identify-mode "erc-services" "\
Set up hooks according to which MODE the user has chosen.
\(fn MODE)" t nil)
(autoload 'erc-nickserv-identify "erc-services" "\
Send an \"identify <PASSWORD>\" 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")
;;;***

290
lisp/erc-autoaway.el Normal file
View File

@ -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 <forcer@forcix.cx>
;; 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

1967
lisp/erc-backend.el Normal file

File diff suppressed because it is too large Load Diff

269
lisp/erc-bbdb.el Normal file
View File

@ -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 <asf@void.at>
;; Maintainer: Mario Lang <mlang@delysid.org>
;; 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 <asf@void.at> wrote zenirc-bbdb-whois.el, which was
;; adapted for ERC by Mario Lang <mlang@delysid.org>.
;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
;; 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

537
lisp/erc-button.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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)
("<URL: *\\([^<> ]+\\) *>" 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 "<button2>") 'erc-button-click-button)
(define-key map (kbd "<mouse-2>") 'erc-button-click-button))
(define-key map (kbd "TAB") 'erc-button-next)
(define-key map (kbd "<backtab>") '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 "<backtab>") '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 <URL: > 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 "<URL: ")))
(let ((pos (copy-marker from)))
(while (> (- 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

208
lisp/erc-capab.el Normal file
View File

@ -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 <http://freenode.net/faq.shtml#spoofing> and
;; <http://freenode.net/faq.shtml#registering> 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

181
lisp/erc-chess.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

446
lisp/erc-compat.el Normal file
View File

@ -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 <alex@gnu.org>
;; 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

1186
lisp/erc-dcc.el Normal file

File diff suppressed because it is too large Load Diff

180
lisp/erc-ezbounce.el Normal file
View File

@ -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 <asf@void.at>
;; 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 <server> 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

198
lisp/erc-fill.el Normal file
View File

@ -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 <asf@void.at>
;; Mario Lang <mlang@delysid.org>
;; 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:
<shortnick> this is a very very very long message with no
meaning at all
Variable Filling with an `erc-fill-prefix' of four spaces:
<shortnick> this is a very very very long message with no
meaning at all
Static Filling with `erc-fill-static-center' of 27:
<shortnick> foo bar baz
<a-very-long-nick> foo bar baz quuuuux
<shortnick> 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 <nickname> 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

576
lisp/erc-goodies.el Normal file
View File

@ -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 <forcer@forcix.cx>
;; 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

225
lisp/erc-hecomplete.el Normal file
View File

@ -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 <alex@gnu.org>
;; 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

195
lisp/erc-ibuffer.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

127
lisp/erc-identd.el Normal file
View File

@ -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 <johnw@gnu.org>
;; 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

138
lisp/erc-imenu.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

139
lisp/erc-join.el Normal file
View File

@ -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 <alex@gnu.org>
;; 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

213
lisp/erc-lang.el Normal file
View File

@ -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 <alex@gnu.org>
;; Maintainer: Alex Schroeder <alex@gnu.org>
;; 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
<ftp://dkuug.dk/i18n/ISO_639>
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

416
lisp/erc-list-old.el Normal file
View File

@ -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 <mlang@lexx.delysid.org>
;; 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

229
lisp/erc-list.el Normal file
View File

@ -0,0 +1,229 @@
;;; erc-list.el --- /list support for ERC
;; Copyright (C) 2008 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; 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

456
lisp/erc-log.el Normal file
View File

@ -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 <wence@gmx.li>
;; 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

3
lisp/erc-maint.el Normal file
View File

@ -0,0 +1,3 @@
(add-to-list 'load-path ".")
;; arch-tag: 977c5231-16c4-46d2-88f0-90abe5a79ba1

640
lisp/erc-match.el Normal file
View File

@ -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 <asf@void.at>
;; 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

154
lisp/erc-menu.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

214
lisp/erc-netsplit.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

870
lisp/erc-networks.el Normal file
View File

@ -0,0 +1,870 @@
;;; erc-networks.el --- IRC networks
;; Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
;; 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

222
lisp/erc-nick-notify.el Normal file
View File

@ -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 "\\("
"\\(<\\([^>]*\\)>\\)" ; <someone>
"\\|"
;; 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 "<b>&lt;" (match-string-no-properties 3)
"&gt;</b> "))
(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

416
lisp/erc-nicklist.el Normal file
View File

@ -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 <wence@gmx.li>
;; 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 <edgar.goncalves@inesc-id.pt>
;; 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 "<down-mouse-3>") '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

254
lisp/erc-notify.el Normal file
View File

@ -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 <mlang@lexx.delysid.org>
;; 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

114
lisp/erc-page.el Normal file
View File

@ -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

284
lisp/erc-pcomplete.el Normal file
View File

@ -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 <sacha@free.net.ph>
;; 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

99
lisp/erc-replace.el Normal file
View File

@ -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 <asf@void.at>
;; 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

149
lisp/erc-ring.el Normal file
View File

@ -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 <alex@gnu.org>
;; 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

95
lisp/erc-sasl.el Normal file
View File

@ -0,0 +1,95 @@
;; erc-sasl.el -- handle SASL PLAIN authentication
;; Copyright (C) 2012 Joseph Gay
;; Author: Joseph Gay <ysph@psy.ai>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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:

445
lisp/erc-services.el Normal file
View File

@ -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-<password>"
"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-<password>"
"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-<password>"
"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-<password>"
"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 <PASSWORD>\" 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

152
lisp/erc-sound.el Normal file
View File

@ -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

230
lisp/erc-speak.el Normal file
View File

@ -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

371
lisp/erc-speedbar.el Normal file
View File

@ -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 <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <eric@siege-engine.com>
;; 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

112
lisp/erc-spelling.el Normal file
View File

@ -0,0 +1,112 @@
;;; erc-spelling.el --- use flyspell in ERC
;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; 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

427
lisp/erc-stamp.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

1074
lisp/erc-track.el Normal file

File diff suppressed because it is too large Load Diff

121
lisp/erc-truncate.el Normal file
View File

@ -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 <asf@void.at>
;; 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

74
lisp/erc-viper.el Normal file
View File

@ -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 <ted@oconnor.cx>
;; 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

141
lisp/erc-xdcc.el Normal file
View File

@ -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 <mlang@delysid.org>
;; 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

6520
lisp/erc.el Normal file

File diff suppressed because it is too large Load Diff

135
lisp/org-notmuch.el Normal file
View File

@ -0,0 +1,135 @@
;;; org-notmuch.el --- Support for links to notmuch messages from within Org-mode
;; Copyright (C) 2010-2014 Matthieu Lemerre
;; Author: Matthieu Lemerre <racin@free.fr>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file implements links to notmuch messages and "searchs". A
;; search is a query to be performed by notmuch; it is the equivalent
;; to folders in other mail clients. Similarly, mails are refered to
;; by a query, so both a link can refer to several mails.
;; Links have one the following form
;; notmuch:<search terms>
;; notmuch-search:<search terms>.
;; The first form open the queries in notmuch-show mode, whereas the
;; second link open it in notmuch-search mode. Note that queries are
;; performed at the time the link is opened, and the result may be
;; different from whet the link was stored.
;;; Code:
(require 'org)
;; customisable notmuch open functions
(defcustom org-notmuch-open-function
'org-notmuch-follow-link
"Function used to follow notmuch links.
Should accept a notmuch search string as the sole argument."
:group 'org-notmuch
:version "24.4"
:package-version '(Org . "8.0")
:type 'function)
(defcustom org-notmuch-search-open-function
'org-notmuch-search-follow-link
"Function used to follow notmuch-search links.
Should accept a notmuch search string as the sole argument."
:group 'org-notmuch
:version "24.4"
:package-version '(Org . "8.0")
:type 'function)
;; Install the link type
(org-link-set-parameters "notmuch"
:follow #'org-notmuch-open
:store #'org-notmuch-store-link)
(defun org-notmuch-store-link ()
"Store a link to a notmuch search or message."
(when (eq major-mode 'notmuch-show-mode)
(let* ((message-id (notmuch-show-get-message-id t))
(subject (notmuch-show-get-subject))
(to (notmuch-show-get-to))
(from (notmuch-show-get-from))
(date (org-trim (notmuch-show-get-date)))
desc link)
(org-store-link-props :type "notmuch" :from from :to to :date date
:subject subject :message-id message-id)
(setq desc (org-email-link-description))
(setq link (concat "notmuch:id:" message-id))
(org-add-link-props :link link :description desc)
link)))
(defun org-notmuch-open (path)
"Follow a notmuch message link specified by PATH."
(funcall org-notmuch-open-function path))
(defun org-notmuch-follow-link (search)
"Follow a notmuch link to SEARCH.
Can link to more than one message, if so all matching messages are shown."
(require 'notmuch)
(notmuch-show search))
(org-link-set-parameters "notmuch-search"
:follow #'org-notmuch-search-open
:store #'org-notmuch-search-store-link)
(defun org-notmuch-search-store-link ()
"Store a link to a notmuch search or message."
(when (eq major-mode 'notmuch-search-mode)
(let ((link (concat "notmuch-search:"
(org-link-escape notmuch-search-query-string)))
(desc (concat "Notmuch search: " notmuch-search-query-string)))
(org-store-link-props :type "notmuch-search"
:link link
:description desc)
link)))
(defun org-notmuch-search-open (path)
"Follow a notmuch message link specified by PATH."
(message "%s" path)
(funcall org-notmuch-search-open-function path))
(defun org-notmuch-search-follow-link (search)
"Follow a notmuch link by displaying SEARCH in notmuch-search mode."
(require 'notmuch)
(notmuch-search (org-link-unescape search)))
(defun org-notmuch-tree-follow-link (search)
"Follow a notmuch link by displaying SEARCH in notmuch-tree mode."
(require 'notmuch)
(notmuch-tree (org-link-unescape search)))
(provide 'org-notmuch)
;;; org-notmuch.el ends here

651
lisp/sr-speedbar.el Normal file
View File

@ -0,0 +1,651 @@
;;; sr-speedbar.el --- Same frame speedbar
;; Author: Sebastian Rose <sebastian_rose@gmx.de>
;; Maintainer: Sebastian Rose <sebastian_rose@gmx.de>
;; Peter Lunicks <plunix@users.sourceforge.net>
;; Copyright (C) 2008, 2009, Sebastian Rose, all rights reserved.
;; Copyright (C) 2008, 2009, Andy Stewart, all rights reserved.
;; Copyright (C) 2009, Peter Lunicks, all rights reversed.
;; Created: 2008
;; Version: 20161025
;; X-Original-Version: 0.1.10
;; Last-Updated: 2016-10-25
;; URL: http://www.emacswiki.org/emacs/download/sr-speedbar.el
;; Keywords: speedbar, sr-speedbar.el
;; Compatibility: GNU Emacs 22 ~ GNU Emacs 25
;;
;; Features required by this library:
;;
;; `speedbar' `advice' `cl'
;;
;;; 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:
;;
;; The sr-speedbar.el was created just because I could not believe what I
;; read on http://www.emacswiki.org/cgi-bin/wiki/Speedbar. They wrote there
;; that it is not possible to show the speedbar in the same frame. But, as
;; we all know, ecb had this already. So I started as some kind of joke :)
;; But when I found it useful and use it all the time.
;;
;; Now you type windows key with 's' (`s-s' in Emacs) will show the speedbar
;; in an extra window, same frame. You can customize the initial width of the
;; speedbar window.
;;
;; Below are commands you can use:
;;
;; `sr-speedbar-open' Open `sr-speedbar' window.
;; `sr-speedbar-close' Close `sr-speedbar' window.
;; `sr-speedbar-toggle' Toggle `sr-speedbar' window.
;; `sr-speedbar-select-window' Select `sr-speedbar' window.
;; `sr-speedbar-refresh-turn-on' Turn on refresh speedbar content.
;; `sr-speedbar-refresh-turn-off' Turn off refresh speedbar content.
;; `sr-speedbar-refresh-toggle' Toggle refresh speedbar content.
;;
;; Enjoy! ;)
;;
;;; Installation:
;;
;; Copy sr-speedbar.el to your load-path and add to your ~/.emacs
;;
;; (require 'sr-speedbar)
;; (global-set-key (kbd "s-s") 'sr-speedbar-toggle)
;;
;; ... or any key binding you like.
;;
;;; Customize:
;;
;; M-x customize-group RET sr-speedbar RET
;;; Change log:
;; * 25 Oct 2016:
;; * Hong Xu <hong@topbug.net>
;; * Fix compilation warning when `helm-alive-p' is not defined.
;;
;; * 04 Aug 2015:
;; * Tamas Levai <levait@tmit.bme.hu>:
;; * fix compilation warnings
;;
;; * 15 Sep 2014:
;; * Tu, Do Hoang <tuhdo1710@gmail.com>
;; * define `sr-speedbar-handle-other-window-advice' and `ad-advised-definition-p'
;; before defining `sr-speedbar-skip-other-window-p'. Othewise, `sr-speedbar'
;; fails to load at this stage.
;;
;; * Do not used advised `pop-to-buffer' when helm window is
;; alive. Otherwise another horizontal buffer is created inside
;; Helm buffer.
;;
;; * Uwe Koloska <kolewu@koloro.de>
;; * define `ad-advised-definition-p' only if it's not defined
;; fixes an error on Emacs 24.3 where `macrop' ist still named
;; `ad-macro-p'
;;
;; * 03 Aug 2014:
;; * Reuben Thomas <rrt@sc3d.org>:
;; * Reduce to a single width preference, and make it work properly on
;; startup.
;; * Miscellaneous tidying of documentation and comments.
;; * Remove version constant; should be using the package header, and it
;; was already way out of date.
;;
;; * 08 Jun 2014:
;; * Gregor Zattler:
;; * test if symbol `ad-advised-definition-p' is defined,
;; since Christian Brassats version test failed on emacs
;; 23.3.91.1
;;
;; * 05 May 2014:
;; * Christian Brassat:
;; * `ad-advised-definition-p' is not supported since Emacs 24.4.
;;
;; * 09 Mar 2013:
;; * Tharre:
;; * Remove Emacs 21 compatibility code as it fails to compile on Emacs 24.
;;
;; * 20 July 2009:
;; * Peter Lunicks:
;; * Add new option `sr-speedbar-right-side' to control which
;; side of the frame the speedbar appears on.
;;
;; * 18 Feb 2009:
;; * Andy Stewart:
;; * Fix bug between ECB and `sr-speedbar-close'.
;;
;; * 29 Jan 2009:
;; * Andy Stewart:
;; * Fix doc.
;;
;; * 13 Jan 2009:
;; * Andy Stewart:
;; * Use `emacs-major-version' instead comment for Emacs 21 compatibility.
;; * Rewrite advice for `pop-to-buffer' to avoid `pop-to-buffer' not effect
;; when have many dedicated window in current frame.
;; * Rewrite advice for `delete-other-windows' to avoid use common variable
;; `delete-protected-window-list' and use `window-dedicated-p' instead.
;; Remove variable `delete-protected-window-list' and function
;; `sr-speedbar-dedicated-match-protected-window-p'.
;;
;; * 04 Jan 2009:
;; * Andy Stewart:
;; * Add new option `sr-speedbar-auto-refresh' control refresh content.
;; * Add new functions:
;; `sr-speedbar-refresh-turn-on',
;; `sr-speedbar-refresh-turn-off',
;; `sr-speedbar-refresh-toggle'.
;; * Fix doc.
;;
;; * 30 Dec 2008:
;; * Andy Stewart:
;; * Rewrite advice for `delete-other-windows' for fix the bug
;; with window configuration save and revert.
;; * Rewrite advice for `delete-window', now just remember window
;; width before deleted, and can use `delete-window' do same effect
;; as command `sr-speedbar-close'.
;; * Add new option `sr-speedbar-max-width'.
;; Remember window width before hide, except larger than value of
;; `sr-speedbar-max-width'.
;; * Add new variable `delete-protected-window-list', for protected
;; special window don't deleted.
;; This variable is common for any extension that use dedicated
;; window.
;; * Fix doc.
;;
;; * 29 Dec 2008:
;; * Andy Stewart:
;; * Pick-up and refactory code that use `buffer-live-p' or `window-live-p',
;; and replace with `sr-speedbar-buffer-exist-p' and
;; `sr-speedbar-window-exist-p'.
;; * Rename some function with prefix `sr-speedbar-' to avoid
;; conflict with other functions.
;; * Pick-up the code that handle advice for `other-window',
;; and replace with function `sr-speedbar-handle-other-window-advice'.
;; * Clean up code, make more clear.
;;
;; * 21 Dec 2008:
;; * Andy Stewart:
;; * Fix the bug `sr-speedbar-open' and `sr-speedbar-close'.
;; * Fix doc.
;;
;; * 20 Dec 2008
;; * Andy Stewart:
;; * Fix `ad-advised-definition-p' error.
;; * Fix doc.
;;
;; * 17 Dec 2008
;; * Andy Stewart:
;; * Add new option `sr-speedbar-skip-other-window-p' and new advice
;; for `other-window', make user skip select `sr-speedbar' window
;; when use command `other-window'.
;; * Fix the name of advice, make more clear.
;; * Fix the bug `sr-speedbar-select-window' when no live window exist.
;; * Fix doc.
;;
;; * 16 Dec 2008:
;; * Andy Stewart:
;; * Fix the bug of `sr-speedbar-refresh', use `default-directory'
;; get refresh directory instead through function in `dired'.
;; * Fix `window-live-p' bug, check window valid value before use
;; `window-live-p' test `sr-speedbar-window'.
;; * Fix `buffer-live-p' bug, check buffer valid value before use
;; `buffer-live-p' test `speedbar-buffer'.
;; * Add advice `pop-to-buffer' to make function `display-buffer'
;; can pop-up window when just have two windows (one is `sr-speedbar'
;; window) in current frame.
;; * Add group `sr-speedbar'.
;; More better customize interface through `customize-group'.
;;
;; * 28 Sep 2008:
;; * Andy Stewart:
;; * Fix a bug, when `sr-speedbar-toggle' many times, window width
;; will increment automatically.
;; * Use around advices replace, make code simple.
;; * Use `sr-speedbar-open' replace `sr-speedbar-no-separate-frame'.
;; * Clean up code.
;;
;; * 28 Sep 2008:
;; * Sebastian:
;; * set `sr-speedbar-delete-windows' to nil to avoid
;; the removal of other windows.
;;
;; * 26 Jun 2008:
;; * Sebastian:
;; * Added Andy Stewart's patch to refresh the speedbar's contents.
;; Thanks for this one!
;;
;; * Init:
;; * Sebastian:
;; * Added some lines to get it working:
;; * splitting the window and remember it,
;; * changing the way speedbar finds a file.
;; * File view of speedbar is now working all right.
;; * C-x 1 in other window deletes speedbar-window, just calling
;; M-x sr-speedbar-no-separate-frame again is fine now.
;; * Toggle speedbar works, width is save when toggling.
;; * Recalculate speedbar width if window-width - speedbar-width <= 0
;; * Speedbar window is now dedicated to speedbar-buffer.
;;
;;; Acknowledgements:
;;
;; All emacsers ... :)
;;
;;; Bug
;;
;;
;;; TODO
;;
;;
;;
;;; Require
(require 'speedbar)
(require 'advice)
(require 'cl-lib)
(eval-when-compile
(require 'cl))
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; User Customization ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup sr-speedbar nil
"Same frame speedbar."
:group 'speedbar)
(defcustom sr-speedbar-default-width 40
"Initial width of `sr-speedbar-window' under window system."
:type 'integer
:group 'sr-speedbar)
(defcustom sr-speedbar-max-width 50
"The max width limit that window allowed.
Default, if hide `sr-speedbar' window will remember
window width, except the window width larger than
this value."
:type 'integer
:group 'sr-speedbar)
(defcustom sr-speedbar-auto-refresh t
"Automatically refresh speedbar content when changed directory.
Default is t."
:type 'boolean
:set (lambda (symbol value)
(set symbol value))
:group 'sr-speedbar)
(defcustom sr-speedbar-right-side t
"Show the speedbar to the right side of the current window.
If nil, the speedbar will appear on the left.
Default is t."
:type 'boolean
:set (lambda (symbol value)
(set symbol value))
:group 'sr-speedbar)
(defcustom sr-speedbar-delete-windows nil
"Allow the speedbar to delete other windows before showing up.
If nil, speedbar will not touch your window configuration.
Otherwise `delete-other-windows' will be called before showing
the speedbar.
Default is nil."
:type 'boolean
:group 'sr-speedbar)
(if (not (fboundp 'ad-advised-definition-p))
(defun ad-advised-definition-p (definition)
"Return non-nil if DEFINITION was generated from advice information."
(if (or (ad-lambda-p definition)
(macrop definition)
(ad-compiled-p definition))
(let ((docstring (ad-docstring definition)))
(and (stringp docstring)
(get-text-property 0 'dynamic-docstring-function docstring))))))
(defun sr-speedbar-handle-other-window-advice (activate)
"Handle advice for function `other-window'.
If ACTIVATE is `non-nil' enable advice `sr-speedbar-other-window-advice'.
Otherwise disable it."
(if activate
(ad-enable-advice 'other-window 'after 'sr-speedbar-other-window-advice)
(ad-disable-advice 'other-window 'after 'sr-speedbar-other-window-advice))
(ad-activate 'other-window))
(defcustom sr-speedbar-skip-other-window-p nil
"Whether skip `sr-speedbar' window with `other-window'.
Default, can use `other-window' select window in cyclic
ordering of windows. But sometimes we don't want select
`sr-speedbar' window use `other-window'.
Just want make `sr-speedbar' window as a view sidebar.
So please turn on this option if you want skip
`sr-speedbar' window with `other-window'.
Default is nil."
:type 'boolean
:set (lambda (symbol value)
(set symbol value)
(if (fboundp 'ad-advised-definition-p)
(when (ad-advised-definition-p 'other-window)
(sr-speedbar-handle-other-window-advice value))
(when (ad-is-advised 'other-window)
(sr-speedbar-handle-other-window-advice value))))
:group 'sr-speedbar)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Constant ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst sr-speedbar-buffer-name "*SPEEDBAR*"
"The buffer name of sr-speedbar.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar sr-speedbar-width sr-speedbar-default-width
"Initial width of speedbar-window.")
(defvar sr-speedbar-window nil
"Speedbar window.")
(defvar sr-speedbar-last-refresh-dictionary nil
"The last refresh dictionary record of 'sr-speedbar-refresh'.")
(eval-when-compile
(defvar ecb-activated-window-configuration nil)
(defun ecb-activate ())
(defun ecb-deactivate ()))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun sr-speedbar-toggle ()
"Toggle sr-speedbar window.
Toggle visibility of sr-speedbar by resizing
the `sr-speedbar-window' to a minimal width
or the last width when visible.
Use this function to create or toggle visibility
of a speedbar-window. It will be created if necessary."
(interactive)
(if (sr-speedbar-exist-p)
(sr-speedbar-close)
(sr-speedbar-open)))
;;;###autoload
(defun sr-speedbar-open ()
"Create `sr-speedbar' window."
(interactive)
(if (not (sr-speedbar-exist-p))
(let ((current-window (selected-window)))
;; Ensure only one window is there
;; when `sr-speedbar-delete-windows' is non-nil
(if sr-speedbar-delete-windows
(delete-other-windows))
;; Whether activate `other-window' advice
;; to skip `sr-speedbar' window when use `other-window'.
(sr-speedbar-handle-other-window-advice sr-speedbar-skip-other-window-p)
;; Switch buffer
(if (sr-speedbar-buffer-exist-p speedbar-buffer)
(unless (sr-speedbar-window-exist-p sr-speedbar-window)
(sr-speedbar-get-window))
(if (<= (sr-speedbar-current-window-take-width) sr-speedbar-width)
(setq sr-speedbar-width sr-speedbar-default-width))
(sr-speedbar-get-window) ;get `sr-speedbar' window that split current window
(setq speedbar-buffer (get-buffer-create sr-speedbar-buffer-name)
speedbar-frame (selected-frame)
dframe-attached-frame (selected-frame)
speedbar-select-frame-method 'attached
speedbar-verbosity-level 0 ;don't say anything, i don't like ... :)
speedbar-last-selected-file nil)
(set-buffer speedbar-buffer)
(buffer-disable-undo speedbar-buffer) ;make disable in speedbar buffer, otherwise will occur `undo-outer-limit' error
(speedbar-mode)
(speedbar-reconfigure-keymaps)
(speedbar-update-contents)
(speedbar-set-timer 1)
;; Add speedbar hook.
(add-hook 'speedbar-before-visiting-file-hook 'sr-speedbar-before-visiting-file-hook t)
(add-hook 'speedbar-before-visiting-tag-hook 'sr-speedbar-before-visiting-tag-hook t)
(add-hook 'speedbar-visiting-file-hook 'sr-speedbar-visiting-file-hook t)
(add-hook 'speedbar-visiting-tag-hook 'sr-speedbar-visiting-tag-hook t)
;; Add `kill-buffer-hook'.
(add-hook 'kill-buffer-hook 'sr-speedbar-kill-buffer-hook) ;add `kill-buffer-hook'
;; Auto refresh speedbar content
;; if option `sr-speedbar-auto-refresh' is non-nil
(sr-speedbar-handle-auto-refresh sr-speedbar-auto-refresh))
(set-window-buffer sr-speedbar-window (get-buffer sr-speedbar-buffer-name))
(set-window-dedicated-p sr-speedbar-window t) ;make `sr-speedbar-window' dedicated to speedbar-buffer.
(select-window current-window))
(message "`sr-speedbar' window has exist.")))
(defun sr-speedbar-close ()
"Close `sr-speedbar' window and save window width."
(interactive)
(if (sr-speedbar-exist-p)
(let ((current-window (selected-window)))
;; Remember window width.
(sr-speedbar-select-window)
(sr-speedbar-remember-window-width)
;; Close window.
(if (and (require 'ecb nil t)
ecb-activated-window-configuration)
;; Toggle ECB window when ECB window activated.
(progn
(ecb-deactivate)
(ecb-activate))
;; Otherwise delete dedicated window.
(delete-window sr-speedbar-window)
(if (sr-speedbar-window-exist-p current-window)
(select-window current-window))))
(message "`sr-speedbar' window is not exist.")))
(defun sr-speedbar-select-window ()
"Force the windows that contain `sr-speedbar'."
(interactive)
(if (sr-speedbar-exist-p)
(select-window sr-speedbar-window)
(message "`sr-speedbar' window is not exist.")))
(defun sr-speedbar-refresh-turn-on ()
"Turn on refresh content automatically."
(interactive)
(setq sr-speedbar-auto-refresh t)
(sr-speedbar-handle-auto-refresh sr-speedbar-auto-refresh t))
(defun sr-speedbar-refresh-turn-off ()
"Turn off refresh content automatically."
(interactive)
(setq sr-speedbar-auto-refresh nil)
(sr-speedbar-handle-auto-refresh sr-speedbar-auto-refresh t))
(defun sr-speedbar-refresh-toggle ()
"Toggle refresh content status."
(interactive)
(setq sr-speedbar-auto-refresh (not sr-speedbar-auto-refresh))
(sr-speedbar-handle-auto-refresh sr-speedbar-auto-refresh t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; utilise functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sr-speedbar-exist-p ()
"Return `non-nil' if `sr-speedbar' is exist.
Otherwise return nil."
(and (sr-speedbar-buffer-exist-p speedbar-buffer)
(sr-speedbar-window-exist-p sr-speedbar-window)))
(defun sr-speedbar-window-p ()
"Return `non-nil' if current window is `sr-speedbar' window.
Otherwise return nil."
(equal sr-speedbar-buffer-name (buffer-name (window-buffer))))
(defun sr-speedbar-remember-window-width ()
"Remember window width."
(let ((win-width (sr-speedbar-current-window-take-width)))
(if (and (sr-speedbar-window-p)
(> win-width 1)
(<= win-width sr-speedbar-max-width))
(setq sr-speedbar-width win-width))))
(defun sr-speedbar-get-window ()
"Get `sr-speedbar' window."
(let ((current-window (selected-window))
;; Get split new window.
(new-window (split-window
(selected-window)
(if sr-speedbar-right-side
(- (sr-speedbar-current-window-take-width) sr-speedbar-width)
sr-speedbar-width)
t)))
;; Select split window.
(setq sr-speedbar-window
(if sr-speedbar-right-side
;; Select right window when `sr-speedbar-right-side' is enable.
new-window
;; Otherwise select left widnow.
current-window))))
(defun sr-speedbar-before-visiting-file-hook ()
"Function that hook `speedbar-before-visiting-file-hook'."
(select-window (previous-window)))
(defun sr-speedbar-before-visiting-tag-hook ()
"Function that hook `speedbar-before-visiting-tag-hook'."
(select-window (previous-window)))
(defun sr-speedbar-visiting-file-hook ()
"Function that hook `speedbar-visiting-file-hook'."
(select-window (previous-window)))
(defun sr-speedbar-visiting-tag-hook ()
"Function that hook `speedbar-visiting-tag-hook'."
(select-window (previous-window)))
(defun sr-speedbar-kill-buffer-hook ()
"Function that hook `kill-buffer-hook'."
(when (eq (current-buffer) speedbar-buffer)
(setq speedbar-frame nil
dframe-attached-frame nil
speedbar-buffer nil)
(speedbar-set-timer nil)
(remove-hook 'speedbar-before-visiting-file-hook 'sr-speedbar-before-visiting-file-hook)
(remove-hook 'speedbar-before-visiting-tag-hook 'sr-speedbar-before-visiting-tag-hook)
(remove-hook 'speedbar-visiting-file-hook 'sr-speedbar-visiting-file-hook)
(remove-hook 'speedbar-visiting-tag-hook 'sr-speedbar-visiting-tag-hook)))
(defun sr-speedbar-refresh ()
"Refresh the context of speedbar."
(when (and (not (equal default-directory sr-speedbar-last-refresh-dictionary)) ;if directory is change
(not (sr-speedbar-window-p))) ;and is not in speedbar buffer
(setq sr-speedbar-last-refresh-dictionary default-directory)
(speedbar-refresh)))
(defun sr-speedbar-handle-auto-refresh (activate &optional echo-show)
"Automatically refresh speedbar content when changed directory.
Do nothing if option ACTIVATE is nil.
Will display message if ECHO-SHOW is non-nil."
(if activate
(progn
(add-hook 'speedbar-timer-hook 'sr-speedbar-refresh)
(if echo-show (message "Turn on speedbar content refresh automatically.")))
(remove-hook 'speedbar-timer-hook 'sr-speedbar-refresh)
(if echo-show (message "Turn off speedbar content refresh automatically."))))
(defun sr-speedbar-current-window-take-width (&optional window)
"Return the width that WINDOW take up.
If WINDOW is nil, get current window."
(let ((edges (window-edges window)))
(- (nth 2 edges) (nth 0 edges))))
(defun sr-speedbar-window-dedicated-only-one-p ()
"Only have one non-dedicated window."
(interactive)
(let ((window-number 0)
(dedicated-window-number 0))
(walk-windows
(lambda (w)
(with-selected-window w
(incf window-number)
(if (window-dedicated-p w)
(incf dedicated-window-number)))))
(if (and (> dedicated-window-number 0)
(= (- window-number dedicated-window-number) 1))
t nil)))
(defun sr-speedbar-window-exist-p (window)
"Return `non-nil' if WINDOW is exist.
Otherwise return nil."
(and window (window-live-p window)))
(defun sr-speedbar-buffer-exist-p (buffer)
"Return `non-nil' if BUFFER is exist.
Otherwise return nil."
(and buffer (buffer-live-p buffer)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Advices ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defadvice delete-other-windows (around sr-speedbar-delete-other-window-advice activate)
"This advice to make `sr-speedbar' window can't deleted by command `delete-other-windows'."
(let ((sr-speedbar-active-p (sr-speedbar-window-exist-p sr-speedbar-window)))
(if sr-speedbar-active-p
(let ((current-window (selected-window)))
(dolist (win (window-list))
(when (and (window-live-p win)
(not (eq current-window win))
(not (window-dedicated-p win)))
(delete-window win))))
ad-do-it)))
(defadvice delete-window (before sr-speedbar-delete-window-advice activate)
"This advice to remember `sr-speedbar' window width before deleted.
Use `delete-window' delete `sr-speedbar' window have same effect as `sr-speedbar-close'."
;; Remember window width before deleted.
(sr-speedbar-remember-window-width))
(defadvice pop-to-buffer (before sr-speedbar-pop-to-buffer-advice activate)
"This advice is to fix `pop-to-buffer' problem with dedicated window.
Default, function `display-buffer' can't display buffer in select window
if current window is `dedicated'.
So function `display-buffer' conflict with `sr-speedbar' window, because
`sr-speedbar' window is `dedicated' window.
That is to say, when current frame just have one `non-dedicated' window,
any functions that use `display-buffer' can't split windows
to display buffer, even option `pop-up-windows' is enable.
And the example function that can occur above problem is `pop-to-buffer'."
(when (and pop-up-windows ;`pop-up-windows' is enable
(sr-speedbar-window-dedicated-only-one-p) ;just have one `non-dedicated' window
(sr-speedbar-window-exist-p sr-speedbar-window)
(not (sr-speedbar-window-p)) ;not in `sr-speedbar' window
(not (bound-and-true-p helm-alive-p)))
(split-window-vertically)
(windmove-down)))
(defadvice other-window (after sr-speedbar-other-window-advice)
"Default, can use `other-window' select window in cyclic ordering of windows.
But sometimes we don't want select `sr-speedbar' window use `other-window'.
Just want make `sr-speedbar' window as a view sidebar.
This advice can make `other-window' skip `sr-speedbar' window."
(let ((count (or (ad-get-arg 0) 1)))
(when (and (sr-speedbar-window-exist-p sr-speedbar-window)
(eq sr-speedbar-window (selected-window)))
(other-window count))))
(provide 'sr-speedbar)
;;; sr-speedbar.el ends here

2
org-journal.cache Normal file
View File

@ -0,0 +1,2 @@
#s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8125 data ("/home/gigavinyl/org/journal/20191215" (12 15 2019)))
#s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8125 data ("/home/gigavinyl/org/journal/20191215" (24054 28645 781744 617000)))

6
request/curl-cookie-jar Normal file
View File

@ -0,0 +1,6 @@
# Netscape HTTP Cookie File
# https://curl.haxx.se/docs/http-cookies.html
# This file was generated by libcurl! Edit at your own risk.
#HttpOnly_www.powerthesaurus.org FALSE / FALSE 0 yandex_metrika_switch 0
www.powerthesaurus.org FALSE / FALSE 1607535719 token 3d01500b31ad2e97e00b51d83362367e