rcirc.el

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

;; Copyright (C) 2005-2012 Free Software Foundation, Inc.

;; Author: Ryan Yeske <rcyeske@gmail.com>
;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
;;              Deniz Dogan <deniz@dogan.se>
;; 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 mode line,
;; 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")
     ;; Don't use the TLS port by default, in case gnutls is not available.
     ;; :port 7000 :encryption tls
     ))
  "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.

`:encryption'

VALUE must be `plain' (the default) for unencrypted connections, or `tls'
for connections using SSL/TLS."
  :type '(alist :key-type string
		:value-type (plist :options
                                   ((:nick string)
                                    (:port integer)
                                    (:user-name string)
                                    (:password string)
                                    (:full-name string)
                                    (:channels (repeat string))
                                    (:encryption (choice (const tls)
                                                         (const plain))))))
  :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
  `quakenet': ACCOUNT PASSWORD

Examples:
 ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
  (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
  (\"bitlbee\" bitlbee \"robert\" \"sekrit\")
  (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
  (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
  :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"))
                                    (list :tag "QuakeNet"
                                          (const quakenet)
                                          (string :tag "Account")
                                          (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-authenticate-before-join t
  "Non-nil means authenticate to services before joining channels.
Currently only works with NickServ on some networks."
  :version "24.1"
  :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)

(defvar rcirc-authenticated-hook nil
  "Hook run after successfully authenticated.")

(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.
Set to 'undecided if you want the encoding of the incoming
messages autodetected."
  :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)

(defcustom rcirc-nick-completion-format "%s: "
  "Format string to use in nick completions.

The format string is only used when completing at the beginning
of a line.  The string is passed as the first argument to
`format' with the nickname as the second argument."
  :version "24.1"
  :type 'string
  :group 'rcirc)

