Mercurial > emacs
changeset 66248:6914d742203d
New file.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Thu, 20 Oct 2005 16:51:41 +0000 |
| parents | 12c614f065b1 |
| children | 35d36d48eb91 |
| files | lisp/net/rcirc.el |
| diffstat | 1 files changed, 1722 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/rcirc.el Thu Oct 20 16:51:41 2005 +0000 @@ -0,0 +1,1722 @@ +;;; rcirc.el --- default, simple IRC client. + +;; Copyright (C) 2005 Free Software Foundation, Inc. + +;; Author: Ryan Yeske +;; X-RCS: $Id: rcirc.el,v 1.288 2005/10/18 06:47:23 rcyeske Exp $ +;; URL: http://www.nongnu.org/rcirc +;; Keywords: comm + +;; This file is not currently 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; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; rcirc is an Internet Relay Chat (IRC) client for Emacs + +;; IRC is a form of instant communication over the Internet. It is +;; mainly designed for group (many-to-many) communication in +;; discussion forums called channels, but also allows one-to-one +;; communication. + +;; Place this file in your `load-path' and add +;; (autoload 'rcirc "rcirc.el" "Connect to IRC." t) +;; to your .emacs +;; Open a new irc connection with: +;; M-x irc RET + +;;; Code: + +(require 'ring) +(require 'time-date) +(eval-when-compile (require 'cl)) + +(defvar rcirc-server "irc.freenode.net" + "The default server to connect to.") + +(defvar rcirc-port 6667 + "The default port to connect to.") + +(defvar rcirc-nick (user-login-name) + "Your nick.") + +(defvar rcirc-user-name (user-login-name) + "Your user name sent to the server when connecting.") + +(defvar rcirc-user-full-name (if (string= (user-full-name) "") + rcirc-user-name + (user-full-name)) + "The full name sent to the server when connecting.") + +(defvar rcirc-startup-channels-alist nil + "Alist of channels to join at startup. +Each element looks like (REGEXP . CHANNEL-LIST).") + +(defvar rcirc-fill-flag t + "*Non-nil means fill messages printed in channel buffers.") + +(defvar rcirc-fill-column nil + "*If non-nil, fill to this column, otherwise use value of `fill-column'.") + +(defvar rcirc-fill-prefix nil + "*Text to insert before filled lines. +If nil, calculate the prefix dynamically to line up text +underneath each nick.") + +(defvar rcirc-ignore-channel-activity nil + "If non-nil, ignore activity in this channel.") +(make-variable-buffer-local 'rcirc-ignore-channel-activity) + +(defvar rcirc-ignore-all-activity-flag nil + "*Non-nil means track activity, but do not display it in the modeline.") + +(defvar rcirc-time-format "%H:%M " + "*Describes how timestamps are printed. +Used as the first arg to `format-time-string'.") + +(defvar rcirc-input-ring-size 1024 + "*Size of input history ring.") + +(defvar rcirc-read-only-flag t + "*Non-nil means make text in irc buffers read-only.") + +(defvar rcirc-buffer-maximum-lines nil + "*The maximum size in lines for rcirc buffers. +Channel buffers are truncated from the top to be no greater than this +number. If zero or nil, no truncating is done.") + +(defvar rcirc-authinfo-file-name + "~/.rcirc-authinfo" + "File containing rcirc authentication passwords. +The file consists of a single list, with each element itself a +list with a SERVER-REGEXP string, a NICK-REGEXP string, a METHOD +and the remaining method specific ARGUMENTS. The valid METHOD +symbols are `nickserv', `chanserv' and `bitlbee'. + +The required ARGUMENTS for each METHOD symbol are: + `nickserv': PASSWORD + `chanserv': CHANNEL PASSWORD + `bitlbee': PASSWORD + +Example: + ((\"freenode\" \"bob\" nickserv \"p455w0rd\") + (\"freenode\" \"bob\" chanserv \"#bobland\" \"passwd99\") + (\"bitlbee\" \"robert\" bitlbee \"sekrit\"))") + +(defvar rcirc-auto-authenticate-flag (file-readable-p rcirc-authinfo-file-name) + "*Non-nil means automatically send authentication string to server. +See also `rcirc-authinfo-file-name'.") + +(defvar rcirc-print-hooks nil + "Hook run after text is printed. +Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT.") + +(defvar rcirc-prompt "%n> " + "Prompt string to use in irc buffers. + +The following replacements are made: +%n is your nick. +%s is the server. +%t is the buffer target, a channel or a user. + +Setting this alone will not affect the prompt; +use `rcirc-update-prompt' after changing this variable.") + +(defvar rcirc-prompt-start-marker nil) +(defvar rcirc-prompt-end-marker nil) + +(defvar rcirc-nick-table nil) + +(defvar rcirc-activity nil + "List of channels with unviewed activity.") + +(defvar rcirc-activity-string "" + "String displayed in modeline representing `rcirc-activity'.") +(put 'rcirc-activity-string 'risky-local-variable t) + +(defvar rcirc-process nil + "The server process associated with this buffer.") + +(defvar rcirc-target nil + "The channel or user associated with this buffer.") + +(defvar rcirc-channels nil + "Joined channels.") + +(defvar rcirc-private-chats nil + "Private chats open.") + +(defvar rcirc-urls nil + "List of urls seen in the current buffer.") + +(defvar rcirc-keepalive-seconds 60 + "Number of seconds between keepalive pings.") + + +(defun rcirc-version (&optional here) + "Return rcirc version string. +If optional argument HERE is non-nil, insert string at point." + (interactive "P") + (let ((version "rcirc.el 0.9 $Revision: 1.288 $")) + (if here + (insert version) + (if (interactive-p) + (message "%s" version) + version)))) + +(defvar rcirc-startup-channels nil) +;;;###autoload +(defun rcirc (&optional server port nick channels) + "Connect to IRC. + +If any of the the optional SERVER, PORT, NICK or CHANNELS are not +supplied, they are taken from the variables `rcirc-server', +`rcirc-port', `rcirc-nick', and `rcirc-startup-channels', +respectively." + (interactive (list (read-string "IRC Server: " rcirc-server) + (read-string "IRC Port: " (number-to-string rcirc-port)) + (read-string "IRC Nick: " rcirc-nick))) + (or server (setq server rcirc-server)) + (or port (setq port rcirc-port)) + (or nick (setq nick rcirc-nick)) + (or channels + (setq channels + (if (interactive-p) + (delete "" + (split-string + (read-string "Channels: " + (mapconcat 'identity + (rcirc-startup-channels server) + " ")) + "[, ]+")) + (rcirc-startup-channels server)))) + (or global-mode-string (setq global-mode-string '(""))) + (and (not (memq 'rcirc-activity-string global-mode-string)) + (setq global-mode-string + (append global-mode-string '(rcirc-activity-string)))) + (add-hook 'window-configuration-change-hook 'rcirc-update-activity) + (rcirc-connect server port nick rcirc-user-name rcirc-user-full-name + channels)) + +;;;###autoload +(defalias 'irc 'rcirc) + + +(defvar rcirc-process-output nil) +(defvar rcirc-last-buffer nil) +(defvar rcirc-topic nil) +(defvar rcirc-keepalive-timer nil) +(make-variable-buffer-local 'rcirc-topic) +(defun rcirc-connect (server port nick user-name full-name startup-channels) + "Return a connection to SERVER on PORT. + +User will identify using the values of NICK, USER-NAME and +FULL-NAME. The variable list of channel names in +STARTUP-CHANNELS will automatically be joined on startup." + (save-excursion + (message "Connecting to %s..." server) + (let* ((inhibit-eol-conversion) + (port-number (if (stringp port) + (string-to-number port) + port)) + (process (open-network-stream server nil server port-number))) + ;; set up process + (set-process-coding-system process 'raw-text 'raw-text) + (set-process-filter process 'rcirc-filter) + (switch-to-buffer (concat "*" (process-name process) "*")) + (set-process-buffer process (current-buffer)) + (set-process-sentinel process 'rcirc-sentinel) + (rcirc-mode process nil) + (make-local-variable 'rcirc-nick-table) + (setq rcirc-nick-table (make-hash-table :test 'equal)) + (make-local-variable 'rcirc-server) + (setq rcirc-server server) + (make-local-variable 'rcirc-nick) + (setq rcirc-nick nick) + (make-local-variable 'rcirc-process-output) + (setq rcirc-process-output nil) + (make-local-variable 'rcirc-last-buffer) + (setq rcirc-last-buffer (current-buffer)) + (make-local-variable 'rcirc-channels) + (setq rcirc-channels nil) + (make-local-variable 'rcirc-private-chats) + (setq rcirc-private-chats nil) + (make-local-variable 'rcirc-startup-channels) + (setq rcirc-startup-channels startup-channels) + + ;; identify + (rcirc-send-string process (concat "NICK " nick)) + (rcirc-send-string process (concat "USER " user-name + " hostname servername :" + full-name)) + + ;; setup ping timer if necessary + (unless rcirc-keepalive-timer + (setq rcirc-keepalive-timer + (run-at-time 0 rcirc-keepalive-seconds 'rcirc-keepalive))) + + (message "Connecting to %s...done" server) + + ;; return process object + process))) + +(defun rcirc-keepalive () + "Send keep alive pings to active rcirc processes." + (if (rcirc-process-list) + (mapc (lambda (process) + (with-current-buffer (process-buffer process) + (rcirc-send-string process (concat "PING " rcirc-server)))) + (rcirc-process-list)) + (cancel-timer rcirc-keepalive-timer) + (setq rcirc-keepalive-timer nil))) + +(defvar rcirc-log-buffer "*rcirc log*") +(defvar rcirc-log-p nil + "If non-nil, write information to `rcirc-log-buffer'.") +(defun rcirc-log (process text) + "Add an entry to the debug log including PROCESS and TEXT. +Debug text is written to `rcirc-log-buffer' if `rcirc-log-p' is +non-nil." + (when rcirc-log-p + (save-excursion + (save-window-excursion + (set-buffer (get-buffer-create rcirc-log-buffer)) + (goto-char (point-max)) + (insert (concat + "[" + (format-time-string "%Y-%m-%dT%T ") (process-name process) + "] " + text)))))) + +(defvar rcirc-sentinel-hooks nil + "Hook functions called when the process sentinel is called. +Functions are called with PROCESS and SENTINEL arguments.") + +(defun rcirc-sentinel (process sentinel) + "Called when PROCESS receives SENTINEL." + (let ((sentinel (replace-regexp-in-string "\n" "" sentinel))) + (rcirc-log process (format "SENTINEL: %S %S\n" process sentinel)) + (with-current-buffer (process-buffer process) + (dolist (target (append rcirc-channels + rcirc-private-chats + (list (current-buffer)))) + (rcirc-print process "rcirc.el" "ERROR" target + (format "%s: %s (%S)" + (process-name process) + sentinel + (process-status process)) t) + ;; remove the prompt from buffers + (with-current-buffer (if (eq target (current-buffer)) + (current-buffer) + (rcirc-get-buffer process target)) + (let ((inhibit-read-only t)) + (delete-region rcirc-prompt-start-marker + rcirc-prompt-end-marker))))) + (run-hook-with-args 'rcirc-sentinel-hooks process sentinel))) + +(defun rcirc-process-list () + "Return a list of rcirc processes." + (let (ps) + (mapc (lambda (p) + (when (process-buffer p) + (with-current-buffer (process-buffer p) + (when (eq major-mode 'rcirc-mode) + (setq ps (cons p ps)))))) + (process-list)) + ps)) + +(defvar rcirc-receive-message-hooks nil + "Hook functions run when a message is recieved from server. +Function is called with PROCESS COMMAND SENDER ARGS and LINE.") +(defun rcirc-filter (process output) + "Called when PROCESS receives OUTPUT." + (rcirc-log process output) + (with-current-buffer (process-buffer process) + (setq rcirc-process-output (concat rcirc-process-output output)) + (when (= (aref rcirc-process-output + (1- (length rcirc-process-output))) ?\n) + (mapc (lambda (line) + (rcirc-process-server-response process line)) + (delete "" (split-string rcirc-process-output "[\n\r]"))) + (setq rcirc-process-output nil)))) + +(defvar rcirc-trap-errors nil) +(defun rcirc-process-server-response (process text) + (if rcirc-trap-errors + (condition-case err + (rcirc-process-server-response-1 process text) + (error + (rcirc-print process "RCIRC" "ERROR" nil + (format "rcirc: error processing: \"%s\" %s" text err)))) + (rcirc-process-server-response-1 process text))) + +(defun rcirc-process-server-response-1 (process text) + (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text) + (let* ((sender (match-string 2 text)) + (cmd (match-string 3 text)) + (args (match-string 4 text)) + (handler (intern-soft (concat "rcirc-handler-" cmd)))) + (string-match "^\\([^:]*\\):?\\(.+\\)?$" args) + (let* ((args1 (match-string 1 args)) + (args2 (match-string 2 args)) + (args (append (delete "" (split-string args1 " ")) + (list args2)))) + (if (not (fboundp handler)) + (rcirc-handler-generic process cmd sender args text) + (funcall handler process sender args text)) + (run-hook-with-args 'rcirc-receive-message-hooks + process cmd sender args text))) + (message "UNHANDLED: %s" text))) + +(defun rcirc-handler-generic (process command sender args text) + "Generic server response handler." + (rcirc-print process sender command nil + (mapconcat 'identity (cdr args) " "))) + +(defun rcirc-send-string (process string) + "Send PROCESS a STRING plus a newline." + (let ((string (concat (encode-coding-string string + buffer-file-coding-system) + "\n"))) + (rcirc-log process string) + (process-send-string process string))) + +(defun rcirc-server (process) + "Return PROCESS server, given by the 001 response." + (with-current-buffer (process-buffer process) + rcirc-server)) + +(defun rcirc-nick (process) + "Return PROCESS nick." + (with-current-buffer (process-buffer process) + rcirc-nick)) + +(defvar rcirc-max-message-length 450 + "Messages longer than this value will be split.") + +(defun rcirc-send-message (process target message &optional noticep) + "Send TARGET associated with PROCESS a privmsg with text MESSAGE. +If NOTICEP is non-nil, send a notice instead of privmsg." + ;; max message length is 512 including CRLF + (let* ((response (if noticep "NOTICE" "PRIVMSG")) + (oversize (> (length message) rcirc-max-message-length)) + (text (if oversize + (substring message 0 rcirc-max-message-length) + message)) + (text (if (string= text "") + " " + text)) + (more (if oversize + (substring message rcirc-max-message-length)))) + (rcirc-print process (rcirc-nick process) response target text) + (rcirc-send-string process (concat response " " target " :" text)) + (if more + (rcirc-send-message process target more noticep)))) + +(defvar rcirc-input-ring nil) +(defvar rcirc-input-ring-index 0) +(defun rcirc-prev-input-string (arg) + (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg))) + +(defun rcirc-insert-prev-input (arg) + (interactive "p") + (when (<= rcirc-prompt-end-marker (point)) + (delete-region rcirc-prompt-end-marker (point-max)) + (insert (rcirc-prev-input-string 0)) + (setq rcirc-input-ring-index (1+ rcirc-input-ring-index)))) + +(defun rcirc-insert-next-input (arg) + (interactive "p") + (when (<= rcirc-prompt-end-marker (point)) + (delete-region rcirc-prompt-end-marker (point-max)) + (setq rcirc-input-ring-index (1- rcirc-input-ring-index)) + (insert (rcirc-prev-input-string -1)))) + +(defvar rcirc-nick-completions nil) +(defvar rcirc-nick-completion-start-offset nil) +(defun rcirc-complete-nick () + "Cycle through nick completions from list of nicks in channel." + (interactive) + (if (eq last-command 'rcirc-complete-nick) + (setq rcirc-nick-completions + (append (cdr rcirc-nick-completions) + (list (car rcirc-nick-completions)))) + (setq rcirc-nick-completion-start-offset + (- (save-excursion + (if (re-search-backward " " rcirc-prompt-end-marker t) + (1+ (point)) + rcirc-prompt-end-marker)) + rcirc-prompt-end-marker)) + (setq rcirc-nick-completions + (let ((completion-ignore-case t)) + (all-completions + (buffer-substring + (+ rcirc-prompt-end-marker + rcirc-nick-completion-start-offset) + (point)) + (mapcar (lambda (x) (cons x nil)) + (rcirc-channel-nicks rcirc-process + (rcirc-buffer-target))))))) + (let ((completion (car rcirc-nick-completions))) + (when completion + (delete-region (+ rcirc-prompt-end-marker + rcirc-nick-completion-start-offset) + (point)) + (insert (concat completion + (if (= (+ rcirc-prompt-end-marker + rcirc-nick-completion-start-offset) + rcirc-prompt-end-marker) + ": ")))))) + +(defun rcirc-buffer-target (&optional buffer) + "Return the name of target for BUFFER. +If buffer is nil, return the target of the current buffer." + (with-current-buffer (or buffer (current-buffer)) + rcirc-target)) + +(defvar rcirc-mode-map (make-sparse-keymap) + "Keymap for rcirc mode.") + +(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input) +(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input) +(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input) +(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick) +(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url) +(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline) +(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join) +(define-key rcirc-mode-map (kbd "C-c C-k") 'rcirc-cmd-kick) +(define-key rcirc-mode-map (kbd "C-c C-l") 'rcirc-cmd-list) +(define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode) +(define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg) +(define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename +(define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-cmd-oper) +(define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part) +(define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query) +(define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic) +(define-key rcirc-mode-map (kbd "C-c C-n") 'rcirc-cmd-names) +(define-key rcirc-mode-map (kbd "C-c C-w") 'rcirc-cmd-whois) +(define-key rcirc-mode-map (kbd "C-c C-x") 'rcirc-cmd-quit) +(define-key rcirc-mode-map (kbd "C-c TAB") ; C-i + 'rcirc-toggle-ignore-channel-activity) +(define-key rcirc-mode-map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer) +(define-key rcirc-mode-map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line) + +(define-key global-map (kbd "C-c `") 'rcirc-next-active-buffer) +(define-key global-map (kbd "C-c C-@") 'rcirc-next-active-buffer) +(define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer) + +(defvar rcirc-mode-hook nil + "Hook run when setting up rcirc buffer.") + +(defun rcirc-mode (process target) + "Major mode for irc channel buffers. + +\\{rcirc-mode-map}" + (kill-all-local-variables) + (use-local-map rcirc-mode-map) + (setq mode-name "rcirc") + (setq major-mode 'rcirc-mode) + + (make-local-variable 'rcirc-input-ring) + (setq rcirc-input-ring (make-ring rcirc-input-ring-size)) + (make-local-variable 'rcirc-process) + (setq rcirc-process process) + (make-local-variable 'rcirc-target) + (setq rcirc-target target) + (make-local-variable 'rcirc-urls) + (setq rcirc-urls nil) + (setq use-hard-newlines t) + (when (rcirc-channel-p rcirc-target) + (setq header-line-format 'rcirc-topic)) + + ;; setup the prompt and markers + (make-local-variable 'rcirc-prompt-start-marker) + (setq rcirc-prompt-start-marker (make-marker)) + (set-marker rcirc-prompt-start-marker (point-max)) + (make-local-variable 'rcirc-prompt-end-marker) + (setq rcirc-prompt-end-marker (make-marker)) + (set-marker rcirc-prompt-end-marker (point-max)) + (rcirc-update-prompt) + (goto-char rcirc-prompt-end-marker) + (make-local-variable 'overlay-arrow-position) + (setq overlay-arrow-position (make-marker)) + (set-marker overlay-arrow-position nil) + + (run-hooks 'rcirc-mode-hook)) + +(defun rcirc-update-prompt () + "Reset the prompt string in the current buffer." + (let ((inhibit-read-only t) + (prompt (or rcirc-prompt ""))) + (mapc (lambda (rep) + (setq prompt + (replace-regexp-in-string (car rep) (cdr rep) prompt))) + (list (cons "%n" (with-rcirc-process-buffer rcirc-process + rcirc-nick)) + (cons "%s" (with-rcirc-process-buffer rcirc-process + rcirc-server)) + (cons "%t" (or rcirc-target "")))) + (save-excursion + (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker) + (goto-char rcirc-prompt-start-marker) + (let ((start (point))) + (insert-before-markers prompt) + (set-marker rcirc-prompt-start-marker start) + (when (not (zerop (- rcirc-prompt-end-marker + rcirc-prompt-start-marker))) + (add-text-properties rcirc-prompt-start-marker + rcirc-prompt-end-marker + (list 'face 'rcirc-prompt-face + 'read-only t 'field t + 'front-sticky t 'rear-nonsticky t))))))) + +(defun rcirc-channel-p (target) + "Return t if TARGET is a channel name." + (and target + (not (zerop (length target))) + (or (eq (aref target 0) ?#) + (eq (aref target 0) ?&)))) + +(defun rcirc-kill-buffer-hook () + "Part the channel when killing an rcirc buffer." + (when (eq major-mode 'rcirc-mode) + (rcirc-clear-activity (current-buffer)) + (when (and rcirc-process + (eq (process-status rcirc-process) 'open)) + (if (rcirc-channel-p rcirc-target) + (rcirc-cmd-part "" rcirc-process rcirc-target) + ;; remove target from privchat list + (when rcirc-target + (let ((target (downcase rcirc-target))) + (with-rcirc-process-buffer rcirc-process + (setq rcirc-private-chats + (delete target rcirc-private-chats))))))))) +(add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook) + +(defun rcirc-get-buffer-name (process target) + "Return buffer name based on PROCESS and TARGET." + (concat (and target (downcase target)) "@" (process-name process))) + +(defun rcirc-get-buffer (process target &optional error) + "Return the buffer associated with the PROCESS and TARGET. +If TARGET is nil and ERROR is nil, return the process buffer." + (let ((buffer (and target + (get-buffer (rcirc-get-buffer-name process target))))) + (if (and buffer (buffer-live-p buffer)) + buffer + (if error + (error "Buffer associated with %s does not exist" target) + (process-buffer process))))) + +(defun rcirc-get-buffer-create (process target) + "Return the buffer named associated with the PROCESS and TARGET. +Create the buffer if it doesn't exist. If TARGET is nil, return +the process buffer." + (with-current-buffer (process-buffer process) + (if (not target) + (current-buffer) + (let ((target (downcase target))) + ;; add private chats to list. we dont add channels here, they + ;; are managed by the join/part/quit handlers + (when (and (not (rcirc-channel-p target)) + (not (member target rcirc-private-chats))) + (with-rcirc-process-buffer process + (setq rcirc-private-chats (cons target rcirc-private-chats)))) + ;; create and setup a buffer, or return the existing one + (let ((bufname (rcirc-get-buffer-name process target))) + (with-current-buffer (get-buffer-create bufname) + (if (or (not rcirc-process) + (not (equal (process-status rcirc-process) 'open))) + (rcirc-mode process target) + (setq rcirc-target target)) + (current-buffer))))))) + +(defun rcirc-send-input () + "Send input to target associated with the current buffer." + (interactive) + (if (not (eq (process-status rcirc-process) 'open)) + (error "Network connection to %s is not open" + (process-name rcirc-process)) + ;; update last buffer + (rcirc-set-last-buffer rcirc-process (current-buffer)) + (if (< (point) rcirc-prompt-end-marker) + ;; copy the line down to the input area + (progn + (forward-line 0) + (let ((start (if (eq (point) (point-min)) + (point) + (if (get-text-property (1- (point)) 'hard) + (point) + (previous-single-property-change (point) 'hard)))) + (end (next-single-property-change (1+ (point)) 'hard))) + (goto-char (point-max)) + (insert (replace-regexp-in-string + "\n\\s-+" " " + (buffer-substring-no-properties start end))))) + ;; assume text has been read + (when (marker-position overlay-arrow-position) + (set-marker overlay-arrow-position nil)) + ;; process input + (goto-char (point-max)) + (let ((target (rcirc-buffer-target)) + (start rcirc-prompt-end-marker)) + (when (not (equal 0 (- (point) start))) + ;; delete a trailing newline + (when (eq (point) (point-at-bol)) + (delete-backward-char 1)) + (let ((input (buffer-substring-no-properties + rcirc-prompt-end-marker (point)))) + ;; process a /cmd + (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input) + (let* ((command (match-string 1 input)) + (fun (intern-soft (concat "rcirc-cmd-" command))) + (args (match-string 2 input))) + (newline) + (with-current-buffer (current-buffer) + (delete-region rcirc-prompt-end-marker (point)) + (if (string= command "me") + (rcirc-print rcirc-process (rcirc-nick rcirc-process) + "ACTION" target args) + (rcirc-print rcirc-process (rcirc-nick rcirc-process) + "COMMAND" target input)) + (set-marker rcirc-prompt-end-marker (point)) + (if (fboundp fun) + (funcall fun args rcirc-process target) + (rcirc-send-string rcirc-process + (concat command " " args))))) + ;; send message to server + (if (not rcirc-target) + (message "Not joined") + (delete-region rcirc-prompt-end-marker (point)) + (mapc (lambda (message) + (rcirc-send-message rcirc-process target message)) + (split-string input "\n")))) + ;; add to input-ring + (save-excursion + (ring-insert rcirc-input-ring input) + (setq rcirc-input-ring-index 0)))))))) + +(defvar rcirc-parent-buffer nil) +(defvar rcirc-window-configuration nil) +(defun rcirc-edit-multiline () + "Move current edit to a dedicated buffer." + (interactive) + (let ((pos (1+ (- (point) rcirc-prompt-end-marker)))) + (goto-char (point-max)) + (let ((text (buffer-substring rcirc-prompt-end-marker (point))) + (parent (buffer-name)) + (process rcirc-process)) + (delete-region rcirc-prompt-end-marker (point)) + (setq rcirc-window-configuration (current-window-configuration)) + (pop-to-buffer (concat "*multiline " parent "*")) + (rcirc-multiline-edit-mode) + (setq rcirc-parent-buffer parent) + (setq rcirc-process process) + (insert text) + (and (> pos 0) (goto-char pos))))) + +(define-derived-mode rcirc-multiline-edit-mode + text-mode "rcirc multi" + "Major mode for multiline edits +\\{rcirc-multiline-edit-mode-map}" + (make-local-variable 'rcirc-parent-buffer) + (make-local-variable 'rcirc-process)) + +(define-key rcirc-multiline-edit-mode-map + (kbd "C-c C-c") 'rcirc-multiline-edit-submit) +(define-key rcirc-multiline-edit-mode-map + (kbd "C-x C-s") 'rcirc-multiline-edit-submit) +(define-key rcirc-multiline-edit-mode-map + (kbd "C-c C-k") 'rcirc-multiline-edit-cancel) +(define-key rcirc-multiline-edit-mode-map + (kbd "ESC ESC ESC") 'rcirc-multiline-edit-cancel) + +(defun rcirc-multiline-edit-submit () + "Send the text in buffer back to parent buffer." + (interactive) + (assert (and (eq major-mode 'rcirc-multiline-edit-mode))) + (assert rcirc-parent-buffer) + (let ((text (buffer-substring (point-min) (point-max))) + (buffer (current-buffer)) + (pos (point))) + (set-buffer rcirc-parent-buffer) + (goto-char (point-max)) + (insert text) + (goto-char (+ rcirc-prompt-end-marker (1- pos))) + (kill-buffer buffer) + (set-window-configuration rcirc-window-configuration))) + +(defun rcirc-multiline-edit-cancel () + "Cancel the multiline edit." + (interactive) + (assert (and (eq major-mode 'rcirc-multiline-edit-mode))) + (kill-buffer (current-buffer)) + (set-window-configuration rcirc-window-configuration)) + +(defun rcirc-last-buffer (process) + "Return the last working buffer for PROCESS. +Used for displaying messages that don't have an explicit destination." + (with-current-buffer (process-buffer process) + (or (and rcirc-last-buffer + (buffer-live-p rcirc-last-buffer) + rcirc-last-buffer) + (current-buffer)))) + +(defun rcirc-set-last-buffer (process buffer) + "Set the last working buffer for PROCESS to BUFFER." + (with-current-buffer (process-buffer process) + (setq rcirc-last-buffer buffer))) + +(defmacro with-rcirc-process-buffer (process &rest body) + (declare (indent 1) (debug t)) + `(with-current-buffer (process-buffer ,process) + ,@body)) + +(defun rcirc-format-response-string (process sender response target text) + (concat (when rcirc-time-format + (format-time-string rcirc-time-format (current-time))) + (cond ((or (string= response "PRIVMSG") + (string= response "NOTICE") + (string= response "ACTION")) + (let (first middle end) + (cond ((string= response "PRIVMSG") + (setq first "<" middle "> ")) + ((string= response "NOTICE") + (setq first "-" middle "- ")) + (t + (setq first "[" middle " " end "]"))) + (concat first + (rcirc-facify (rcirc-user-nick sender) + (if (string= sender + (rcirc-nick process)) + 'rcirc-my-nick-face + 'rcirc-other-nick-face)) + middle + (rcirc-mangle-text process text) + end))) + ((string= response "COMMAND") + text) + ((string= response "ERROR") + (propertize text 'face 'font-lock-warning-face)) + (t + (rcirc-mangle-text + process + (rcirc-facify + (concat "*** " + (when (not (string= sender (rcirc-server process))) + (concat (rcirc-user-nick sender) " ")) + (when (zerop (string-to-number response)) + (concat response " ")) + (when (and target (not (string= target rcirc-target))) + (concat target " ")) + text) + 'rcirc-server-face)))))) + +(defvar rcirc-activity-type nil) +(make-variable-buffer-local 'rcirc-activity-type) +(defun rcirc-print (process sender response target text &optional activity) + "Print TEXT in the buffer associated with TARGET. +Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, +record activity." + (let* ((buffer (cond ((bufferp target) + target) + ((not target) + (rcirc-last-buffer process)) + ((not (rcirc-channel-p target)) + (rcirc-get-buffer-create process target)) + ((rcirc-get-buffer process target)) + (t (process-buffer process)))) + (inhibit-read-only t)) + (with-current-buffer buffer + (let ((moving (= (point) rcirc-prompt-end-marker)) + (old-point (point-marker)) + (fill-start (marker-position rcirc-prompt-start-marker))) + + (unless (string= sender (rcirc-nick process)) + ;; only decode text from other senders, not ours + (setq text (decode-coding-string text buffer-file-coding-system)) + ;; mark the line with overlay arrow + (unless (or (marker-position overlay-arrow-position) + (get-buffer-window (current-buffer))) + (set-marker overlay-arrow-position + (marker-position rcirc-prompt-start-marker)))) + + ;; temporarily set the marker insertion-type because + ;; insert-before-markers results in hidden text in new buffers + (goto-char rcirc-prompt-start-marker) + (set-marker-insertion-type rcirc-prompt-start-marker t) + (set-marker-insertion-type rcirc-prompt-end-marker t) + (insert + (rcirc-format-response-string process sender response target text) + (propertize "\n" 'hard t)) + (set-marker-insertion-type rcirc-prompt-start-marker nil) + (set-marker-insertion-type rcirc-prompt-end-marker nil) + + ;; fill the text we just inserted, maybe + (when (and rcirc-fill-flag + (not (string= response "372"))) ;/motd + (let ((fill-prefix + (or rcirc-fill-prefix + (make-string + (+ (if rcirc-time-format + (length (format-time-string + rcirc-time-format)) + 0) + (cond ((or (string= response "PRIVMSG") + (string= response "NOTICE")) + (+ (length (rcirc-user-nick sender)) + 2)) ; <> + ((string= response "ACTION") + (+ (length (rcirc-user-nick sender)) + 1)) ; [ + (t 3)) ; *** + 1) + ? ))) + (fill-column (or rcirc-fill-column fill-column))) + (fill-region fill-start rcirc-prompt-start-marker 'left t))) + + ;; truncate buffer if it is very long + (save-excursion + (when (and rcirc-buffer-maximum-lines + (> rcirc-buffer-maximum-lines 0) + (= (forward-line (- rcirc-buffer-maximum-lines)) 0)) + (delete-region (point-min) (point)))) + + ;; set inserted text to be read-only + (when rcirc-read-only-flag + (put-text-property rcirc-prompt-start-marker fill-start 'read-only t) + (let ((inhibit-read-only t)) + (put-text-property rcirc-prompt-start-marker fill-start + 'front-sticky t) + (put-text-property (1- (point)) (point) 'rear-nonsticky t))) + + ;; set the window point for buffers show in windows + (walk-windows (lambda (w) + (unless (eq (selected-window) w) + (when (and (eq (current-buffer) + (window-buffer w)) + (>= (window-point w) + rcirc-prompt-end-marker)) + (set-window-point w (point-max))))) + nil t) + + ;; restore the point + (goto-char (if moving rcirc-prompt-end-marker old-point)) + + ;; flush undo (can we do something smarter here?) + (buffer-disable-undo) + (buffer-enable-undo)) + + ;; record modeline activity + (when activity + (let ((nick-match + (string-match (concat "\\b" + (regexp-quote (rcirc-nick process)) + "\\b") + text))) + (when (or (not rcirc-ignore-channel-activity) + ;; always notice when our nick is mentioned, even + ;; if ignoring channel activity + nick-match) + (rcirc-record-activity + (current-buffer) + (when (or nick-match (not (rcirc-channel-p rcirc-target))) + 'nick))))) + + (run-hook-with-args 'rcirc-print-hooks + process sender response target text)))) + +(defun rcirc-startup-channels (server) + "Return the list of startup channels for server." + (let (channels) + (dolist (i rcirc-startup-channels-alist) + (if (string-match (car i) server) + (setq channels (append channels (cdr i))))) + channels)) + +(defun rcirc-join-channels (process channels) + "Join CHANNELS." + (save-window-excursion + (mapc (lambda (channel) + (with-current-buffer (process-buffer process) + (let (rcirc-last-buffer) ; make sure /join text is + ; printed in server buffer + (rcirc-print process (rcirc-nick process) "COMMAND" + nil (concat "/join " channel))) + (rcirc-cmd-join channel process))) + channels))) + +;;; nick management +(defun rcirc-user-nick (user) + "Return the nick from USER. Remove any non-nick junk." + (if (string-match "^[@%+]?\\([^! ]+\\)!?" (or user "")) + (match-string 1 user) + user)) + +(defun rcirc-user-non-nick (user) + "Return the non-nick portion of USER." + (if (string-match "^[@+]?[^! ]+!?\\(.*\\)" (or user "")) + (match-string 1 user) + user)) + +(defun rcirc-nick-channels (process nick) + "Return list of channels for NICK." + (let ((nick (rcirc-user-nick nick))) + (with-current-buffer (process-buffer process) + (mapcar (lambda (x) (car x)) + (gethash nick rcirc-nick-table))))) + +(defun rcirc-put-nick-channel (process nick channel) + "Add CHANNEL to list associated with NICK." + (with-current-buffer (process-buffer process) + (let* ((nick (rcirc-user-nick nick)) + (chans (gethash nick rcirc-nick-table)) + (record (assoc channel chans))) + (if record + (setcdr record (current-time)) + (puthash nick (cons (cons channel (current-time)) + chans) + rcirc-nick-table))))) + +(defun rcirc-nick-remove (process nick) + "Remove NICK from table." + (with-current-buffer (process-buffer process) + (remhash nick rcirc-nick-table))) + +(defun rcirc-remove-nick-channel (process nick channel) + "Remove the CHANNEL from list associated with NICK." + (with-current-buffer (process-buffer process) + (let* ((nick (rcirc-user-nick nick)) + (chans (gethash nick rcirc-nick-table)) + (newchans (assq-delete-all channel chans))) + (if newchans + (puthash nick newchans rcirc-nick-table) + (remhash nick rcirc-nick-table))))) + +(defun rcirc-channel-nicks (process channel) + "Return the list of nicks in CHANNEL sorted by last activity." + (with-current-buffer (process-buffer process) + (let (nicks) + (maphash + (lambda (k v) + (let ((record (assoc channel v))) + (if record + (setq nicks (cons (cons k (cdr record)) nicks))))) + rcirc-nick-table) + (mapcar (lambda (x) (car x)) + (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x)))))))) + +;;; activity tracking +(or (assq 'rcirc-ignore-channel-activity minor-mode-alist) + (setq minor-mode-alist + (cons '(rcirc-ignore-channel-activity " Ignore") minor-mode-alist))) + +(defun rcirc-toggle-ignore-channel-activity (&optional all) + "Toggle the value of `rcirc-ignore-channel-activity'. +If ALL is non-nil, instead toggle the value of +`rcirc-ignore-all-activity-flag'." + (interactive "P") + (if all + (progn + (setq rcirc-ignore-all-activity-flag + (not rcirc-ignore-all-activity-flag)) + (message (concat "Global activity " + (if rcirc-ignore-all-activity-flag + "hidden" + "displayed"))) + (rcirc-update-activity-string)) + (setq rcirc-ignore-channel-activity + (not rcirc-ignore-channel-activity))) + (force-mode-line-update)) + +(defvar rcirc-switch-to-buffer-function 'switch-to-buffer + "Function to use when switching buffers. +Possible values are `switch-to-buffer', `pop-to-buffer', and +`display-buffer'.") + +(defun rcirc-switch-to-server-buffer () + "Switch to the server buffer associated with current channel buffer." + (interactive) + (funcall rcirc-switch-to-buffer-function (process-buffer rcirc-process))) + +(defun rcirc-jump-to-first-unread-line () + "Move the point to the first unread line in this buffer." + (interactive) + (when (marker-position overlay-arrow-position) + (goto-char overlay-arrow-position))) + +(defvar rcirc-last-non-irc-buffer nil + "The buffer to switch to when there is no more activity.") + +(defun rcirc-next-active-buffer (arg) + "Go to the ARGth rcirc buffer with activity. +The function given by `rcirc-switch-to-buffer-function' is used to +show the buffer." + (interactive "p") + (if rcirc-activity + (progn + (unless (eq major-mode 'rcirc-mode) + (setq rcirc-last-non-irc-buffer (current-buffer))) + (if (and (> arg 0) + (<= arg (length rcirc-activity))) + (funcall rcirc-switch-to-buffer-function + (nth (1- arg) rcirc-activity)) + (message "Invalid arg: %d" arg))) + (if (eq major-mode 'rcirc-mode) + (if (not (and rcirc-last-non-irc-buffer + (buffer-live-p rcirc-last-non-irc-buffer))) + (message "No last buffer.") + (funcall rcirc-switch-to-buffer-function rcirc-last-non-irc-buffer) + (setq rcirc-last-non-irc-buffer nil)) + (message "No channel activity. Go start something.")))) + +(defvar rcirc-activity-hooks nil + "Hook to be run when there is channel activity. + +Functions are called with a single argument, the buffer with the +activity. Only run if the buffer is not visible and +`rcirc-ignore-channel-activity' is non-nil.") + +(defun rcirc-record-activity (buffer type) + "Record BUFFER activity with TYPE." + (with-current-buffer buffer + (when (not (get-buffer-window (current-buffer) t)) + (add-to-list 'rcirc-activity (current-buffer) 'append) + (if (not rcirc-activity-type) + (setq rcirc-activity-type type)) + (rcirc-update-activity-string))) + (run-hook-with-args 'rcirc-activity-hooks buffer)) + +(defun rcirc-clear-activity (buffer) + "Clear the BUFFER activity." + (setq rcirc-activity (delete buffer rcirc-activity)) + (with-current-buffer buffer + (setq rcirc-activity-type nil))) + +(defun rcirc-update-activity-string () + "Update mode-line string." + (setq rcirc-activity-string + (if (or rcirc-ignore-all-activity-flag + (not rcirc-activity)) + "" + (concat " [" (mapconcat + (lambda (b) + (let ((s (rcirc-short-buffer-name b))) + (with-current-buffer b + (if (not (eq rcirc-activity-type 'nick)) + s + (rcirc-facify s + 'rcirc-mode-line-nick-face))))) + rcirc-activity ",") "]")))) + +(defun rcirc-short-buffer-name (buffer) + "Return a short name for BUFFER to use in the modeline indicator." + (with-current-buffer buffer + (or rcirc-target (process-name rcirc-process)))) + +(defun rcirc-update-activity () + "Go through visible windows and remove buffers from activity list." + (walk-windows (lambda (w) (rcirc-clear-activity (window-buffer w)))) + (rcirc-update-activity-string)) + + +;;; /commands these are called with 3 args: PROCESS, TARGET, which is +;; the current buffer/channel/user, and ARGS, which is a string +;; containing the text following the /cmd. + +(defmacro defun-rcirc-command (command argument docstring interactive-form + &rest body) + "Define a command." + `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) + (,@argument &optional process target) + ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values of" + "\nbuffer local variables `rcirc-process' and `rcirc-target'," + "\nwill be used.") + ,interactive-form + (let ((process (or process rcirc-process)) + (target (or target rcirc-target))) + ,@body))) + +(defun-rcirc-command msg (message) + "Send private MESSAGE to TARGET." + (interactive "i") + (if (null message) + (progn + (setq target (completing-read "Message nick: " + (with-current-buffer + (process-buffer rcirc-process) + rcirc-nick-table))) + (when (> (length target) 0) + (setq message (read-string (format "Message %s: " target))) + (when (> (length message) 0) + (rcirc-send-message process target message)))) + (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message)) + (message "Not enough args, or something.") + (setq target (match-string 1 message) + message (match-string 2 message)) + (rcirc-send-message process target message)))) + +(defun-rcirc-command query (nick) + "Open a private chat buffer to NICK." + (interactive (list (completing-read "Query nick: " + (with-current-buffer + (process-buffer rcirc-process) + rcirc-nick-table)))) + (let ((new-buffer (eq (rcirc-get-buffer rcirc-process nick) + (process-buffer rcirc-process)))) + (switch-to-buffer (rcirc-get-buffer-create process nick)) + (when new-buffer + (rcirc-cmd-whois nick)))) + +(defun-rcirc-command join (args) + "Join CHANNEL." + (interactive "sJoin channel: ") + (let* ((channel (car (split-string args))) + (buffer (rcirc-get-buffer-create process channel))) + (when (not (eq (selected-window) (minibuffer-window))) + (funcall rcirc-switch-to-buffer-function buffer)) + (rcirc-send-string process (concat "JOIN " args)) + (rcirc-set-last-buffer process buffer))) + +(defun-rcirc-command part (channel) + "Part CHANNEL." + (interactive "sPart channel: ") + (let ((channel (if (> (length channel) 0) channel target))) + (rcirc-send-string process (concat "PART " channel " :" (rcirc-version))))) + +(defun-rcirc-command quit (reason) + "Send a quit message to server with REASON." + (interactive "sQuit reason: ") + (rcirc-send-string process (concat "QUIT :" reason))) + +(defun-rcirc-command nick (nick) + "Change nick to NICK." + (interactive "i") + (when (null nick) + (setq nick (read-string "New nick: " (rcirc-nick process)))) + (rcirc-send-string process (concat "NICK " nick))) + +(defun-rcirc-command names (channel) + "Display list of names in CHANNEL or in current channel if CHANNEL is nil. +If called interactively, prompt for a channel when prefix arg is supplied." + (interactive "P") + (if (interactive-p) + (if channel + (setq channel (read-string "List names in channel: " target)))) + (let ((channel (if (> (length channel) 0) + channel + target))) + (rcirc-send-string process (concat "NAMES " channel)))) + +(defun-rcirc-command topic (topic) + "List TOPIC for the TARGET channel. +With a prefix arg, prompt for new topic." + (interactive "P") + (if (and (interactive-p) topic) + (setq topic (read-string "New Topic: " rcirc-topic))) + (rcirc-send-string process (concat "TOPIC " target + (when (> (length topic) 0) + (concat " :" topic))))) + +(defun-rcirc-command whois (nick) + "Request information from server about NICK." + (interactive (list + (completing-read "Whois: " + (with-current-buffer + (process-buffer rcirc-process) + rcirc-nick-table)))) + (rcirc-set-last-buffer rcirc-process (current-buffer)) + (rcirc-send-string process (concat "WHOIS " nick))) + +(defun-rcirc-command mode (args) + "Set mode with ARGS." + (interactive (list (concat (read-string "Mode nick or channel: ") + " " (read-string "Mode: ")))) + (rcirc-send-string process (concat "MODE " args))) + +(defun-rcirc-command list (channels) + "Request information on CHANNELS from server." + (interactive "sList Channels: ") + (rcirc-send-string process (concat "LIST " channels))) + +(defun-rcirc-command oper (args) + "Send operator command to server." + (interactive "sOper args: ") + (rcirc-send-string process (concat "OPER " args))) + +(defun-rcirc-command quote (message) + "Send MESSAGE literally to server." + (interactive "sServer message: ") + (rcirc-send-string process message)) + +(defun-rcirc-command kick (arg) + "Kick NICK from current channel." + (interactive (list + (concat (completing-read "Kick nick: " + (rcirc-channel-nicks rcirc-process + rcirc-target)) + (read-from-minibuffer "Kick reason: ")))) + (let* ((arglist (split-string arg)) + (argstring (concat (car arglist) " :" + (mapconcat 'identity (cdr arglist) " ")))) + (rcirc-send-string process (concat "KICK " target " " argstring)))) + +(defun rcirc-cmd-ctcp (args &optional process target) + (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args) + (let ((target (match-string 1 args)) + (request (match-string 2 args))) + (rcirc-send-message process target + (concat "\C-a" (upcase request) "\C-a"))) + (rcirc-print process (rcirc-nick process) "ERROR" target + "usage: /ctcp NICK REQUEST"))) + +(defun rcirc-cmd-me (args &optional process target) + (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" + target args))) + +(defun rcirc-message-leader (sender face) + "Return a string with SENDER propertized with FACE." + (rcirc-facify (concat "<" (rcirc-user-nick sender) "> ") face)) + +(defun rcirc-facify (string face) + "Return a copy of STRING with FACE property added." + (propertize (or string "") 'face face 'rear-nonsticky t)) + +;; shy grouping must be used within this regexp +(defvar rcirc-url-regexp + "\\b\\(?:\\(?:www\\.\\|\\(?:s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\ +\\|wais\\|mailto\\):\\)\\(?://[-a-zA-Z0-9_.]+:[0-9]*\\)?\\(?:[-a-zA-Z0-9_=!?#$\ +@~`%&*+|\\/:;.,]\\|\\w\\)+\\(?:[-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)" + "Regexp matching URL's. Set to nil to disable URL features in rcirc.") + +(defun rcirc-browse-url (&optional arg) + "Prompt for url to browse based on urls in buffer." + (interactive) + (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls)) + (initial-input (car rcirc-urls)) + (history (cdr rcirc-urls))) + (browse-url (completing-read "rcirc browse-url: " + completions nil nil initial-input 'history) + arg))) + +(defun rcirc-map-regexp (function regexp string) + "Return a copy of STRING after calling FUNCTION for each REGEXP match. +FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING." + (let ((start 0)) + (while (string-match regexp string start) + (setq start (match-end 0)) + (funcall function (match-beginning 0) (match-end 0) string))) + string) + +(defvar rcirc-nick-syntax-table + (let ((table (make-syntax-table text-mode-syntax-table))) + (mapc (lambda (c) (modify-syntax-entry c "w" table)) + "[]\\`_^{|}-") + (modify-syntax-entry ?' "_" table) + table) + "Syntax table which includes all nick characters as word constituents.") + +(defun rcirc-mangle-text (process text) + "Return TEXT with properties added based on various patterns." + ;; ^B + (setq text + (rcirc-map-regexp (lambda (start end string) + (add-text-properties + start end + (list 'face 'bold 'rear-nonsticky t) + string)) + ".*?" + text)) + (while (string-match "\\(.*\\)[]\\(.*\\)" text) ; deal with + (setq text (concat (match-string 1 text) + (match-string 2 text)))) + ;; my nick + (setq text + (with-syntax-table rcirc-nick-syntax-table + (rcirc-map-regexp (lambda (start end string) + (add-text-properties + start end + (list 'face 'rcirc-nick-in-message-face + 'rear-nonsticky t) + string)) + (concat "\\b" + (regexp-quote (rcirc-nick process)) + "\\b") + text))) + ;; urls + (setq text + (rcirc-map-regexp + (lambda (start end string) + (let ((orig-face (get-text-property start 'face string))) + (add-text-properties start end + (list 'face (list orig-face 'bold) + 'rear-nonsticky t) + string)) + (push (substring string start end) rcirc-urls)) + rcirc-url-regexp + text)) + text) + + +;;; handlers +;; these are called with the server PROCESS, the SENDER, which is a +;; server or a user, depending on the command, the ARGS, which is a +;; list of strings, and the TEXT, which is the original server text, +;; verbatim +(defun rcirc-handler-001 (process sender args text) + (rcirc-handler-generic process "001" sender args text) + ;; set the real server name + (with-current-buffer (process-buffer process) + (setq rcirc-server sender) + (setq rcirc-nick (car args)) + (rcirc-update-prompt) + (when rcirc-auto-authenticate-flag (rcirc-authenticate)) + (let (rcirc-last-buffer) + (rcirc-join-channels process rcirc-startup-channels)))) + +(defun rcirc-handler-PRIVMSG (process sender args text) + (let ((target (if (rcirc-channel-p (car args)) + (car args) + (rcirc-user-nick sender))) + (message (or (cadr args) ""))) + (if (string-match "^\C-a\\(.*\\)\C-a$" message) + (rcirc-handler-CTCP process target sender (match-string 1 message)) + (rcirc-print process sender "PRIVMSG" target message t)) + ;; update nick timestamp + (if (member target (rcirc-nick-channels process sender)) + (rcirc-put-nick-channel process sender target)))) + +(defun rcirc-handler-NOTICE (process sender args text) + (let ((target (car args)) + (message (cadr args))) + (rcirc-print process sender "NOTICE" + (cond ((rcirc-channel-p target) + target) + ((string-match "^\\[\\(#[^ ]+\\)\\]" message) + (match-string 1 message)) + (sender + (if (string= sender (rcirc-server process)) + (process-buffer process) + (rcirc-user-nick sender)))) + message t) + (and sender (rcirc-put-nick-channel process sender target)))) + +(defun rcirc-handler-WALLOPS (process sender args text) + (let ((target (rcirc-user-nick sender))) + (rcirc-print process sender "WALLOPS" target (car args) t))) + +(defun rcirc-handler-JOIN (process sender args text) + (let ((channel (downcase (car args))) + (nick (rcirc-user-nick sender))) + (rcirc-get-buffer-create process channel) + (rcirc-print process sender "JOIN" channel "") + + ;; print in private chat buffer if it exists + (if (not (eq (process-buffer rcirc-process) + (rcirc-get-buffer rcirc-process nick))) + (rcirc-print process sender "JOIN" nick channel)) + + (rcirc-put-nick-channel process sender channel) + (if (string= nick (rcirc-nick process)) + (setq rcirc-channels (cons channel rcirc-channels))))) + +;; PART and KICK are handled the same way +(defun rcirc-handler-PART-or-KICK (process response channel sender nick args) + (rcirc-print process sender response channel (concat channel " " args)) + + ;; print in private chat buffer if it exists + (when (not (eq (process-buffer rcirc-process) + (rcirc-get-buffer rcirc-process nick))) + (rcirc-print process sender response nick (concat channel " " args))) + + (if (not (string= nick (rcirc-nick process))) + ;; this is someone else leaving + (rcirc-remove-nick-channel process nick channel) + ;; this is us leaving + (mapc (lambda (n) + (rcirc-remove-nick-channel process n channel)) + (rcirc-channel-nicks process channel)) + (setq rcirc-channels (delete channel rcirc-channels)) + (with-current-buffer (rcirc-get-buffer process channel) + (setq rcirc-target nil)))) + +(defun rcirc-handler-PART (process sender args text) + (rcirc-handler-PART-or-KICK process "PART" + (car args) sender (rcirc-user-nick sender) + (cadr args))) + +(defun rcirc-handler-KICK (process sender args text) + (rcirc-handler-PART-or-KICK process "KICK" (car args) sender (cadr args) + (caddr args))) + +(defun rcirc-handler-QUIT (process sender args text) + (let ((nick (rcirc-user-nick sender))) + (mapc (lambda (channel) + (rcirc-print process sender "QUIT" channel (apply 'concat args))) + (rcirc-nick-channels process nick)) + + ;; print in private chat buffer if it exists + (if (not (eq (process-buffer rcirc-process) + (rcirc-get-buffer rcirc-process nick))) + (rcirc-print process sender "QUIT" nick (apply 'concat args))) + + (rcirc-nick-remove process nick))) + +(defun rcirc-handler-NICK (process sender args text) + (let* ((old-nick (rcirc-user-nick sender)) + (new-nick (car args)) + (channels (rcirc-nick-channels process old-nick))) + ;; print message to nick's channels + (dolist (target channels) + (rcirc-print process sender "NICK" target new-nick)) + ;; update private chat buffer, if it exists + (with-current-buffer (rcirc-get-buffer process old-nick) + (when (not (equal (process-buffer rcirc-process) + (current-buffer))) + (rcirc-print process sender "NICK" old-nick new-nick) + (setq rcirc-target new-nick) + (rename-buffer (rcirc-get-buffer-name process new-nick)))) + ;; remove old nick and add new one + (with-current-buffer (process-buffer process) + (let ((v (gethash old-nick rcirc-nick-table))) + (remhash old-nick rcirc-nick-table) + (puthash new-nick v rcirc-nick-table)) + ;; if this is our nick... + (when (string= old-nick rcirc-nick) + (setq rcirc-nick new-nick) + ;; update prompts + (mapc (lambda (target) + (with-current-buffer (rcirc-get-buffer process target) + (rcirc-update-prompt))) + (append rcirc-channels rcirc-private-chats)) + ;; reauthenticate + (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) + +(defun rcirc-handler-PING (process sender args text) + (rcirc-send-string process (concat "PONG " (car args)))) + +(defun rcirc-handler-PONG (process sender args text) + ;; do nothing + ) + +(defun rcirc-handler-TOPIC (process sender args text) + (let ((topic (cadr args))) + (rcirc-print process sender "TOPIC" (car args) topic) + (with-current-buffer (rcirc-get-buffer process (car args)) + (setq rcirc-topic topic)))) + +(defun rcirc-handler-332 (process sender args text) + "RPL_TOPIC" + (with-current-buffer (rcirc-get-buffer process (cadr args)) + (setq rcirc-topic (caddr args)))) + +(defun rcirc-handler-333 (process sender args text) + "Not in rfc1459.txt" + (with-current-buffer (rcirc-get-buffer process (cadr args)) + (let ((setter (caddr args)) + (time (current-time-string + (seconds-to-time + (string-to-number (cadddr args)))))) + (rcirc-print process sender "TOPIC" (cadr args) + (format "%s (%s on %s)" rcirc-topic setter time))))) + +(defun rcirc-handler-477 (process sender args text) + "ERR_NOCHANMODES" + (rcirc-print process sender "477" (cadr args) (caddr args))) + +(defun rcirc-handler-MODE (process sender args text) + (let ((target (car args)) + (msg (mapconcat 'identity (cdr args) " "))) + (rcirc-print process sender "MODE" + (if (string= target (rcirc-nick process)) + nil + target) + msg) + + ;; print in private chat buffers if they exist + (mapc (lambda (nick) + (when (not (eq (process-buffer rcirc-process) + (rcirc-get-buffer rcirc-process nick))) + (rcirc-print process sender "MODE" nick msg))) + (cddr args)))) + +(defun rcirc-get-temp-buffer-create (process channel) + "Return a buffer based on PROCESS and CHANNEL." + (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process)))) + (get-buffer-create tmpnam))) + +(defun rcirc-handler-353 (process sender args text) + "RPL_NAMREPLY" + (let ((channel (downcase (caddr args)))) + (mapc (lambda (nick) + (rcirc-put-nick-channel process nick channel)) + (delete "" (split-string (cadddr args) " "))) + (with-current-buffer (rcirc-get-temp-buffer-create process channel) + (goto-char (point-max)) + (insert (car (last args)) " ")))) + +(defun rcirc-handler-366 (process sender args text) + "RPL_ENDOFNAMES" + (let* ((channel (cadr args)) + (buffer (rcirc-get-temp-buffer-create process channel))) + (with-current-buffer buffer + (rcirc-print process sender "NAMES" channel + (buffer-substring (point-min) (point-max)))) + (kill-buffer buffer))) + +(defun rcirc-handler-433 (process sender args text) + "ERR_NICKNAMEINUSE" + (rcirc-handler-generic process "433" sender args text) + (let* ((new-nick (concat (cadr args) "`"))) + (with-current-buffer (process-buffer process) + (rcirc-cmd-nick new-nick nil process)))) + +(defun rcirc-authenticate () + "Send authentication to process associated with current buffer. +Passwords are read from `rcirc-authinfo-file-name' (which see)." + (interactive) + (let ((password-alist + (with-temp-buffer + (insert-file-contents-literally rcirc-authinfo-file-name) + (goto-char (point-min)) + (read (current-buffer))))) + (with-current-buffer (process-buffer rcirc-process) + (dolist (i password-alist) + (let ((server (car i)) + (nick (cadr i)) + (method (caddr i)) + (args (cdddr i))) + (when (and (string-match server rcirc-server) + (string-match nick rcirc-nick)) + (cond ((equal method 'nickserv) + (rcirc-send-string + rcirc-process + (concat + "PRIVMSG nickserv :identify " + (car args)))) + ((equal method 'chanserv) + (rcirc-send-string + rcirc-process + (concat + "PRIVMSG chanserv :identify " + (car args) " " (cadr args)))) + ((equal method 'bitlbee) + (rcirc-send-string + rcirc-process + (concat "PRIVMSG #bitlbee :identify " (car args)))) + (t + (message "No %S authentication method defined" + method))))))))) + +(defun rcirc-handler-INVITE (process sender args text) + (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) + +(defun rcirc-handler-ERROR (process sender args text) + (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " "))) + +(defun rcirc-handler-CTCP (process target sender text) + (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text) + (let* ((request (upcase (match-string 1 text))) + (args (match-string 2 text)) + (nick (rcirc-user-nick sender)) + (handler (intern-soft (concat "rcirc-handler-ctcp-" request)))) + (if (not (fboundp handler)) + (rcirc-print process sender "ERROR" target + (format "unhandled ctcp: %s" text)) + (funcall handler process target sender args) + (if (not (string= request "ACTION")) + (rcirc-print process sender "CTCP" target + (format "%s" text))))))) + +(defun rcirc-handler-ctcp-VERSION (process target sender args) + (rcirc-send-string process + (concat "NOTICE " (rcirc-user-nick sender) + " :\C-aVERSION " (rcirc-version) + " - http://www.nongnu.org/rcirc" + "\C-a"))) + +(defun rcirc-handler-ctcp-ACTION (process target sender args) + (rcirc-print process sender "ACTION" target args t)) + +(defun rcirc-handler-ctcp-TIME (process target sender args) + (rcirc-send-string process + (concat "NOTICE " (rcirc-user-nick sender) + " :\C-aTIME " (current-time-string) "\C-a"))) + +(defface rcirc-my-nick-face + '((((type tty) (class color)) (:foreground "blue" :weight bold)) + (((class color) (background light)) (:foreground "Blue")) + (((class color) (background dark)) (:foreground "LightSkyBlue")) + (t (:inverse-video t :bold t))) + "The rcirc face used to highlight my messages." + :group 'rcirc) + +(defface rcirc-other-nick-face + '((((type tty) (class color)) (:foreground "yellow" :weight light)) + (((class grayscale) (background light)) + (:foreground "Gray90" :bold t :italic t)) + (((class grayscale) (background dark)) + (:foreground "DimGray" :bold t :italic t)) + (((class color) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (background dark)) (:foreground "LightGoldenrod")) + (t (:bold t :italic t))) + "The rcirc face used to highlight other messages." + :group 'rcirc) + +(defface rcirc-server-face + '((((type tty pc) (class color) (background light)) (:foreground "red")) + (((type tty pc) (class color) (background dark)) (:foreground "red1")) + (((class grayscale) (background light)) + (:foreground "DimGray" :bold t :italic t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :bold t :italic t)) + (((class color) (background light)) (:foreground "gray40")) + (((class color) (background dark)) (:foreground "chocolate1")) + (t (:bold t :italic t))) + "The rcirc face used to highlight server messages." + :group 'rcirc) + +(defface rcirc-nick-in-message-face + '((((type tty) (class color)) (:foreground "cyan" :weight bold)) + (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) + (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) + (((class color) (background light)) (:foreground "Purple")) + (((class color) (background dark)) (:foreground "Cyan")) + (t (:bold t))) + "The rcirc face used to highlight instances of nick within messages." + :group 'rcirc) + +(defface rcirc-prompt-face + '((((background dark)) (:foreground "cyan")) + (t (:foreground "dark blue"))) + "The rcirc face to use to highlight prompts." + :group 'rcirc) + +(defface rcirc-mode-line-nick-face + '((t (:bold t))) + "The rcirc face used indicate activity directed at you." + :group 'rcirc) + +;; When using M-x flyspell-mode, only check words past the input marker +(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input) +(defun rcirc-looking-at-input () + "Returns true if point is past the input marker." + (>= (point) rcirc-prompt-end-marker)) + + +(provide 'rcirc) +;;; rcirc.el ends here