;; -*- emacs-lisp -*- ;;; mst-erc.el --- emacs IRC Client configuration file ;; Author: Mark Triggs ;; $Id: mst-erc.el,v 1.252 2007/03/04 11:06:41 mst Exp $ ;; 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; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; These are various configuration hacks for ERC, the Emacs IRC client. Much ;; of the functionality here now comes as standard anyway. ;;; Code: ;; General settings ;; (require 'erc-stamp) (require 'erc-ring) (require 'erc-button) (require 'erc-dcc) (require 'erc-match) ;(require 'erc-nickserv) ;; (require 'erc-log) (require 'erc-bans) (require 'erc-print-names) (require 'op-friends) (when (fboundp 'erc-services-mode) (erc-services-mode)) (when (try-require 'escreen) (escreen-create-screen) (defvar erc-screen nil) (setq erc-screen escreen-current-screen-number) (let ((jump-to-erc '(lambda () (interactive) (escreen-goto-screen erc-screen) (unless (or (eq major-mode 'erc-mode) (eq major-mode 'erc-dcc-chat-mode)) (switch-to-buffer (find-if (lambda (b) (eq (buffer-mode b) 'erc-mode)) (buffer-list))))))) (define-key global-map [?\e f3] jump-to-erc) (define-key global-map [M-f3] jump-to-erc))) ;; (defadvice erc-cmd-WHOIS (before erc-mst-cmd-WHOIS activate) ;; (setq user (concat user " " user))) (defadvice erc-get-buffer-create (before erc-switch-to-erc-screen activate) (escreen-goto-screen erc-screen)) (defvar doterc-loaded-hook nil "A hook run after mst-erc has been loaded") (defvar erc-mst-suppress-line-regexp nil "A list of regular expressions matching lines that should not be displayed") ;; Timestamps (erc-timestamp-mode 1) ;; Nickserv (erc-nickserv-mode 1) (defstruct erc-mst-network name addresses nick description channels) (defun erc-find-server-network (server) (find-if (lambda (network) (member server (erc-mst-network-addresses network))) erc-mst-networks)) (defvar erc-mst-networks nil "IRC networks") (require 'erc-user-settings) ;; Logging (setq erc-enable-logging t erc-netsplit-regexp "^$" ; foil erc-netsplit.. erc-verbose-dcc nil erc-log-channels-directory "~/.irc/erc/" erc-email-userid "woobar" erc-timestamp-format "[%H:%M %d/%m/%y]" erc-save-buffer-on-part t erc-save-queries-on-quit t erc-generate-log-file-name-function 'erc-mst-log erc-track-exclude '("auth" "nickop" "root") erc-track-visibility nil erc-log-insert-log-on-open nil) (defun erc-track-find-face (faces) 'erc-mst-track-face) (defface erc-mst-track-face '((t (:foreground "#def"))) "erc tracking") (set-face-attribute 'erc-mst-track-face nil :weight 'bold) ;; User settings (setq erc-fill-column 100 erc-timestamp-right-column 105 erc-current-nick-highlight-type 'nick fill-column 100 erc-auto-query 'bury) ;; enable match mode (erc-match-mode 1) ;; Channel tracking (when (try-require 'erc-track) (erc-track-mode 1)) ;; Key bindings ;; (define-key erc-mode-map (kbd "C-c C-q") 'erc-mst-nuke-server) (define-key erc-mode-map (kbd "M-*") (lambda (&optional arg) (interactive "P") (insert-pair arg ?* ?*))) (defun erc-mst-nuke-server () (interactive) "Quit the current server and close all its windows" (save-some-buffers t (lambda () (when (and (eq major-mode 'erc-mode) buffer-file-name) t))) (let* ((quit-buffer (erc-server-buffer)) (reason (read-string "Reason?: "))) (erc-cmd-QUIT reason) (mapc (lambda (current) (set-buffer current) (when (equal (erc-server-buffer) quit-buffer) (kill-buffer nil))) (remove-if (lambda (x) (equal quit-buffer x)) (erc-buffer-list))) ;; Finally, kill the server buffer (kill-buffer quit-buffer))) (define-key erc-mode-map (kbd "M-.") (lambda () (interactive) (ignore-errors (erc-display-line-1 " " (current-buffer))) (recenter 1))) (define-key erc-mode-map (kbd "C-a") 'erc-maybe-bol) (define-key erc-mode-map (kbd "C-c b") 'erc-iswitchb) (defvar last-screen 0 "The last screen we were using") (defun erc-mst-track-next () (interactive) (unless (member (current-buffer) (erc-buffer-list)) (setq last-screen escreen-current-screen-number) (setq last-buffer (current-buffer))) (let ((modified-channels erc-modified-channels-alist)) (cond ((null modified-channels) (escreen-goto-screen last-screen) (when (eq major-mode 'erc-mode) ;; hmm.. Still here. (switch-to-buffer last-buffer))) (t (escreen-goto-screen erc-screen) ;; by switching to the erc screen, we may have already selected one of ;; the modified buffers. (unless (assoc (current-buffer) modified-channels) (let ((erc-track-last-non-erc-buffer nil)) (erc-track-switch-buffer 1))) (goto-char (point-max)))))) (define-key global-map (kbd "M-`") 'erc-mst-track-next) ;; who needs the scroll wheel anyway? (define-key global-map [mouse-4] 'erc-mst-track-next) ;; Hooks ;; ;; Munge input (add-hook 'erc-send-pre-hook 'erc-mst-munge-input) ;; Disable tracking for messages from the announced server (add-hook 'erc-server-004-hook 'erc-mst-server-004) ;; Auto-join channels (add-hook 'erc-after-connect 'erc-mst-autojoin) (defadvice erc-auto-query (around keep-buffer activate) (save-window-excursion ad-do-it)) ;; "end of names" (defun erc-mst-get-password (file) "Grab the first line of a file (used for passwords)" (with-temp-buffer (insert-file file) (remove (string-to-char "\n") (buffer-string)))) (defun erc-mst-join (proc parsed) "Joining a channel" (let* ((chnl (erc-response.contents parsed)) (sndr (erc-parse-user (erc-response.sender parsed))) (nick (car sndr))) (when (string= (erc-current-nick) nick) ;; I have joined the channel ;; If this is bitbee, login to stuff (when (and (string= chnl "&bitlbee") (string-match "localhost:6663" (buffer-name (erc-server-buffer)))) (erc-send-command (concat "PRIVMSG &bitlbee :identify " (erc-mst-get-password "~/.pass/bitlbeepass")) nil)))) nil) (add-hook 'erc-server-JOIN-functions 'erc-mst-join t nil) (when (try-require 'erc-fill) (add-hook 'erc-mode-hook (lambda () (erc-fill-mode 1)))) (add-hook 'erc-mode-hook (lambda () ;; find-file from erc should default to my home-dir (setq default-directory "~/") (when (fboundp 'erc-ring-mode) (erc-ring-mode 1)) (erc-button-mode 1) (set (make-variable-buffer-local 'coding-system-for-write) 'emacs-mule) ;; turn off fill mode in erc - erc has its own fill features (auto-fill-mode 0) (when (fboundp 'filladapt-mode) (filladapt-mode 0)))) ;; Functions ;; (defun erc-mst-log (buffer target nick server port) (downcase (format "%s/%s-%s.log" erc-log-channels-directory server target))) (defun erc-mst-autojoin (&optional server nick) "Autojoin any channels for the current server" (interactive) (let* ((buffer (car (split-string (buffer-name (erc-server-buffer)) ":"))) (channels (erc-mst-network-channels (erc-find-server-network buffer)))) (mapc (lambda (x) (cond ((string-match "^#" x) (erc-cmd-JOIN (car (split-string x)) ;; include the key if it was given (cadr (split-string x)))) (t (erc-cmd-QUERY x)))) channels))) (defun erc-maybe-bol () "Goto the end of `erc-prompt'. If already there, go to `beginning-of-line'." (interactive) (if (and (string-match (concat "^" (regexp-quote (erc-prompt)) " *$") (buffer-substring-no-properties (line-beginning-position) (point))) (not (bolp))) (beginning-of-line) (erc-bol))) (defalias 'erc-cmd-TALKTO 'erc-cmd-QUERY) (defun erc-cmd-CHOPS () "Request chanop to op me" (erc-send-command (format "PRIVMSG %s :OP %s %s" (erc-mst-channel-service) (erc-default-target) (erc-current-nick))) t) (defun erc-cmd-ID () "Identify to nickop" (erc-send-command (concat (format "PRIVMSG %s :IDENTIFY " (erc-mst-nick-service)) (erc-mst-get-password "~/.pass/ircpass"))) t) (defun erc-cmd-GHOST (nick) "kill a ghost" (unless (null nick) (erc-send-command (concat "PRIVMSG Nickop@austnet.org :KILL " nick " " (erc-mst-get-password "~/.pass/ircpass"))) t)) (defun erc-mst-channel-service () (if (eq (erc-mst-network) 'Astrolink) "ChanServ" "Chanop")) (defun erc-mst-nick-service () (if (eq (erc-mst-network) 'Astrolink) "NickServ" "Nickop@austnet.org")) (defun erc-mst-connect (details) (destructuring-bind (selection network) details (destructuring-bind (server &optional port) (split-string selection ":") (with-current-buffer (erc :server server :port (or port 6667) :nick (erc-mst-network-nick network)) (set (make-local-variable 'network-name) (erc-mst-network-name network)))))) (defun erc-mst-select () (interactive) (let* ((table (mapcan (lambda (network) (mapcar (lambda (s) (cons (if (erc-mst-network-description network) (format "%s (%s)" s (erc-mst-network-description network)) s) (list s network))) (erc-mst-network-addresses network))) erc-mst-networks))) (erc-mst-connect (cdr (assoc (completing-read "Server? " table nil t) table))))) (defun erc-mst-current-network-name () (with-current-buffer (erc-server-buffer) (if (boundp 'network-name) network-name nil))) ;; (defun erc-auto-query (proc parsed) ;; "Put this on `erc-server-PRIVMSG-hook'." ;; (when erc-auto-query ;; (let* ((nick (car (erc-parse-user (aref parsed 1)))) ;; (old-buffer erc-active-buffer) ;; (target (aref parsed 2)) ;; (msg (aref parsed 3)) ;; (query (if (not erc-query-on-unjoined-chan-privmsg) ;; nick ;; (if (string= (erc-downcase target) ;; (erc-downcase (erc-current-nick))) ;; nick ;; target)))) ;; (and (not (erc-ignored-user-p (aref parsed 1))) ;; (or erc-query-on-unjoined-chan-privmsg ;; (string= target (erc-current-nick))) ;; (not (erc-get-buffer query proc)) ;; (not (erc-is-message-ctcp-and-not-action-p msg)) ;; (erc-cmd-QUERY query) ;; (when (not erc-auto-query-jump) ;; (let ((faces (erc-faces-in (buffer-string)))) ;; (setq erc-modified-channels-alist ;; (cons (cons (current-buffer) ;; (cons 1 (erc-track-find-face faces))) ;; erc-modified-channels-alist))) ;; (switch-to-buffer old-buffer) ;; (erc-modified-channels-display)) ;; nil)))) (defvar erc-input-replacements nil "A list of pairs of the form (old . new) which will be used when substituting input lines. For example: '((\"apple\" . \"orange\"))") (defun erc-mst-replace-word-in-string (word replacement s) (let ((word-delim "[\\.-,:\"!' ]")) (replace-regexp-in-string (format "%s %s" word-delim word) replacement (replace-regexp-in-string (format "^%s%s" word word-delim) replacement s)))) (defun nuke-trailing-whitespace (s) (subseq s 0 (loop for i from (1- (length s)) downto 0 while (member (aref s i) (list (string-to-char " ") (string-to-char "\n"))) finally (return (1+ i))))) (defun erc-mst-munge-input (line) "Modify the line about to be sent" (setq str (copy-seq line)) (setq str (nuke-trailing-whitespace str)) (with-temp-buffer (insert (concat " "str " ")) (dolist (pair erc-input-replacements) (goto-char (point-min)) (while (search-forward (concat " " (car pair) " ") nil t) (replace-match (concat " " (cdr pair) " ") nil t))) (goto-char (point-min)) (delete-horizontal-space) (goto-char (point-max)) (delete-horizontal-space) (setq str (buffer-string))) ;; If we're using bitlbee, munge smileys. (let ((server (with-current-buffer (erc-server-buffer) erc-session-server))) (when (string= server "localhost") (mapc #'(lambda (pair) (let ((old (car pair)) (new (cdr pair))) (setq str (replace-regexp-in-string old new str)))) '((":o)" . ":)") (":o(" . ":(") (":oP" . ":P"))))) ;; Confirm when sending something that looks like it might be the erc prompt, ;; an intended command, stupidness or if something has been changed (above) (let ((case-fold-search nil) (prompt-regexp (reduce (lambda (x y) (concat x ".*" y)) (mapcar (lambda (x) (format "%c" x)) (string-to-list (erc-string-no-properties erc-prompt)))))) (when (or (string-match (concat prompt-regexp "\\|" "^ +/" "\\|" "^ *[^ ] *$") str) (and (not (string-match "^\\.\\.\\." str)) (string-match "^\\([^w ]\\)\\1\\1+" str))) (setq str (read-string "Please confirm: " str))))) ;; Pretty erc! ;; (when (not (featurep 'color-theme)) (try-require 'color-theme)) ;; Show idle time in whois ;; (defadvice erc-cmd-WHOIS (before erc-mst-cmd-WHOIS activate) ;; (setq user (concat user " " user))) (defun erc-mst-server-004 (proc parsed) "Disable tracking for messages from the announced server" (let ((server-name (aref parsed 3))) (setq erc-track-exclude (cons server-name erc-track-exclude))) nil) ;; helper defun to unfill lines that have been cut from elsewhere - Damo (defun erc-unfill () "Unfill the region after the prompt. Intended to be called just before you send a line" (interactive) (save-excursion (end-of-buffer) (goto-char (previous-single-property-change (point) 'erc-prompt)) (while (search-forward "\n" nil t) (delete-backward-char 1) (just-one-space)))) (defun erc-cmd-SPOOK () "Spook 'em" (erc-cmd-TOPIC (remove (string-to-char "\n") (with-temp-buffer (spook) (buffer-string))))) (defun erc-mst-save (beg end) "Save a region to the kill ring removing timestamps. If a prefix argument is used, remove nicknames too." (interactive "r") (flet ((message (&rest args) nil)) (kill-ring-save beg end) (with-temp-buffer (yank) (goto-char (point-min)) (end-of-line) (while (not (eobp)) (backward-char 1) (when (eq (get-face-at) 'erc-timestamp-face) (backward-up-list) (kill-sexp) (delete-horizontal-space)) (next-line) (end-of-line)) (kill-ring-save (point-min) (point-max))))) (define-key erc-mode-map (kbd "C-M-w") 'erc-mst-save) (defun erc-dcc-open-network-stream (procname buffer addr port entry) (open-network-stream procname buffer addr port)) (defadvice erc-display-line (around erc-mst-drop-lines activate) "A *really* blunt instrument for not showing certain lines" (unless (some #'(lambda (regexp) (string-match regexp string)) erc-mst-suppress-line-regexp) ad-do-it)) ;; This should always be at the end (when (boundp 'doterc-loaded-hook) (run-hooks 'doterc-loaded-hook)) (add-hook 'erc-dcc-chat-mode-hook (lambda () (auto-fill-mode -1) (filladapt-mode -1))) ;; Pretty-print nickname lists (used in conjunction with erc-print-names.el) (setq erc-p-n-filters '(erc-mst-sort-names erc-mst-show-nick-modes)) (setq erc-p-n-format-nicks-column-width 12) (defun erc-mst-sort-names (name-list) (let ((ops '()) (plebs '()) (voices '())) (mapc #'(lambda (entry) (cond ((erc-channel-user-op (caddr entry)) (push entry ops)) ((erc-channel-user-voice (caddr entry)) (push entry voices)) (t (push entry plebs)))) name-list) (mapcan #'(lambda (group) (sort group (lambda (entry1 entry2) (string< (car entry1) (car entry2))))) (list ops voices plebs)))) (defun erc-mst-show-nick-modes (name-list) (mapcar (lambda (entry) (cons (concat (cond ((erc-channel-user-op (caddr entry)) "@") ((erc-channel-user-voice (caddr entry)) "+") (t "")) (car entry)) (cdr entry))) name-list)) (defun erc-cmd-REFRESHUSERS () (with-current-buffer (erc-get-buffer (erc-default-target)) (setq erc-channel-users (make-hash-table :test 'equal)))) (set (make-local-variable 'pcomplete-default-completion-function) (lambda () (pcomplete-here (pcomplete-erc-nicks-from-bbdb)))) (defun get-nick-bbdb-record (nick) (find-if (lambda (record) (member nick (split-string (bbdb-get-field record 'screen-name) "[, ]" t))) (bbdb-records))) (defun nick-to-name (nick) (let ((record (get-nick-bbdb-record nick))) (if record (list (bbdb-get-field record 'nick) (car (split-string (bbdb-record-name record)))) nil))) (defun pcomplete-erc-nicks (&optional postfix) "Add people's first names to ERC's completion possibilities" (let ((users (erc-get-channel-user-list))) (if erc-pcomplete-order-nickname-completions (setq users (erc-sort-channel-users-by-activity users))) (let ((nicks (mapcan (lambda (user) (let ((nick (erc-server-user-nickname (car user)))) (cons nick (nick-to-name nick)))) users))) (mapcar (lambda (nick) (concat nick postfix)) nicks)))) ;; Send mail to people straight from ERC. (push (cons "Mail" '(let ((record (get-nick-bbdb-record nick))) (if record (bbdb-send-mail (get-nick-bbdb-record nick)) (error "No suitable record for %s" nick)))) erc-nick-popup-alist) (cond ((and (featurep 'color-theme)) ;; Tweak colours if we are running in a window system (set-face-foreground 'erc-timestamp-face "gray80") (set-face-foreground 'erc-direct-msg-face "#def") (set-face-foreground 'erc-prompt-face "#def") (set-face-background 'erc-prompt-face (face-background 'default)) (set-face-foreground 'erc-default-face "#def") (set-face-foreground 'erc-keyword-face "blue") ;; (set-face-foreground 'erc-input-face "#def") (set-face-foreground 'erc-input-face "gray75") (set-face-foreground 'erc-nick-msg-face "#def") (setq erc-nick-msg-face 'bold) (set-face-foreground 'erc-notice-face "#5080AA") (set-face-attribute 'erc-notice-face nil :weight 'normal)) (t (set-face-foreground 'erc-direct-msg-face "white") (set-face-foreground 'erc-default-face "white") (set-face-foreground 'erc-input-face "white") (set-face-foreground 'erc-timestamp-face "white") (setq erc-nick-msg-face 'bold) (set-face-foreground 'erc-nick-msg-face "white") (set-face-foreground 'erc-notice-face "white"))) (provide 'mst-erc)