(defcustom rcirc-kill-channel-buffers nil
  "When non-nil, kill channel buffers when the server buffer is killed.
Only the channel buffers associated with the server in question
will be killed."
  :version "24.2"
  :type 'boolean
  :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 mode line 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))
             (encryption (rcirc-prompt-for-encryption server-plist)))
	(rcirc-connect server port nick user-name
		       rcirc-default-full-name
		       channels password encryption))
    ;; 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))
              (encryption (plist-get (cdr c) :encryption))
              contact)
	  (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 encryption)
		    (quit (message "Quit connecting to %s" server)))
		(with-current-buffer (process-buffer connected)
                  (setq contact (process-contact
                                 (get-buffer-process (current-buffer)) :host))
                  (setq connected-servers
                        (cons (if (stringp contact) contact server)
                              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-authenticated 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 encryption)
  (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 (open-network-stream
                     server nil server port-number
                     :type (or encryption 'plain))))
      ;; 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)

      (set (make-local-variable 'rcirc-process) process)
      (set (make-local-variable 'rcirc-server) server)
      (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response.
      (set (make-local-variable 'rcirc-buffer-alist) nil)
      (set (make-local-variable 'rcirc-nick-table)
           (make-hash-table :test 'equal))
      (set (make-local-variable 'rcirc-nick) nick)
      (set (make-local-variable 'rcirc-process-output) nil)
      (set (make-local-variable 'rcirc-startup-channels) startup-channels)
      (set (make-local-variable 'rcirc-last-server-message-time)
           (current-time))

      (set (make-local-variable 'rcirc-timeout-timer) nil)
      (set (make-local-variable 'rcirc-user-disconnect) nil)
      (set (make-local-variable 'rcirc-user-authenticated) nil)
      (set (make-local-variable 'rcirc-connecting) t)

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

      ;; identify
      (unless (zerop (length 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-float-time ()
  (if (featurep 'xemacs)
      (time-to-seconds (current-time))
    (float-time)))

(defun rcirc-prompt-for-encryption (server-plist)
  "Prompt the user for the encryption method to use.
SERVER-PLIST is the property list for the server."
  (let ((msg "Encryption (default %s): ")
        (choices '("plain" "tls"))
        (default (or (plist-get server-plist :encryption)
                     'plain)))
    (intern
     (completing-read (format msg default)
                      choices nil t nil nil (symbol-name default)))))

(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-ctcp process
                                   rcirc-nick
                                   (format "KEEPALIVE %f"
                                           (rcirc-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" (- (rcirc-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
    ;; doesn't 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--connection-open-p (process)
  (memq (process-status process) '(run open)))

(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 (rcirc--connection-open-p process)
      (error "Network connection to %s is not open"
             (process-name process)))
    (rcirc-debug process string)
    (process-send-string process string)))

(defun rcirc-send-privmsg (process target string)
  (rcirc-send-string process (format "PRIVMSG %s :%s" target string)))

(defun rcirc-send-ctcp (process target request &optional args)
  (let ((args (if args (concat " " args) "")))
    (rcirc-send-privmsg process target
                        (format "\C-a%s%s\C-a" request args))))

(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 ()
  (interactive)
  (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 ()
  (interactive)
  (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-server-commands
  '("/admin"   "/away"   "/connect" "/die"      "/error"   "/info"
    "/invite"  "/ison"   "/join"    "/kick"     "/kill"    "/links"
    "/list"    "/lusers" "/mode"    "/motd"     "/names"   "/nick"
    "/notice"  "/oper"   "/part"    "/pass"     "/ping"    "/pong"
    "/privmsg" "/quit"   "/rehash"  "/restart"  "/service" "/servlist"
    "/server"  "/squery" "/squit"   "/stats"    "/summon"  "/time"
    "/topic"   "/trace"  "/user"    "/userhost" "/users"   "/version"
    "/wallops" "/who"    "/whois"   "/whowas")
  "A list of user commands by IRC server.
The value defaults to RFCs 1459 and 2812.")

;; /me and /ctcp are not defined by `defun-rcirc-command'.
(defvar rcirc-client-commands '("/me" "/ctcp")
  "A list of user commands defined by IRC client rcirc.
The list is updated automatically by `defun-rcirc-command'.")

(defun rcirc-completion-at-point ()
  "Function used for `completion-at-point-functions' in `rcirc-mode'."
  (and (rcirc-looking-at-input)
       (let* ((beg (save-excursion
		     (if (re-search-backward " " rcirc-prompt-end-marker t)
			 (1+ (point))
		       rcirc-prompt-end-marker)))
	      (table (if (and (= beg rcirc-prompt-end-marker)
			      (eq (char-after beg) ?/))
			 (delete-dups
			  (nconc (sort (copy-sequence rcirc-client-commands)
				       'string-lessp)
				 (sort (copy-sequence rcirc-server-commands)
				       'string-lessp)))
		       (rcirc-channel-nicks (rcirc-buffer-process)
					    rcirc-target))))
	 (list beg (point) table))))

(defvar rcirc-completions nil)
(defvar rcirc-completion-start nil)

(defun rcirc-complete ()
  "Cycle through completions from list of nicks in channel or IRC commands.
IRC command completion is performed only if '/' is the first input char."
  (interactive)
  (unless (rcirc-looking-at-input)
    (error "Point not located after rcirc prompt"))
  (if (eq last-command this-command)
      (setq rcirc-completions
	    (append (cdr rcirc-completions) (list (car rcirc-completions))))
    (let ((completion-ignore-case t)
	  (table (rcirc-completion-at-point)))
      (setq rcirc-completion-start (car table))
      (setq rcirc-completions
	    (and rcirc-completion-start
		 (all-completions (buffer-substring rcirc-completion-start
						    (cadr table))
				  (nth 2 table))))))
  (let ((completion (car rcirc-completions)))
    (when completion
      (delete-region rcirc-completion-start (point))
      (insert
       (cond
        ((= (aref completion 0) ?/) (concat completion " "))
        ((= rcirc-completion-start rcirc-prompt-end-marker)
         (format rcirc-nick-completion-format completion))
        (t completion))))))

(defun set-rcirc-decode-coding-system (coding-system)
  "Set the decode coding system used in this channel."
  (interactive "zCoding system for incoming messages: ")
  (set (make-local-variable '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: ")
  (set (make-local-variable 'rcirc-encode-coding-system) coding-system))

(defvar rcirc-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "RET") 'rcirc-send-input)
    (define-key map (kbd "M-p") 'rcirc-insert-prev-input)
    (define-key map (kbd "M-n") 'rcirc-insert-next-input)
    (define-key map (kbd "TAB") 'rcirc-complete)
    (define-key map (kbd "C-c C-b") 'rcirc-browse-url)
    (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline)
    (define-key map (kbd "C-c C-j") 'rcirc-cmd-join)
    (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick)
    (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority)
    (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode)
    (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg)
    (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
    (define-key map (kbd "C-c C-o") 'rcirc-omit-mode)
    (define-key map (kbd "C-c C-p") 'rcirc-cmd-part)
    (define-key map (kbd "C-c C-q") 'rcirc-cmd-query)
    (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic)
    (define-key map (kbd "C-c C-n") 'rcirc-cmd-names)
    (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois)
    (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit)
    (define-key map (kbd "C-c TAB") ; C-i
      'rcirc-toggle-ignore-buffer-activity)
    (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
    (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
    map)
  "Keymap for rcirc mode.")

(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)
  ;; FIXME: Use define-derived-mode.
  "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)

  (set (make-local-variable 'rcirc-input-ring)
       ;; If rcirc-input-ring is already a ring with desired size do
       ;; not re-initialize.
       (if (and (ring-p rcirc-input-ring)
		(= (ring-size rcirc-input-ring)
		   rcirc-input-ring-size))
	   rcirc-input-ring
	 (make-ring rcirc-input-ring-size)))
  (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
  (set (make-local-variable 'rcirc-target) target)
  (set (make-local-variable 'rcirc-topic) nil)
  (set (make-local-variable 'rcirc-last-post-time) (current-time))
  (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
  (set (make-local-variable 'rcirc-recent-quit-alist) nil)
  (set (make-local-variable 'rcirc-current-line) 0)

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

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

  (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)))
	(set (make-local-variable 'rcirc-decode-coding-system)
             (if (consp (cdr i)) (cadr i) (cdr i)))
        (set (make-local-variable 'rcirc-encode-coding-system)
             (if (consp (cdr i)) (cddr i) (cdr i))))))

  ;; setup the prompt and markers
  (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
  (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
  (rcirc-update-prompt)
  (goto-char rcirc-prompt-end-marker)

  (set (make-local-variable 'overlay-arrow-position) (make-marker))

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

  (add-hook 'completion-at-point-functions
            'rcirc-completion-at-point nil 'local)

  (run-mode-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) ?&))))

(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log"
  "Directory to keep IRC logfiles."
  :type 'directory
  :group 'rcirc)

(defcustom rcirc-log-flag nil
  "Non-nil means log IRC activity to disk.
Logfiles are kept in `rcirc-log-directory'."
  :type 'boolean
  :group 'rcirc)

(defun rcirc-kill-buffer-hook ()
  "Part the channel when killing an rcirc buffer.

If `rcirc-kill-channel-buffers' is non-nil and the killed buffer
is a server buffer, kills all of the channel buffers associated
with it."
  (when (eq major-mode 'rcirc-mode)
    (when (and rcirc-log-flag
               rcirc-log-directory)
      (rcirc-log-write))
    (rcirc-clean-up-buffer "Killed buffer")
    (when (and rcirc-buffer-alist ;; it's a server buffer
               rcirc-kill-channel-buffers)
      (dolist (channel rcirc-buffer-alist)
	(kill-buffer (cdr channel))))))

(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)
	       (rcirc--connection-open-p (rcirc-buffer-process)))
      (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