rcirc.el

;;; rcirc.el --- default, simple IRC client.

;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
;;   Free Software Foundation, Inc.

;; Author: Ryan Yeske
;; URL: http://www.nongnu.org/rcirc
;; 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 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:

;; Internet Relay Chat (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.

;; Rcirc has simple defaults and clear and consistent behavior.
;; Message arrival timestamps, activity notification on the modeline,
;; message filling, nick completion, and keepalive pings are all
;; enabled by default, but can easily be adjusted or turned off.  Each
;; discussion takes place in its own buffer and there is a single
;; server buffer per connection.

;; Open a new irc connection with:
;; M-x irc RET

;;; Todo:

;;; Code:

(require 'ring)
(require 'time-date)
(eval-when-compile (require 'cl))

(defgroup rcirc nil
  "Simple IRC client."
  :version "22.1"
  :prefix "rcirc-"
  :link '(custom-manual "(rcirc)")
  :group 'applications)

(defcustom rcirc-server-alist
  '(("irc.freenode.net" :channels ("#rcirc")))
  "An alist of IRC connections to establish when running `rcirc'.
Each element looks like (SERVER-NAME PARAMETERS).

SERVER-NAME is a string describing the server to connect
to.

The optional PARAMETERS come in pairs PARAMETER VALUE.

The following parameters are recognized:

`:nick'

VALUE must be a string.  If absent, `rcirc-default-nick' is used
for this connection.

`:port'

VALUE must be a number or string.  If absent,
`rcirc-default-port' is used.

`:user-name'

VALUE must be a string.  If absent, `rcirc-default-user-name' is
used.

`:password'

VALUE must be a string.  If absent, no PASS command will be sent
to the server.

`:full-name'

VALUE must be a string.  If absent, `rcirc-default-full-name' is
used.

`:channels'

VALUE must be a list of strings describing which channels to join
when connecting to this server.  If absent, no channels will be
connected to automatically."
  :type '(alist :key-type string
		:value-type (plist :options ((:nick string)
					     (:port integer)
					     (:user-name string)
					     (:password string)
					     (:full-name string)
					     (:channels (repeat string)))))
  :group 'rcirc)

(defcustom rcirc-default-port 6667
  "The default port to connect to."
  :type 'integer
  :group 'rcirc)

(defcustom rcirc-default-nick (user-login-name)
  "Your nick."
  :type 'string
  :group 'rcirc)

(defcustom rcirc-default-user-name "user"
  "Your user name sent to the server when connecting."
  :version "24.1"                       ; changed default
  :type 'string
  :group 'rcirc)

(defcustom rcirc-default-full-name "unknown"
  "The full name sent to the server when connecting."
  :version "24.1"                       ; changed default
  :type 'string
  :group 'rcirc)

(defcustom rcirc-fill-flag t
  "*Non-nil means line-wrap messages printed in channel buffers."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-fill-column nil
  "*Column beyond which automatic line-wrapping should happen.
If nil, use value of `fill-column'.  If 'frame-width, use the
maximum frame width."
  :type '(choice (const :tag "Value of `fill-column'")
		 (const :tag "Full frame width" frame-width)
		 (integer :tag "Number of columns"))
  :group 'rcirc)

(defcustom rcirc-fill-prefix nil
  "*Text to insert before filled lines.
If nil, calculate the prefix dynamically to line up text
underneath each nick."
  :type '(choice (const :tag "Dynamic" nil)
		 (string :tag "Prefix text"))
  :group 'rcirc)

(defvar rcirc-ignore-buffer-activity-flag nil
  "If non-nil, ignore activity in this buffer.")
(make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag)

(defvar rcirc-low-priority-flag nil
  "If non-nil, activity in this buffer is considered low priority.")
(make-variable-buffer-local 'rcirc-low-priority-flag)

(defvar rcirc-omit-mode nil
  "Non-nil if Rcirc-Omit mode is enabled.
Use the command `rcirc-omit-mode' to change this variable.")
(make-variable-buffer-local 'rcirc-omit-mode)

(defcustom rcirc-time-format "%H:%M "
  "*Describes how timestamps are printed.
Used as the first arg to `format-time-string'."
  :type 'string
  :group 'rcirc)

(defcustom rcirc-input-ring-size 1024
  "*Size of input history ring."
  :type 'integer
  :group 'rcirc)

(defcustom rcirc-read-only-flag t
  "*Non-nil means make text in IRC buffers read-only."
  :type 'boolean
  :group 'rcirc)

(defcustom 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."
  :type '(choice (const :tag "No truncation" nil)
		 (integer :tag "Number of lines"))
  :group 'rcirc)

(defcustom rcirc-scroll-show-maximum-output t
  "*If non-nil, scroll buffer to keep the point at the bottom of
the window."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-authinfo nil
  "List of authentication passwords.
Each element of the list is a list with a SERVER-REGEXP string
and a method symbol followed by method specific arguments.

The valid METHOD symbols are `nickserv', `chanserv' and
`bitlbee'.

The ARGUMENTS for each METHOD symbol are:
  `nickserv': NICK PASSWORD [NICKSERV-NICK]
  `chanserv': NICK CHANNEL PASSWORD
  `bitlbee': NICK PASSWORD

Examples:
 ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
  (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
  (\"bitlbee\" bitlbee \"robert\" \"sekrit\")
  (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\"))"
  :type '(alist :key-type (string :tag "Server")
		:value-type (choice (list :tag "NickServ"
					  (const nickserv)
					  (string :tag "Nick")
					  (string :tag "Password"))
				    (list :tag "ChanServ"
					  (const chanserv)
					  (string :tag "Nick")
					  (string :tag "Channel")
					  (string :tag "Password"))
				    (list :tag "BitlBee"
					  (const bitlbee)
					  (string :tag "Nick")
					  (string :tag "Password"))))
  :group 'rcirc)

(defcustom rcirc-auto-authenticate-flag t
  "*Non-nil means automatically send authentication string to server.
See also `rcirc-authinfo'."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-prompt "> "
  "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 either M-x customize or also call `rcirc-update-prompt'."
  :type 'string
  :set 'rcirc-set-changed
  :initialize 'custom-initialize-default
  :group 'rcirc)

(defcustom rcirc-keywords nil
  "List of keywords to highlight in message text."
  :type '(repeat string)
  :group 'rcirc)

(defcustom rcirc-ignore-list ()
  "List of ignored nicks.
Use /ignore to list them, use /ignore NICK to add or remove a nick."
  :type '(repeat string)
  :group 'rcirc)

(defvar rcirc-ignore-list-automatic ()
  "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
When an ignored person renames, their nick is added to both lists.
Nicks will be removed from the automatic list on follow-up renamings or
parts.")

(defcustom rcirc-bright-nicks nil
  "List of nicks to be emphasized.
See `rcirc-bright-nick' face."
  :type '(repeat string)
  :group 'rcirc)

(defcustom rcirc-dim-nicks nil
  "List of nicks to be deemphasized.
See `rcirc-dim-nick' face."
  :type '(repeat string)
  :group 'rcirc)

(defcustom rcirc-print-hooks nil
  "Hook run after text is printed.
Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
  :type 'hook
  :group 'rcirc)

(defcustom rcirc-always-use-server-buffer-flag nil
  "Non-nil means messages without a channel target will go to the server buffer."
  :type 'boolean
  :group 'rcirc)

(defcustom rcirc-decode-coding-system 'utf-8
  "Coding system used to decode incoming irc messages."
  :type 'coding-system
  :group 'rcirc)

(defcustom rcirc-encode-coding-system 'utf-8
  "Coding system used to encode outgoing irc messages."
  :type 'coding-system
  :group 'rcirc)

(defcustom rcirc-coding-system-alist nil
  "Alist to decide a coding system to use for a channel I/O operation.
The format is ((PATTERN . VAL) ...).
PATTERN is either a string or a cons of strings.
If PATTERN is a string, it is used to match a target.
If PATTERN is a cons of strings, the car part is used to match a
target, and the cdr part is used to match a server.
VAL is either a coding system or a cons of coding systems.
If VAL is a coding system, it is used for both decoding and encoding
messages.
If VAL is a cons of coding systems, the car part is used for decoding,
and the cdr part is used for encoding."
  :type '(alist :key-type (choice (string :tag "Channel Regexp")
					  (cons (string :tag "Channel Regexp")
						(string :tag "Server Regexp")))
		:value-type (choice coding-system
				    (cons (coding-system :tag "Decode")
					  (coding-system :tag "Encode"))))
  :group 'rcirc)

(defcustom rcirc-multiline-major-mode 'fundamental-mode
  "Major-mode function to use in multiline edit buffers."
  :type 'function
  :group 'rcirc)

(defvar rcirc-nick nil)

(defvar rcirc-prompt-start-marker nil)
(defvar rcirc-prompt-end-marker nil)

(defvar rcirc-nick-table nil)

(defvar rcirc-recent-quit-alist nil
  "Alist of nicks that have recently quit or parted the channel.")

(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.")

;; each process has an alist of (target . buffer) pairs
(defvar rcirc-buffer-alist nil)

(defvar rcirc-activity nil
  "List of buffers with unviewed activity.")

(defvar rcirc-activity-string ""
  "String displayed in modeline representing `rcirc-activity'.")
(put 'rcirc-activity-string 'risky-local-variable t)

(defvar rcirc-server-buffer nil
  "The server buffer associated with this channel buffer.")

(defvar rcirc-target nil
  "The channel or user associated with this buffer.")

(defvar rcirc-urls nil
  "List of urls seen in the current buffer.")
(put 'rcirc-urls 'permanent-local t)

(defvar rcirc-timeout-seconds 600
  "Kill connection after this many seconds if there is no activity.")

(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))

(defvar rcirc-startup-channels nil)

(defvar rcirc-server-name-history nil
  "History variable for \\[rcirc] call.")

(defvar rcirc-server-port-history nil
  "History variable for \\[rcirc] call.")

(defvar rcirc-nick-name-history nil
  "History variable for \\[rcirc] call.")

(defvar rcirc-user-name-history nil
  "History variable for \\[rcirc] call.")

;;;###autoload
(defun rcirc (arg)
  "Connect to all servers in `rcirc-server-alist'.

Do not connect to a server if it is already connected.

If ARG is non-nil, instead prompt for connection parameters."
  (interactive "P")
  (if arg
      (let* ((server (completing-read "IRC Server: "
				      rcirc-server-alist
				      nil nil
				      (caar rcirc-server-alist)
				      'rcirc-server-name-history))
	     (server-plist (cdr (assoc-string server rcirc-server-alist)))
	     (port (read-string "IRC Port: "
				(number-to-string
				 (or (plist-get server-plist :port)
				     rcirc-default-port))
				'rcirc-server-port-history))
	     (nick (read-string "IRC Nick: "
				(or (plist-get server-plist :nick)
				    rcirc-default-nick)
				'rcirc-nick-name-history))
	     (user-name (read-string "IRC Username: "
                                     (or (plist-get server-plist :user-name)
                                         rcirc-default-user-name)
                                     'rcirc-user-name-history))
	     (password (read-passwd "IRC Password: " nil
                                    (plist-get server-plist :password)))
	     (channels (split-string
			(read-string "IRC Channels: "
				     (mapconcat 'identity
						(plist-get server-plist
							   :channels)
						" "))
			"[, ]+" t)))
	(rcirc-connect server port nick user-name
		       rcirc-default-full-name
		       channels password))
    ;; connect to servers in `rcirc-server-alist'
    (let (connected-servers)
      (dolist (c rcirc-server-alist)
	(let ((server (car c))
	      (nick (or (plist-get (cdr c) :nick) rcirc-default-nick))
	      (port (or (plist-get (cdr c) :port) rcirc-default-port))
	      (user-name (or (plist-get (cdr c) :user-name)
			     rcirc-default-user-name))
	      (full-name (or (plist-get (cdr c) :full-name)
			     rcirc-default-full-name))
	      (channels (plist-get (cdr c) :channels))
              (password (plist-get (cdr c) :password)))
	  (when server
	    (let (connected)
	      (dolist (p (rcirc-process-list))
		(when (string= server (process-name p))
		  (setq connected p)))
	      (if (not connected)
		  (condition-case e
		      (rcirc-connect server port nick user-name
				     full-name channels password)
		    (quit (message "Quit connecting to %s" server)))
		(with-current-buffer (process-buffer connected)
		  (setq connected-servers
			(cons (process-contact (get-buffer-process
						(current-buffer)) :host)
			      connected-servers))))))))
      (when connected-servers
	(message "Already connected to %s"
		 (if (cdr connected-servers)
		     (concat (mapconcat 'identity (butlast connected-servers) ", ")
			     ", and "
			     (car (last connected-servers)))
		   (car connected-servers)))))))

;;;###autoload
(defalias 'irc 'rcirc)


(defvar rcirc-process-output nil)
(defvar rcirc-topic nil)
(defvar rcirc-keepalive-timer nil)
(defvar rcirc-last-server-message-time nil)
(defvar rcirc-server nil)		; server provided by server
(defvar rcirc-server-name nil)		; server name given by 001 response
(defvar rcirc-timeout-timer nil)
(defvar rcirc-user-disconnect nil)
(defvar rcirc-connecting nil)
(defvar rcirc-process nil)

;;;###autoload
(defun rcirc-connect (server &optional port nick user-name
                             full-name startup-channels password)
  (save-excursion
    (message "Connecting to %s..." server)
    (let* ((inhibit-eol-conversion)
           (port-number (if port
			    (if (stringp port)
				(string-to-number port)
			      port)
			  rcirc-default-port))
	   (nick (or nick rcirc-default-nick))
	   (user-name (or user-name rcirc-default-user-name))
	   (full-name (or full-name rcirc-default-full-name))
	   (startup-channels startup-channels)
           (process (make-network-process :name server :host server :service port-number)))
      ;; set up process
      (set-process-coding-system process 'raw-text 'raw-text)
      (switch-to-buffer (rcirc-generate-new-buffer-name process nil))
      (set-process-buffer process (current-buffer))
      (rcirc-mode process nil)
      (set-process-sentinel process 'rcirc-sentinel)
      (set-process-filter process 'rcirc-filter)
      (make-local-variable 'rcirc-process)
      (setq rcirc-process process)
      (make-local-variable 'rcirc-server)
      (setq rcirc-server server)
      (make-local-variable 'rcirc-server-name)
      (setq rcirc-server-name server)	; update when we get 001 response
      (make-local-variable 'rcirc-buffer-alist)
      (setq rcirc-buffer-alist nil)
      (make-local-variable 'rcirc-nick-table)
      (setq rcirc-nick-table (make-hash-table :test 'equal))
      (make-local-variable 'rcirc-nick)
      (setq rcirc-nick nick)
      (make-local-variable 'rcirc-process-output)
      (setq rcirc-process-output nil)
      (make-local-variable 'rcirc-startup-channels)
      (setq rcirc-startup-channels startup-channels)
      (make-local-variable 'rcirc-last-server-message-time)
      (setq rcirc-last-server-message-time (current-time))
      (make-local-variable 'rcirc-timeout-timer)
      (setq rcirc-timeout-timer nil)
      (make-local-variable 'rcirc-user-disconnect)
      (setq rcirc-user-disconnect nil)
      (make-local-variable 'rcirc-connecting)
      (setq rcirc-connecting t)

      (add-hook 'auto-save-hook 'rcirc-log-write)

      ;; identify
      (when password
        (rcirc-send-string process (concat "PASS " password)))
      (rcirc-send-string process (concat "NICK " nick))
      (rcirc-send-string process (concat "USER " user-name
                                         " 0 * :" full-name))

      ;; setup ping timer if necessary
      (unless rcirc-keepalive-timer
	(setq rcirc-keepalive-timer
	      (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive)))

      (message "Connecting to %s...done" server)

      ;; return process object
      process)))

(defmacro with-rcirc-process-buffer (process &rest body)
  (declare (indent 1) (debug t))
  `(with-current-buffer (process-buffer ,process)
     ,@body))

(defmacro with-rcirc-server-buffer (&rest body)
  (declare (indent 0) (debug t))
  `(with-current-buffer rcirc-server-buffer
     ,@body))

(defun rcirc-keepalive ()
  "Send keep alive pings to active rcirc processes.
Kill processes that have not received a server message since the
last ping."
  (if (rcirc-process-list)
      (mapc (lambda (process)
	      (with-rcirc-process-buffer process
		(when (not rcirc-connecting)
		  (rcirc-send-string process
				     (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a"
					     rcirc-nick
                                             (if (featurep 'xemacs)
                                                 (time-to-seconds
                                                  (current-time))
                                               (float-time)))))))
            (rcirc-process-list))
    ;; no processes, clean up timer
    (cancel-timer rcirc-keepalive-timer)
    (setq rcirc-keepalive-timer nil)))

(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
  (with-rcirc-process-buffer process
    (setq header-line-format (format "%f" (- (if (featurep 'xemacs)
                                                 (time-to-seconds
                                                  (current-time))
                                               (float-time))
					     (string-to-number message))))))

(defvar rcirc-debug-buffer " *rcirc debug*")
(defvar rcirc-debug-flag nil
  "If non-nil, write information to `rcirc-debug-buffer'.")
(defun rcirc-debug (process text)
  "Add an entry to the debug log including PROCESS and TEXT.
Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag'
is non-nil."
  (when rcirc-debug-flag
    (with-current-buffer (get-buffer-create rcirc-debug-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-debug process (format "SENTINEL: %S %S\n" process sentinel))
    (with-rcirc-process-buffer process
      (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
	(with-current-buffer (or buffer (current-buffer))
	  (rcirc-print process "rcirc.el" "ERROR" rcirc-target
		       (format "%s: %s (%S)"
			       (process-name process)
			       sentinel
			       (process-status process)) (not rcirc-target))
	  (rcirc-disconnect-buffer)))
      (run-hook-with-args 'rcirc-sentinel-hooks process sentinel))))

(defun rcirc-disconnect-buffer (&optional buffer)
  (with-current-buffer (or buffer (current-buffer))
    ;; set rcirc-target to nil for each channel so cleanup
    ;; doesnt happen when we reconnect
    (setq rcirc-target nil)
    (setq mode-line-process ":disconnected")))

(defun rcirc-process-list ()
  "Return a list of rcirc processes."
  (let (ps)
    (mapc (lambda (p)
            (when (buffer-live-p (process-buffer p))
              (with-rcirc-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 received from server.
Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defun rcirc-filter (process output)
  "Called when PROCESS receives OUTPUT."
  (rcirc-debug process output)
  (rcirc-reschedule-timeout process)
  (with-rcirc-process-buffer process
    (setq rcirc-last-server-message-time (current-time))
    (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))
            (split-string rcirc-process-output "[\n\r]" t))
      (setq rcirc-process-output nil))))

(defun rcirc-reschedule-timeout (process)
  (with-rcirc-process-buffer process
    (when (not rcirc-connecting)
      (with-rcirc-process-buffer process
	(when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
	(setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
					       'rcirc-delete-process
					       process))))))

(defun rcirc-delete-process (process)
  (delete-process process))

(defvar rcirc-trap-errors-flag t)
(defun rcirc-process-server-response (process text)
  (if rcirc-trap-errors-flag
      (condition-case err
          (rcirc-process-server-response-1 process text)
        (error
         (rcirc-print process "RCIRC" "ERROR" nil
                      (format "\"%s\" %s" text err) t)))
    (rcirc-process-server-response-1 process text)))

(defun rcirc-process-server-response-1 (process text)
  (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text)
      (let* ((user (match-string 2 text))
	     (sender (rcirc-user-nick user))
             (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 (delq nil (append (split-string args1 " " t)
				       (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)))

(defvar rcirc-responses-no-activity '("305" "306")
  "Responses that don't trigger activity in the mode-line indicator.")

(defun rcirc-handler-generic (process response sender args text)
  "Generic server response handler."
  (rcirc-print process sender response nil
               (mapconcat 'identity (cdr args) " ")
	       (not (member response rcirc-responses-no-activity))))

(defun rcirc-send-string (process string)
  "Send PROCESS a STRING plus a newline."
  (let ((string (concat (encode-coding-string string rcirc-encode-coding-system)
                        "\n")))
    (unless (eq (process-status process) 'open)
      (error "Network connection to %s is not open"
             (process-name process)))
    (rcirc-debug process string)
    (process-send-string process string)))

(defun rcirc-buffer-process (&optional buffer)
  "Return the process associated with channel BUFFER.
With no argument or nil as argument, use the current buffer."
  (or (get-buffer-process (if buffer
			      (with-current-buffer buffer
				rcirc-server-buffer)
			    rcirc-server-buffer))
      rcirc-process))

(defun rcirc-server-name (process)
  "Return PROCESS server name, given by the 001 response."
  (with-rcirc-process-buffer process
    (or rcirc-server-name
	(warn "server name for process %S unknown" process))))

(defun rcirc-nick (process)
  "Return PROCESS nick."
  (with-rcirc-process-buffer process
    (or rcirc-nick rcirc-default-nick)))

(defun rcirc-buffer-nick (&optional buffer)
  "Return the nick associated with BUFFER.
With no argument or nil as argument, use the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    (with-current-buffer rcirc-server-buffer
      (or rcirc-nick rcirc-default-nick))))

(defvar rcirc-max-message-length 420
  "Messages longer than this value will be split.")

(defun rcirc-send-message (process target message &optional noticep silent)
  "Send TARGET associated with PROCESS a privmsg with text MESSAGE.
If NOTICEP is non-nil, send a notice instead of privmsg.
If SILENT is non-nil, do not print the message in any irc buffer."
  ;; 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-get-buffer-create process target)
    (rcirc-send-string process (concat response " " target " :" text))
    (unless silent
      (rcirc-print process (rcirc-nick process) response target text))
    (when 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 this-command)
      (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-buffer-process)
					  rcirc-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 set-rcirc-decode-coding-system (coding-system)
  "Set the decode coding system used in this channel."
  (interactive "zCoding system for incoming messages: ")
  (setq rcirc-decode-coding-system coding-system))

(defun set-rcirc-encode-coding-system (coding-system)
  "Set the encode coding system used in this channel."
  (interactive "zCoding system for outgoing messages: ")
  (setq rcirc-encode-coding-system coding-system))

(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-toggle-low-priority)
(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-omit-mode)
(define-key rcirc-mode-map (kbd "M-o") 'rcirc-omit-mode)
(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-buffer-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)

(defvar rcirc-browse-url-map (make-sparse-keymap)
  "Keymap used for browsing URLs in `rcirc-mode'.")

(define-key rcirc-browse-url-map (kbd "RET") 'rcirc-browse-url-at-point)
(define-key rcirc-browse-url-map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse)
(define-key rcirc-browse-url-map [follow-link] 'mouse-face)

(defvar rcirc-short-buffer-name nil
  "Generated abbreviation to use to indicate buffer activity.")

(defvar rcirc-mode-hook nil
  "Hook run when setting up rcirc buffer.")

(defvar rcirc-last-post-time nil)

(defvar rcirc-log-alist nil
  "Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
Each element looks like (FILENAME . TEXT).")

(defvar rcirc-current-line 0
  "The current number of responses printed in this channel.
This number is independent of the number of lines in the 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)
  (setq mode-line-process nil)

  (make-local-variable 'rcirc-input-ring)
  (setq rcirc-input-ring (make-ring rcirc-input-ring-size))
  (make-local-variable 'rcirc-server-buffer)
  (setq rcirc-server-buffer (process-buffer process))
  (make-local-variable 'rcirc-target)
  (setq rcirc-target target)
  (make-local-variable 'rcirc-topic)
  (setq rcirc-topic nil)
  (make-local-variable 'rcirc-last-post-time)
  (setq rcirc-last-post-time (current-time))
  (make-local-variable 'fill-paragraph-function)
  (setq fill-paragraph-function 'rcirc-fill-paragraph)
  (make-local-variable 'rcirc-recent-quit-alist)
  (setq rcirc-recent-quit-alist nil)
  (make-local-variable 'rcirc-current-line)
  (setq rcirc-current-line 0)

  (make-local-variable 'rcirc-short-buffer-name)
  (setq rcirc-short-buffer-name nil)
  (make-local-variable 'rcirc-urls)
  (setq use-hard-newlines t)

  ;; setup for omitting responses
  (setq buffer-invisibility-spec '())
  (setq buffer-display-table (make-display-table))
  (set-display-table-slot buffer-display-table 4
			  (let ((glyph (make-glyph-code 
					?. 'font-lock-keyword-face)))
			    (make-vector 3 glyph)))

  (make-local-variable 'rcirc-decode-coding-system)
  (make-local-variable 'rcirc-encode-coding-system)
  (dolist (i rcirc-coding-system-alist)
    (let ((chan (if (consp (car i)) (caar i) (car i)))
	  (serv (if (consp (car i)) (cdar i) "")))
      (when (and (string-match chan (or target ""))
		 (string-match serv (rcirc-server-name process)))
	(setq rcirc-decode-coding-system (if (consp (cdr i)) (cadr i) (cdr i))
	      rcirc-encode-coding-system (if (consp (cdr i)) (cddr i) (cdr i))))))

  ;; 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)

  ;; if the user changes the major mode or kills the buffer, there is
  ;; cleanup work to do
  (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t)
  (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t)

  ;; add to buffer list, and update buffer abbrevs
  (when target				; skip server buffer
    (let ((buffer (current-buffer)))
      (with-rcirc-process-buffer process
	(setq rcirc-buffer-alist (cons (cons target buffer)
				       rcirc-buffer-alist))))
    (rcirc-update-short-buffer-names))

  (run-hooks 'rcirc-mode-hook))

(defun rcirc-update-prompt (&optional all)
  "Reset the prompt string in the current buffer.

If ALL is non-nil, update prompts in all IRC buffers."
  (if all
      (mapc (lambda (process)
	      (mapc (lambda (buffer)
		      (with-current-buffer buffer
			(rcirc-update-prompt)))
		    (with-rcirc-process-buffer process
		      (mapcar 'cdr rcirc-buffer-alist))))
	    (rcirc-process-list))
    (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" (rcirc-buffer-nick))
		  (cons "%s" (with-rcirc-server-buffer rcirc-server-name))
		  (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
				       'read-only t 'field t
				       'front-sticky t 'rear-nonsticky t))))))))

(defun rcirc-set-changed (option value)
  "Set OPTION to VALUE and do updates after a customization change."
  (set-default option value)
  (cond ((eq option 'rcirc-prompt)
	 (rcirc-update-prompt 'all))
	(t
	 (error "Bad option %s" option))))

(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-clean-up-buffer "Killed buffer")))

(defun rcirc-change-major-mode-hook ()
  "Part the channel when changing the major-mode."
  (rcirc-clean-up-buffer "Changed major mode"))

(defun rcirc-clean-up-buffer (reason)
  (let ((buffer (current-buffer)))
    (rcirc-clear-activity buffer)
    (when (and (rcirc-buffer-process)
	       (eq (process-status (rcirc-buffer-process)) 'open))
      (with-rcirc-server-buffer
       (setq rcirc-buffer-alist
	     (rassq-delete-all buffer rcirc-buffer-alist)))
      (rcirc-update-short-buffer-names)
      (if (rcirc-channel-p rcirc-target)
	  (rcirc-send-string (rcirc-buffer-process)
			     (concat "PART " rcirc-target " :" reason))
	(when rcirc-target
	  (rcirc-remove-nick-channel (rcirc-buffer-process)
				     (rcirc-buffer-nick)
				     rcirc-target))))
    (setq rcirc-target nil)))

(defun rcirc-generate-new-buffer-name (process target)
  "Return a buffer name based on PROCESS and TARGET.
This is used for the initial name given to IRC buffers."
  (substring-no-properties
   (if target
       (concat target "@" (process-name process))
     (concat "*" (process-name process) "*"))))

(defun rcirc-get-buffer (process target &optional server)
  "Return the buffer associated with the PROCESS and TARGET.

If optional argument SERVER is non-nil, return the server buffer
if there is no existing buffer for TARGET, otherwise return nil."
  (with-rcirc-process-buffer process
    (if (null target)
	(current-buffer)
      (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t))))
	(or buffer (when server (current-buffer)))))))

(defun rcirc-get-buffer-create (process target)
  "Return the buffer associated with the PROCESS and TARGET.
Create the buffer if it doesn't exist."
  (let ((buffer (rcirc-get-buffer process target)))
    (if (and buffer (buffer-live-p buffer))
	(with-current-buffer buffer
	  (when (not rcirc-target)
 	    (setq rcirc-target target))
	  buffer)
      ;; create the buffer
      (with-rcirc-process-buffer process
	(let ((new-buffer (get-buffer-create
			   (rcirc-generate-new-buffer-name process target))))
	  (with-current-buffer new-buffer
	    (rcirc-mode process target)
	    (rcirc-put-nick-channel process (rcirc-nick process) target 
				    rcirc-current-line))
	  new-buffer)))))

(defun rcirc-send-input ()
  "Send input to target associated with the current buffer."
  (interactive)
  (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)))))
    ;; process input
    (goto-char (point-max))
    (when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
      ;; delete a trailing newline
      (when (eq (point) (point-at-bol))
	(delete-char -1))
      (let ((input (buffer-substring-no-properties
		    rcirc-prompt-end-marker (point))))
	(dolist (line (split-string input "\n"))
	  (rcirc-process-input-line line))
	;; add to input-ring
	(save-excursion
	  (ring-insert rcirc-input-ring input)
	  (setq rcirc-input-ring-index 0))))))

(defun rcirc-fill-paragraph (&optional arg)
  (interactive "p")
  (when (> (point) rcirc-prompt-end-marker)
    (save-restriction
      (narrow-to-region rcirc-prompt-end-marker (point-max))
      (let ((fill-column rcirc-max-message-length))
	(fill-region (point-min) (point-max))))))

(defun rcirc-process-input-line (line)
  (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
      (rcirc-process-command (match-string 1 line)
			     (match-string 2 line)
			     line)
    (rcirc-process-message line)))

(defun rcirc-process-message (line)
  (if (not rcirc-target)
      (message "Not joined (no target)")
    (delete-region rcirc-prompt-end-marker (point))
    (rcirc-send-message (rcirc-buffer-process) rcirc-target line)
    (setq rcirc-last-post-time (current-time))))

(defun rcirc-process-command (command args line)
  (if (eq (aref command 0) ?/)
      ;; "//text" will send "/text" as a message
      (rcirc-process-message (substring line 1))
    (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
	  (process (rcirc-buffer-process)))
      (newline)
      (with-current-buffer (current-buffer)
	(delete-region rcirc-prompt-end-marker (point))
	(if (string= command "me")
	    (rcirc-print process (rcirc-buffer-nick)
			 "ACTION" rcirc-target args)
	  (rcirc-print process (rcirc-buffer-nick)
		       "COMMAND" rcirc-target line))
	(set-marker rcirc-prompt-end-marker (point))
	(if (fboundp fun)
	    (funcall fun args process rcirc-target)
	  (rcirc-send-string process
			     (concat command " :" args)))))))

(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-no-properties rcirc-prompt-end-marker 
						(point)))
          (parent (buffer-name)))
      (delete-region rcirc-prompt-end-marker (point))
      (setq rcirc-window-configuration (current-window-configuration))
      (pop-to-buffer (concat "*multiline " parent "*"))
      (funcall rcirc-multiline-major-mode)
      (rcirc-multiline-minor-mode 1)
      (setq rcirc-parent-buffer parent)
      (insert text)
      (and (> pos 0) (goto-char pos))
      (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent))))

(defvar rcirc-multiline-minor-mode-map (make-sparse-keymap)
  "Keymap for multiline mode in rcirc.")
(define-key rcirc-multiline-minor-mode-map
  (kbd "C-c C-c") 'rcirc-multiline-minor-submit)
(define-key rcirc-multiline-minor-mode-map
  (kbd "C-x C-s") 'rcirc-multiline-minor-submit)
(define-key rcirc-multiline-minor-mode-map
  (kbd "C-c C-k") 'rcirc-multiline-minor-cancel)
(define-key rcirc-multiline-minor-mode-map
  (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel)

(define-minor-mode rcirc-multiline-minor-mode
  "Minor mode for editing multiple lines in rcirc."
  :init-value nil
  :lighter " rcirc-mline"
  :keymap rcirc-multiline-minor-mode-map
  :global nil
  :group 'rcirc
  (make-local-variable 'rcirc-parent-buffer)
  (put 'rcirc-parent-buffer 'permanent-local t)
  (setq fill-column rcirc-max-message-length))

(defun rcirc-multiline-minor-submit ()
  "Send the text in buffer back to parent buffer."
  (interactive)
  (untabify (point-min) (point-max))
  (let ((text (buffer-substring (point-min) (point-max)))
        (buffer (current-buffer))
        (pos (point)))
    (set-buffer rcirc-parent-buffer)
    (goto-char (point-max))
    (insert text)
    (kill-buffer buffer)
    (set-window-configuration rcirc-window-configuration)
    (goto-char (+ rcirc-prompt-end-marker (1- pos)))))

(defun rcirc-multiline-minor-cancel ()
  "Cancel the multiline edit."
  (interactive)
  (kill-buffer (current-buffer))
  (set-window-configuration rcirc-window-configuration))

(defun rcirc-any-buffer (process)
  "Return a buffer for PROCESS, either the one selected or the process buffer."
  (if rcirc-always-use-server-buffer-flag
      (process-buffer process)
    (let ((buffer (window-buffer (selected-window))))
      (if (and buffer
	       (with-current-buffer buffer
		 (and (eq major-mode 'rcirc-mode)
		      (eq (rcirc-buffer-process) process))))
	  buffer
	(process-buffer process)))))