lisp/net/rcirc.el

   1 ;;; rcirc.el --- default, simple IRC client.
   2
   3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: Ryan Yeske
   6 ;; URL: http://www.nongnu.org/rcirc
   7 ;; Keywords: comm
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; This file is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This file is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Internet Relay Chat (IRC) is a form of instant communication over
  29 ;; the Internet. It is mainly designed for group (many-to-many)
  30 ;; communication in discussion forums called channels, but also allows
  31 ;; one-to-one communication.
  32
  33 ;; Rcirc has simple defaults and clear and consistent behaviour.
  34 ;; Message arrival timestamps, activity notification on the modeline,
  35 ;; message filling, nick completion, and keepalive pings are all
  36 ;; enabled by default, but can easily be adjusted or turned off.  Each
  37 ;; discussion takes place in its own buffer and there is a single
  38 ;; server buffer per connection.
  39
  40 ;; Open a new irc connection with:
  41 ;; M-x irc RET
  42
  43 ;;; Code:
  44
  45 (require 'ring)
  46 (require 'time-date)
  47 (eval-when-compile (require 'cl))
  48
  49 (defgroup rcirc nil
  50   "Simple IRC client."
  51   :version "22.1"
  52   :prefix "rcirc"
  53   :group 'applications)
  54
  55 (defcustom rcirc-server "irc.freenode.net"
  56   "The default server to connect to."
  57   :type 'string
  58   :group 'rcirc)
  59
  60 (defcustom rcirc-port 6667
  61   "The default port to connect to."
  62   :type 'integer
  63   :group 'rcirc)
  64
  65 (defcustom rcirc-nick (user-login-name)
  66   "Your nick."
  67   :type 'string
  68   :group 'rcirc)
  69
  70 (defcustom rcirc-user-name (user-login-name)
  71   "Your user name sent to the server when connecting."
  72   :type 'string
  73   :group 'rcirc)
  74
  75 (defcustom rcirc-user-full-name (if (string= (user-full-name) "")
  76                                  rcirc-user-name
  77                                (user-full-name))
  78   "The full name sent to the server when connecting."
  79   :type 'string
  80   :group 'rcirc)
  81
  82 (defcustom rcirc-startup-channels-alist nil
  83   "Alist of channels to join at startup.
  84 Each element looks like (SERVER-REGEXP . CHANNEL-LIST)."
  85   :type '(alist :key-type string :value-type (repeat string))
  86   :group 'rcirc)
  87
  88 (defcustom rcirc-fill-flag t
  89   "*Non-nil means line-wrap messages printed in channel buffers."
  90   :type 'boolean
  91   :group 'rcirc)
  92
  93 (defcustom rcirc-fill-column nil
  94   "*Column beyond which automatic line-wrapping should happen.
  95 If nil, use value of `fill-column'.  If frame-width, use the
  96 maximum frame width."
  97   :type '(choice (const :tag "Value of `fill-column'")
  98                  (const :tag "Full frame width" frame-width)
  99                  (integer :tag "Number of columns"))
 100   :group 'rcirc)
 101
 102 (defcustom rcirc-fill-prefix nil
 103   "*Text to insert before filled lines.
 104 If nil, calculate the prefix dynamically to line up text
 105 underneath each nick."
 106   :type '(choice (const :tag "Dynamic" nil)
 107                  (string :tag "Prefix text"))
 108   :group 'rcirc)
 109
 110 (defvar rcirc-ignore-buffer-activity-flag nil
 111   "If non-nil, ignore activity in this buffer.")
 112 (make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag)
 113
 114 (defcustom rcirc-ignore-all-activity-flag nil
 115   "*Non-nil means do not indicate any activity in the modeline."
 116   :type 'boolean
 117   :group 'rcirc)
 118
 119 (defcustom rcirc-time-format "%H:%M "
 120   "*Describes how timestamps are printed.
 121 Used as the first arg to `format-time-string'."
 122   :type 'string
 123   :group 'rcirc)
 124
 125 (defcustom rcirc-input-ring-size 1024
 126   "*Size of input history ring."
 127   :type 'integer
 128   :group 'rcirc)
 129
 130 (defcustom rcirc-read-only-flag t
 131   "*Non-nil means make text in irc buffers read-only."
 132   :type 'boolean
 133   :group 'rcirc)
 134
 135 (defcustom rcirc-buffer-maximum-lines nil
 136   "*The maximum size in lines for rcirc buffers.
 137 Channel buffers are truncated from the top to be no greater than this
 138 number.  If zero or nil, no truncating is done."
 139   :type '(choice (const :tag "No truncation" nil)
 140                  (integer :tag "Number of lines"))
 141   :group 'rcirc)
 142
 143 (defcustom rcirc-authinfo-file-name
 144   "~/.rcirc-authinfo"
 145   "File containing rcirc authentication passwords.
 146 The file consists of a single list, with each element itself a
 147 list with a SERVER-REGEXP string, a NICK-REGEXP string, a METHOD
 148 and the remaining method specific ARGUMENTS.  The valid METHOD
 149 symbols are `nickserv', `chanserv' and `bitlbee'.
 150
 151 The required ARGUMENTS for each METHOD symbol are:
 152   `nickserv': PASSWORD
 153   `chanserv': CHANNEL PASSWORD
 154   `bitlbee': PASSWORD
 155
 156 Example:
 157  ((\"freenode\" \"bob\" nickserv \"p455w0rd\")
 158   (\"freenode\" \"bob\" chanserv \"#bobland\" \"passwd99\")
 159   (\"bitlbee\" \"robert\" bitlbee \"sekrit\"))"
 160   :type 'string
 161   :group 'rcirc)
 162
 163 (defcustom rcirc-auto-authenticate-flag (file-readable-p rcirc-authinfo-file-name)
 164   "*Non-nil means automatically send authentication string to server.
 165 See also `rcirc-authinfo-file-name'."
 166   :type 'boolean
 167   :group 'rcirc)
 168
 169 (defcustom rcirc-prompt "> "
 170   "Prompt string to use in irc buffers.
 171
 172 The following replacements are made:
 173 %n is your nick.
 174 %s is the server.
 175 %t is the buffer target, a channel or a user.
 176
 177 Setting this alone will not affect the prompt;
 178 use either M-x customize or also call `rcirc-update-prompt'."
 179   :type 'string
 180   :set 'rcirc-set-changed
 181   :initialize 'custom-initialize-default
 182   :group 'rcirc)
 183
 184 (defcustom rcirc-print-hooks nil
 185   "Hook run after text is printed.
 186 Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
 187   :type 'hook
 188   :group 'rcirc)
 189
 190 (defvar rcirc-prompt-start-marker nil)
 191 (defvar rcirc-prompt-end-marker nil)
 192
 193 (defvar rcirc-nick-table nil)
 194
 195 ;; each process has an alist of (target . buffer) pairs
 196 (defvar rcirc-buffer-alist nil)
 197
 198 (defvar rcirc-activity nil
 199   "List of channels with unviewed activity.")
 200
 201 (defvar rcirc-activity-string ""
 202   "String displayed in modeline representing `rcirc-activity'.")
 203 (put 'rcirc-activity-string 'risky-local-variable t)
 204
 205 (defvar rcirc-process nil
 206   "The server process associated with this buffer.")
 207
 208 (defvar rcirc-target nil
 209   "The channel or user associated with this buffer.")
 210
 211 (defvar rcirc-urls nil
 212   "List of urls seen in the current buffer.")
 213
 214 (defvar rcirc-keepalive-seconds 60
 215   "Number of seconds between keepalive pings.")
 216
 217 (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
 218 \f
 219 (defvar rcirc-startup-channels nil)
 220 ;;;###autoload
 221 (defun rcirc (&optional server port nick channels)
 222   "Connect to IRC.
 223
 224 If any of the the optional SERVER, PORT, NICK or CHANNELS are not
 225 supplied, they are taken from the variables `rcirc-server',
 226 `rcirc-port', `rcirc-nick', and `rcirc-startup-channels-alist',
 227 respectively."
 228   (interactive (list (read-string "IRC Server: " rcirc-server)
 229                      (read-string "IRC Port: " (number-to-string rcirc-port))
 230                      (read-string "IRC Nick: " rcirc-nick)))
 231   (or server (setq server rcirc-server))
 232   (or port (setq port rcirc-port))
 233   (or nick (setq nick rcirc-nick))
 234   (or channels
 235       (setq channels
 236             (if (interactive-p)
 237                 (split-string
 238                  (read-string "Channels: "
 239                               (mapconcat 'identity
 240                                          (rcirc-startup-channels server)
 241                                          " "))
 242                          "[, ]+" t)
 243               (rcirc-startup-channels server))))
 244   (or global-mode-string (setq global-mode-string '("")))
 245   (and (not (memq 'rcirc-activity-string global-mode-string))
 246        (setq global-mode-string
 247              (append global-mode-string '(rcirc-activity-string))))
 248   (add-hook 'window-configuration-change-hook
 249             'rcirc-window-configuration-change)
 250   (rcirc-connect server port nick rcirc-user-name rcirc-user-full-name
 251                  channels))
 252
 253 ;;;###autoload
 254 (defalias 'irc 'rcirc)
 255
 256 \f
 257 (defvar rcirc-process-output nil)
 258 (defvar rcirc-topic nil)
 259 (defvar rcirc-keepalive-timer nil)
 260 (make-variable-buffer-local 'rcirc-topic)
 261 (defun rcirc-connect (server port nick user-name full-name startup-channels)
 262   "Return a connection to SERVER on PORT.
 263
 264 User will identify using the values of NICK, USER-NAME and
 265 FULL-NAME.  The variable list of channel names in
 266 STARTUP-CHANNELS will automatically be joined on startup."
 267   (save-excursion
 268     (message "Connecting to %s..." server)
 269     (let* ((inhibit-eol-conversion)
 270            (port-number (if (stringp port)
 271                             (string-to-number port)
 272                           port))
 273            (process (open-network-stream server nil server port-number)))
 274       ;; set up process
 275       (set-process-coding-system process 'raw-text 'raw-text)
 276       (set-process-filter process 'rcirc-filter)
 277       (switch-to-buffer (rcirc-generate-new-buffer-name process nil))
 278       (set-process-buffer process (current-buffer))
 279       (set-process-sentinel process 'rcirc-sentinel)
 280       (rcirc-mode process nil)
 281       (make-local-variable 'rcirc-buffer-alist)
 282       (setq rcirc-buffer-alist nil)
 283       (make-local-variable 'rcirc-nick-table)
 284       (setq rcirc-nick-table (make-hash-table :test 'equal))
 285       (make-local-variable 'rcirc-server)
 286       (setq rcirc-server server)
 287       (make-local-variable 'rcirc-nick)
 288       (setq rcirc-nick nick)
 289       (make-local-variable 'rcirc-process-output)
 290       (setq rcirc-process-output nil)
 291       (make-local-variable 'rcirc-startup-channels)
 292       (setq rcirc-startup-channels startup-channels)
 293
 294       ;; identify
 295       (rcirc-send-string process (concat "NICK " nick))
 296       (rcirc-send-string process (concat "USER " user-name
 297                                       " hostname servername :"
 298                                       full-name))
 299
 300       ;; setup ping timer if necessary
 301       (unless rcirc-keepalive-timer
 302         (setq rcirc-keepalive-timer
 303               (run-at-time 0 rcirc-keepalive-seconds 'rcirc-keepalive)))
 304
 305       (message "Connecting to %s...done" server)
 306
 307       ;; return process object
 308       process)))
 309
 310 (defmacro with-rcirc-process-buffer (process &rest body)
 311   (declare (indent 1) (debug t))
 312   `(with-current-buffer (process-buffer ,process)
 313      ,@body))
 314
 315 (defun rcirc-keepalive ()
 316   "Send keep alive pings to active rcirc processes."
 317   (if (rcirc-process-list)
 318       (mapc (lambda (process)
 319               (with-rcirc-process-buffer process
 320                 (rcirc-send-string process (concat "PING " rcirc-server))))
 321             (rcirc-process-list))
 322     (cancel-timer rcirc-keepalive-timer)
 323     (setq rcirc-keepalive-timer nil)))
 324
 325 (defvar rcirc-debug-buffer " *rcirc debug*")
 326 (defvar rcirc-debug-flag nil
 327   "If non-nil, write information to `rcirc-debug-buffer'.")
 328 (defun rcirc-debug (process text)
 329   "Add an entry to the debug log including PROCESS and TEXT.
 330 Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-p'
 331 is non-nil."
 332   (when rcirc-debug-flag
 333     (save-excursion
 334       (save-window-excursion
 335         (set-buffer (get-buffer-create rcirc-debug-buffer))
 336         (goto-char (point-max))
 337         (insert (concat
 338                  "["
 339                  (format-time-string "%Y-%m-%dT%T ") (process-name process)
 340                  "] "
 341                  text))))))
 342
 343 (defvar rcirc-sentinel-hooks nil
 344   "Hook functions called when the process sentinel is called.
 345 Functions are called with PROCESS and SENTINEL arguments.")
 346
 347 (defun rcirc-sentinel (process sentinel)
 348   "Called when PROCESS receives SENTINEL."
 349   (let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
 350     (rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
 351     (with-rcirc-process-buffer process
 352       (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
 353         (rcirc-print process "rcirc.el" "ERROR" buffer
 354                      (format "%s: %s (%S)"
 355                              (process-name process)
 356                              sentinel
 357                              (process-status process)) t)
 358         ;; remove the prompt from buffers
 359         (with-current-buffer (or buffer (current-buffer))
 360           (let ((inhibit-read-only t))
 361             (delete-region rcirc-prompt-start-marker
 362                            rcirc-prompt-end-marker)))))
 363     (run-hook-with-args 'rcirc-sentinel-hooks process sentinel)))
 364
 365 (defun rcirc-process-list ()
 366   "Return a list of rcirc processes."
 367   (let (ps)
 368     (mapc (lambda (p)
 369             (when (process-buffer p)
 370               (with-rcirc-process-buffer p
 371                 (when (eq major-mode 'rcirc-mode)
 372                   (setq ps (cons p ps))))))
 373           (process-list))
 374     ps))
 375
 376 (defvar rcirc-receive-message-hooks nil
 377   "Hook functions run when a message is recieved from server.
 378 Function is called with PROCESS COMMAND SENDER ARGS and LINE.")
 379 (defun rcirc-filter (process output)
 380   "Called when PROCESS receives OUTPUT."
 381   (rcirc-debug process output)
 382   (with-rcirc-process-buffer process
 383     (setq rcirc-process-output (concat rcirc-process-output output))
 384     (when (= (aref rcirc-process-output
 385                    (1- (length rcirc-process-output))) ?\n)
 386       (mapc (lambda (line)
 387               (rcirc-process-server-response process line))
 388             (split-string rcirc-process-output "[\n\r]" t))
 389       (setq rcirc-process-output nil))))
 390
 391 (defvar rcirc-trap-errors-flag t)
 392 (defun rcirc-process-server-response (process text)
 393   (if rcirc-trap-errors-flag
 394       (condition-case err
 395           (rcirc-process-server-response-1 process text)
 396         (error
 397          (rcirc-print process "RCIRC" "ERROR" nil
 398                       (format "\"%s\" %s" text err) t)))
 399     (rcirc-process-server-response-1 process text)))
 400
 401 (defun rcirc-process-server-response-1 (process text)
 402   (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text)
 403       (let* ((sender (match-string 2 text))
 404              (cmd (match-string 3 text))
 405              (args (match-string 4 text))
 406              (handler (intern-soft (concat "rcirc-handler-" cmd))))
 407         (string-match "^\\([^:]*\\):?\\(.+\\)?$" args)
 408         (let* ((args1 (match-string 1 args))
 409                (args2 (match-string 2 args))
 410                (args (delq nil (append (split-string args1 " " t)
 411                                        (list args2)))))
 412         (if (not (fboundp handler))
 413             (rcirc-handler-generic process cmd sender args text)
 414           (funcall handler process sender args text))
 415         (run-hook-with-args 'rcirc-receive-message-hooks
 416                             process cmd sender args text)))
 417     (message "UNHANDLED: %s" text)))
 418
 419 (defun rcirc-handler-generic (process command sender args text)
 420   "Generic server response handler."
 421   (rcirc-print process sender command nil
 422                (mapconcat 'identity (cdr args) " ") t))
 423
 424 (defun rcirc-send-string (process string)
 425   "Send PROCESS a STRING plus a newline."
 426   (let ((string (concat (encode-coding-string string
 427                                               buffer-file-coding-system)
 428                         "\n")))
 429     (rcirc-debug process string)
 430     (process-send-string process string)))
 431
 432 (defun rcirc-server (process)
 433   "Return PROCESS server, given by the 001 response."
 434   (with-rcirc-process-buffer process
 435     rcirc-server))
 436
 437 (defun rcirc-nick (process)
 438   "Return PROCESS nick."
 439   (with-rcirc-process-buffer process
 440     rcirc-nick))
 441
 442 (defvar rcirc-max-message-length 450
 443   "Messages longer than this value will be split.")
 444
 445 (defun rcirc-send-message (process target message &optional noticep)
 446   "Send TARGET associated with PROCESS a privmsg with text MESSAGE.
 447 If NOTICEP is non-nil, send a notice instead of privmsg."
 448   ;; max message length is 512 including CRLF
 449   (let* ((response (if noticep "NOTICE" "PRIVMSG"))
 450          (oversize (> (length message) rcirc-max-message-length))
 451          (text (if oversize
 452                    (substring message 0 rcirc-max-message-length)
 453                  message))
 454          (text (if (string= text "")
 455                    " "
 456                  text))
 457          (more (if oversize
 458                    (substring message rcirc-max-message-length))))
 459     (rcirc-print process (rcirc-nick process) response
 460                  (rcirc-get-buffer-create process target)
 461                  text)
 462     (rcirc-send-string process (concat response " " target " :" text))
 463     (if more
 464         (rcirc-send-message process target more noticep))))
 465
 466 (defvar rcirc-input-ring nil)
 467 (defvar rcirc-input-ring-index 0)
 468 (defun rcirc-prev-input-string (arg)
 469   (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
 470
 471 (defun rcirc-insert-prev-input (arg)
 472   (interactive "p")
 473   (when (<= rcirc-prompt-end-marker (point))
 474     (delete-region rcirc-prompt-end-marker (point-max))
 475     (insert (rcirc-prev-input-string 0))
 476     (setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
 477
 478 (defun rcirc-insert-next-input (arg)
 479   (interactive "p")
 480   (when (<= rcirc-prompt-end-marker (point))
 481     (delete-region rcirc-prompt-end-marker (point-max))
 482     (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
 483     (insert (rcirc-prev-input-string -1))))
 484
 485 (defvar rcirc-nick-completions nil)
 486 (defvar rcirc-nick-completion-start-offset nil)
 487 (defun rcirc-complete-nick ()
 488   "Cycle through nick completions from list of nicks in channel."
 489   (interactive)
 490   (if (eq last-command 'rcirc-complete-nick)
 491       (setq rcirc-nick-completions
 492             (append (cdr rcirc-nick-completions)
 493                     (list (car rcirc-nick-completions))))
 494     (setq rcirc-nick-completion-start-offset
 495           (- (save-excursion
 496                (if (re-search-backward " " rcirc-prompt-end-marker t)
 497                    (1+ (point))
 498                  rcirc-prompt-end-marker))
 499              rcirc-prompt-end-marker))
 500     (setq rcirc-nick-completions
 501           (let ((completion-ignore-case t))
 502             (all-completions
 503              (buffer-substring
 504               (+ rcirc-prompt-end-marker
 505                  rcirc-nick-completion-start-offset)
 506               (point))
 507              (mapcar (lambda (x) (cons x nil))
 508                      (rcirc-channel-nicks rcirc-process
 509                                           (rcirc-buffer-target)))))))
 510   (let ((completion (car rcirc-nick-completions)))
 511     (when completion
 512       (delete-region (+ rcirc-prompt-end-marker
 513                         rcirc-nick-completion-start-offset)
 514                      (point))
 515       (insert (concat completion
 516                       (if (= (+ rcirc-prompt-end-marker
 517                                 rcirc-nick-completion-start-offset)
 518                              rcirc-prompt-end-marker)
 519                           ": "))))))
 520
 521 (defun rcirc-buffer-target (&optional buffer)
 522   "Return the name of target for BUFFER.
 523 If buffer is nil, return the target of the current buffer."
 524   (with-current-buffer (or buffer (current-buffer))
 525     rcirc-target))
 526
 527 (defvar rcirc-mode-map (make-sparse-keymap)
 528   "Keymap for rcirc mode.")
 529
 530 (define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input)
 531 (define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
 532 (define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
 533 (define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick)
 534 (define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url)
 535 (define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
 536 (define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
 537 (define-key rcirc-mode-map (kbd "C-c C-k") 'rcirc-cmd-kick)
 538 (define-key rcirc-mode-map (kbd "C-c C-l") 'rcirc-cmd-list)
 539 (define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode)
 540 (define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg)
 541 (define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
 542 (define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-cmd-oper)
 543 (define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part)
 544 (define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query)
 545 (define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic)
 546 (define-key rcirc-mode-map (kbd "C-c C-n") 'rcirc-cmd-names)
 547 (define-key rcirc-mode-map (kbd "C-c C-w") 'rcirc-cmd-whois)
 548 (define-key rcirc-mode-map (kbd "C-c C-x") 'rcirc-cmd-quit)
 549 (define-key rcirc-mode-map (kbd "C-c TAB") ; C-i
 550   'rcirc-toggle-ignore-buffer-activity)
 551 (define-key rcirc-mode-map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
 552 (define-key rcirc-mode-map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
 553
 554 (define-key global-map (kbd "C-c `") 'rcirc-next-active-buffer)
 555 (define-key global-map (kbd "C-c C-@") 'rcirc-next-active-buffer)
 556 (define-key global-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
 557
 558 (defvar rcirc-browse-url-map (make-sparse-keymap)
 559   "Keymap used ror browsing URLs in `rcirc-mode'.")
 560
 561 (define-key rcirc-browse-url-map (kbd "RET") 'rcirc-browse-url-at-point)
 562 (define-key rcirc-browse-url-map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse)
 563
 564 (defvar rcirc-short-buffer-name nil
 565   "Generated abbreviation to use to indicate buffer activity.")
 566
 567 (defvar rcirc-mode-hook nil
 568   "Hook run when setting up rcirc buffer.")
 569
 570 (defun rcirc-mode (process target)
 571   "Major mode for irc channel buffers.
 572
 573 \\{rcirc-mode-map}"
 574   (kill-all-local-variables)
 575   (use-local-map rcirc-mode-map)
 576   (setq mode-name "rcirc")
 577   (setq major-mode 'rcirc-mode)
 578
 579   (make-local-variable 'rcirc-input-ring)
 580   (setq rcirc-input-ring (make-ring rcirc-input-ring-size))
 581   (make-local-variable 'rcirc-process)
 582   (setq rcirc-process process)
 583   (make-local-variable 'rcirc-target)
 584   (setq rcirc-target target)
 585
 586   (make-local-variable 'rcirc-short-buffer-name)
 587   (setq rcirc-short-buffer-name nil)
 588   (make-local-variable 'rcirc-urls)
 589   (setq rcirc-urls nil)
 590   (setq use-hard-newlines t)
 591
 592   ;; setup the prompt and markers
 593   (make-local-variable 'rcirc-prompt-start-marker)
 594   (setq rcirc-prompt-start-marker (make-marker))
 595   (set-marker rcirc-prompt-start-marker (point-max))
 596   (make-local-variable 'rcirc-prompt-end-marker)
 597   (setq rcirc-prompt-end-marker (make-marker))
 598   (set-marker rcirc-prompt-end-marker (point-max))
 599   (rcirc-update-prompt)
 600   (goto-char rcirc-prompt-end-marker)
 601   (make-local-variable 'overlay-arrow-position)
 602   (setq overlay-arrow-position (make-marker))
 603   (set-marker overlay-arrow-position nil)
 604
 605   ;; add to buffer list, and update buffer abbrevs
 606   (when target                          ; skip server buffer
 607     (let ((buffer (current-buffer)))
 608       (with-rcirc-process-buffer process
 609         (setq rcirc-buffer-alist (cons (cons target buffer)
 610                                        rcirc-buffer-alist))))
 611     (rcirc-update-short-buffer-names))
 612
 613   (run-hooks 'rcirc-mode-hook))
 614
 615 (defun rcirc-update-prompt (&optional all)
 616   "Reset the prompt string in the current buffer.
 617
 618 If ALL is non-nil, update prompts in all IRC buffers."
 619   (if all
 620       (mapc (lambda (process)
 621               (mapc (lambda (buffer)
 622                       (with-current-buffer buffer
 623                         (rcirc-update-prompt)))
 624                     (with-rcirc-process-buffer process
 625                       (mapcar 'cdr rcirc-buffer-alist))))
 626             (rcirc-process-list))
 627     (let ((inhibit-read-only t)
 628           (prompt (or rcirc-prompt "")))
 629       (mapc (lambda (rep)
 630               (setq prompt
 631                     (replace-regexp-in-string (car rep) (regexp-quote (cdr rep)) prompt)))
 632             (list (cons "%n" (with-rcirc-process-buffer rcirc-process
 633                                rcirc-nick))
 634                   (cons "%s" (with-rcirc-process-buffer rcirc-process
 635                                rcirc-server))
 636                   (cons "%t" (or rcirc-target ""))))
 637       (save-excursion
 638         (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
 639         (goto-char rcirc-prompt-start-marker)
 640         (let ((start (point)))
 641           (insert-before-markers prompt)
 642           (set-marker rcirc-prompt-start-marker start)
 643           (when (not (zerop (- rcirc-prompt-end-marker
 644                                rcirc-prompt-start-marker)))
 645             (add-text-properties rcirc-prompt-start-marker
 646                                  rcirc-prompt-end-marker
 647                                  (list 'face 'rcirc-prompt
 648                                        'read-only t 'field t
 649                                        'front-sticky t 'rear-nonsticky t))))))))
 650
 651 (defun rcirc-set-changed (option value)
 652   "Set OPTION to VALUE and do updates after a customization change."
 653   (set-default option value)
 654   (cond ((eq option 'rcirc-prompt)
 655          (rcirc-update-prompt 'all))
 656         (t
 657          (error "Bad option %s" option))))
 658
 659 (defun rcirc-channel-p (target)
 660   "Return t if TARGET is a channel name."
 661   (and target
 662        (not (zerop (length target)))
 663        (or (eq (aref target 0) ?#)
 664            (eq (aref target 0) ?&))))
 665
 666 (defun rcirc-kill-buffer-hook ()
 667   "Part the channel when killing an rcirc buffer."
 668   (when (eq major-mode 'rcirc-mode)
 669     (rcirc-kill-buffer-hook-1)))
 670 (defun rcirc-kill-buffer-hook-1 ()
 671   (let ((buffer (current-buffer)))
 672     (rcirc-clear-activity buffer)
 673     (when (and rcirc-process
 674                (eq (process-status rcirc-process) 'open))
 675       (with-rcirc-process-buffer rcirc-process
 676         (setq rcirc-buffer-alist
 677               (rassq-delete-all buffer rcirc-buffer-alist)))
 678       (rcirc-update-short-buffer-names)
 679       (if (rcirc-channel-p rcirc-target)
 680           (rcirc-send-string rcirc-process
 681                              (concat "PART " rcirc-target
 682                                      " :Killed buffer"))
 683         (when rcirc-target
 684           (rcirc-remove-nick-channel rcirc-process
 685                                      (rcirc-nick rcirc-process)
 686                                      rcirc-target))))))
 687
 688 (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook)
 689
 690 (defun rcirc-generate-new-buffer-name (process target)
 691   "Return a buffer name based on PROCESS and TARGET.
 692 This is used for the initial name given to irc buffers."
 693   (if target
 694       (concat target "@" (process-name process))
 695     (concat "*" (process-name process) "*")))
 696
 697 (defun rcirc-get-buffer (process target &optional server)
 698   "Return the buffer associated with the PROCESS and TARGET.
 699
 700 If TARGET is nil, return the server buffer.
 701
 702 If optional argument SERVER is non-nil, return the server buffer
 703 if there is no existing buffer for TARGET, otherwise return nil."
 704   (with-rcirc-process-buffer process
 705     (if (null target)
 706         (current-buffer)
 707       (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t))))
 708         (or buffer (when server (current-buffer)))))))
 709
 710 (defun rcirc-get-buffer-create (process target)
 711   "Return the buffer associated with the PROCESS and TARGET.
 712 Create the buffer if it doesn't exist."
 713   (let ((buffer (rcirc-get-buffer process target)))
 714     (or buffer
 715         ;; create the buffer
 716         (with-rcirc-process-buffer process
 717           (let ((new-buffer (get-buffer-create
 718                              (rcirc-generate-new-buffer-name process target))))
 719             (with-current-buffer new-buffer
 720               (rcirc-mode process target))
 721             (rcirc-put-nick-channel process (rcirc-nick process) target)
 722             new-buffer)))))
 723
 724 (defun rcirc-send-input ()
 725   "Send input to target associated with the current buffer."
 726   (interactive)
 727   (if (not (eq (process-status rcirc-process) 'open))
 728       (error "Network connection to %s is not open"
 729              (process-name rcirc-process))
 730     (if (< (point) rcirc-prompt-end-marker)
 731         ;; copy the line down to the input area
 732         (progn
 733           (forward-line 0)
 734           (let ((start (if (eq (point) (point-min))
 735                            (point)
 736                          (if (get-text-property (1- (point)) 'hard)
 737                              (point)
 738                            (previous-single-property-change (point) 'hard))))
 739                 (end (next-single-property-change (1+ (point)) 'hard)))
 740             (goto-char (point-max))
 741             (insert (replace-regexp-in-string
 742                      "\n\\s-+" " "
 743                      (buffer-substring-no-properties start end)))))
 744       ;; process input
 745       (goto-char (point-max))
 746       (let ((target (rcirc-buffer-target))
 747             (start rcirc-prompt-end-marker))
 748         (when (not (equal 0 (- (point) start)))
 749           ;; delete a trailing newline
 750           (when (eq (point) (point-at-bol))
 751             (delete-backward-char 1))
 752           (let ((input (buffer-substring-no-properties
 753                         rcirc-prompt-end-marker (point))))
 754             ;; process a /cmd
 755             (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input)
 756                 (let* ((command (match-string 1 input))
 757                        (fun (intern-soft (concat "rcirc-cmd-" command)))
 758                        (args (match-string 2 input)))
 759                   (newline)
 760                   (with-current-buffer (current-buffer)
 761                     (delete-region rcirc-prompt-end-marker (point))
 762                     (if (string= command "me")
 763                         (rcirc-print rcirc-process (rcirc-nick rcirc-process)
 764                                      "ACTION" (current-buffer) args)
 765                       (rcirc-print rcirc-process (rcirc-nick rcirc-process)
 766                                    "COMMAND" (current-buffer) input))
 767                     (set-marker rcirc-prompt-end-marker (point))
 768                     (if (fboundp fun)
 769                         (funcall fun args rcirc-process target)
 770                       (rcirc-send-string rcirc-process
 771                                          (concat command " " args)))))
 772               ;; send message to server
 773               (if (not rcirc-target)
 774                   (message "Not joined")
 775                 (delete-region rcirc-prompt-end-marker (point))
 776                 (mapc (lambda (message)
 777                         (rcirc-send-message rcirc-process target message))
 778                       (split-string input "\n"))))
 779             ;; add to input-ring
 780             (save-excursion
 781               (ring-insert rcirc-input-ring input)
 782               (setq rcirc-input-ring-index 0))))))))
 783
 784 (defvar rcirc-parent-buffer nil)
 785 (defvar rcirc-window-configuration nil)
 786 (defun rcirc-edit-multiline ()
 787   "Move current edit to a dedicated buffer."
 788   (interactive)
 789   (let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
 790     (goto-char (point-max))
 791     (let ((text (buffer-substring rcirc-prompt-end-marker (point)))
 792           (parent (buffer-name))
 793           (process rcirc-process))
 794       (delete-region rcirc-prompt-end-marker (point))
 795       (setq rcirc-window-configuration (current-window-configuration))
 796       (pop-to-buffer (concat "*multiline " parent "*"))
 797       (rcirc-multiline-edit-mode)
 798       (setq rcirc-parent-buffer parent)
 799       (setq rcirc-process process)
 800       (insert text)
 801       (and (> pos 0) (goto-char pos)))))
 802
 803 (define-derived-mode rcirc-multiline-edit-mode
 804   text-mode "rcirc multi"
 805   "Major mode for multiline edits
 806 \\{rcirc-multiline-edit-mode-map}"
 807   (make-local-variable 'rcirc-parent-buffer)
 808   (make-local-variable 'rcirc-process))
 809
 810 (define-key rcirc-multiline-edit-mode-map
 811   (kbd "C-c C-c") 'rcirc-multiline-edit-submit)
 812 (define-key rcirc-multiline-edit-mode-map
 813   (kbd "C-x C-s") 'rcirc-multiline-edit-submit)
 814 (define-key rcirc-multiline-edit-mode-map
 815   (kbd "C-c C-k") 'rcirc-multiline-edit-cancel)
 816 (define-key rcirc-multiline-edit-mode-map
 817   (kbd "ESC ESC ESC") 'rcirc-multiline-edit-cancel)
 818
 819 (defun rcirc-multiline-edit-submit ()
 820   "Send the text in buffer back to parent buffer."
 821   (interactive)
 822   (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
 823   (assert rcirc-parent-buffer)
 824   (untabify (point-min) (point-max))
 825   (let ((text (buffer-substring (point-min) (point-max)))
 826         (buffer (current-buffer))
 827         (pos (point)))
 828     (set-buffer rcirc-parent-buffer)
 829     (goto-char (point-max))
 830     (insert text)
 831     (kill-buffer buffer)
 832     (set-window-configuration rcirc-window-configuration)
 833     (goto-char (+ rcirc-prompt-end-marker (1- pos)))))
 834
 835 (defun rcirc-multiline-edit-cancel ()
 836   "Cancel the multiline edit."
 837   (interactive)
 838   (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
 839   (kill-buffer (current-buffer))
 840   (set-window-configuration rcirc-window-configuration))
 841
 842 (defun rcirc-get-any-buffer (process)
 843   "Return a buffer for PROCESS, either the one selected or the process buffer."
 844   (let ((buffer (window-buffer (selected-window))))
 845     (if (and buffer
 846              (with-current-buffer buffer
 847                (and (eq major-mode 'rcirc-mode)
 848                     (eq rcirc-process process))))
 849         buffer
 850       (process-buffer process))))
 851
 852 (defun rcirc-format-response-string (process sender response target text)
 853   (concat (when rcirc-time-format
 854             (format-time-string rcirc-time-format (current-time)))
 855           (cond ((or (string= response "PRIVMSG")
 856                      (string= response "NOTICE")
 857                      (string= response "ACTION"))
 858                  (let (first middle end)
 859                    (cond ((string= response "PRIVMSG")
 860                           (setq first "<" middle "> "))
 861                          ((string= response "NOTICE")
 862                           (when sender
 863                             (setq first "-" middle "- ")))
 864                          (t
 865                           (setq first "[" middle " " end "]")))
 866                    (concat first
 867                            (rcirc-facify (rcirc-user-nick sender)
 868                                          (if (string= sender
 869                                                       (rcirc-nick process))
 870                                              'rcirc-my-nick
 871                                            'rcirc-other-nick))
 872                            middle
 873                            (rcirc-mangle-text process text)
 874                            end)))
 875                 ((string= response "COMMAND")
 876                  text)
 877                 ((string= response "ERROR")
 878                  (propertize (concat "!!! " text)
 879                              'face 'font-lock-warning-face))
 880                 (t
 881                  (rcirc-mangle-text
 882                   process
 883                   (rcirc-facify
 884                    (concat "*** "
 885                            (when (not (string= sender (rcirc-server process)))
 886                              (concat (rcirc-user-nick sender) " "))
 887                            (when (zerop (string-to-number response))
 888                              (concat response " "))
 889                            text)
 890                    'rcirc-server))))))
 891
 892 (defvar rcirc-activity-type nil)
 893 (make-variable-buffer-local 'rcirc-activity-type)
 894 (defun rcirc-print (process sender response target text &optional activity)
 895   "Print TEXT in the buffer associated with TARGET.
 896 Format based on SENDER and RESPONSE.  If ACTIVITY is non-nil,
 897 record activity."
 898   (let* ((buffer (cond ((bufferp target)
 899                         target)
 900                        ((not target)
 901                         (rcirc-get-any-buffer process))
 902                        ((not (rcirc-channel-p target))
 903                         (rcirc-get-buffer-create process
 904                                                  (rcirc-user-nick sender)))
 905                        ((or (rcirc-get-buffer process target)
 906                             (rcirc-get-any-buffer process)))))
 907          (inhibit-read-only t))
 908     (with-current-buffer buffer
 909       (let ((moving (= (point) rcirc-prompt-end-marker))
 910             (old-point (point-marker))
 911             (fill-start (marker-position rcirc-prompt-start-marker)))
 912
 913         (unless (string= sender (rcirc-nick process))
 914           ;; only decode text from other senders, not ours
 915           (setq text (decode-coding-string (or text "")
 916                                            buffer-file-coding-system))
 917           ;; mark the line with overlay arrow
 918           (unless (or (marker-position overlay-arrow-position)
 919                       (get-buffer-window (current-buffer)))
 920             (set-marker overlay-arrow-position
 921                         (marker-position rcirc-prompt-start-marker))))
 922
 923         ;; temporarily set the marker insertion-type because
 924         ;; insert-before-markers results in hidden text in new buffers
 925         (goto-char rcirc-prompt-start-marker)
 926         (set-marker-insertion-type rcirc-prompt-start-marker t)
 927         (set-marker-insertion-type rcirc-prompt-end-marker t)
 928         (insert
 929          (rcirc-format-response-string process sender response target text)
 930          (propertize "\n" 'hard t))
 931         (set-marker-insertion-type rcirc-prompt-start-marker nil)
 932         (set-marker-insertion-type rcirc-prompt-end-marker nil)
 933
 934         ;; fill the text we just inserted, maybe
 935         (when (and rcirc-fill-flag
 936                    (not (string= response "372"))) ;/motd
 937           (let ((fill-prefix
 938                  (or rcirc-fill-prefix
 939                      (make-string
 940                       (+ (if rcirc-time-format
 941                              (length (format-time-string
 942                                       rcirc-time-format))
 943                            0)
 944                          (cond ((or (string= response "PRIVMSG")
 945                                     (string= response "NOTICE"))
 946                                 (+ (length (rcirc-user-nick sender))
 947                                    2))  ; <>
 948                                ((string= response "ACTION")
 949                                 (+ (length (rcirc-user-nick sender))
 950                                    1))          ; [
 951                                (t 3))           ; ***
 952                          1)
 953                       ? )))
 954                 (fill-column (cond ((eq rcirc-fill-column 'frame-width)
 955                                     (1- (frame-width)))
 956                                    (rcirc-fill-column
 957                                     rcirc-fill-column)
 958                                    (t fill-column))))
 959             (fill-region fill-start rcirc-prompt-start-marker 'left t)))
 960
 961         ;; set inserted text to be read-only
 962         (when rcirc-read-only-flag
 963           (put-text-property rcirc-prompt-start-marker fill-start 'read-only t)
 964           (let ((inhibit-read-only t))
 965             (put-text-property rcirc-prompt-start-marker fill-start
 966                                'front-sticky t)
 967             (put-text-property (1- (point)) (point) 'rear-nonsticky t)))
 968
 969         ;; truncate buffer if it is very long
 970         (save-excursion
 971           (when (and rcirc-buffer-maximum-lines
 972                      (> rcirc-buffer-maximum-lines 0)
 973                      (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
 974             (delete-region (point-min) (point))))
 975
 976         ;; set the window point for buffers show in windows
 977         (walk-windows (lambda (w)
 978                         (unless (eq (selected-window) w)
 979                           (when (and (eq (current-buffer)
 980                                          (window-buffer w))
 981                                      (>= (window-point w)
 982                                          rcirc-prompt-end-marker))
 983                             (set-window-point w (point-max)))))
 984                       nil t)
 985
 986         ;; restore the point
 987         (goto-char (if moving rcirc-prompt-end-marker old-point))
 988
 989         ;; flush undo (can we do something smarter here?)
 990         (buffer-disable-undo)
 991         (buffer-enable-undo))
 992
 993       ;; record modeline activity
 994       (when activity
 995         (let ((nick-match
 996                (string-match (concat "\\b"
 997                                      (regexp-quote (rcirc-nick process))
 998                                      "\\b")
 999                              text)))
1000           (when (or (not rcirc-ignore-buffer-activity-flag)
1001                     ;; always notice when our nick is mentioned, even
1002                     ;; if ignoring channel activity
1003                     nick-match)
1004             (rcirc-record-activity
1005              (current-buffer)
1006              (when (or nick-match (not (rcirc-channel-p rcirc-target)))
1007                'nick)))))
1008
1009       (sit-for 0)                       ; displayed text before hook
1010       (run-hook-with-args 'rcirc-print-hooks
1011                           process sender response target text))))
1012
1013 (defun rcirc-startup-channels (server)
1014   "Return the list of startup channels for server."
1015   (let (channels)
1016     (dolist (i rcirc-startup-channels-alist)
1017       (if (string-match (car i) server)
1018           (setq channels (append channels (cdr i)))))
1019     channels))
1020
1021 (defun rcirc-join-channels (process channels)
1022   "Join CHANNELS."
1023   (save-window-excursion
1024     (mapc (lambda (channel)
1025             (with-rcirc-process-buffer process
1026               (rcirc-cmd-join channel process)))
1027           channels)))
1028 \f
1029 ;;; nick management
1030 (defun rcirc-user-nick (user)
1031   "Return the nick from USER.  Remove any non-nick junk."
1032   (if (string-match "^[@%+]?\\([^! ]+\\)!?" (or user ""))
1033       (match-string 1 user)
1034     user))
1035
1036 (defun rcirc-user-non-nick (user)
1037   "Return the non-nick portion of USER."
1038   (if (string-match "^[@+]?[^! ]+!?\\(.*\\)" (or user ""))
1039       (match-string 1 user)
1040     user))
1041
1042 (defun rcirc-nick-channels (process nick)
1043   "Return list of channels for NICK."
1044   (let ((nick (rcirc-user-nick nick)))
1045     (with-rcirc-process-buffer process
1046       (mapcar (lambda (x) (car x))
1047               (gethash nick rcirc-nick-table)))))
1048
1049 (defun rcirc-put-nick-channel (process nick channel)
1050   "Add CHANNEL to list associated with NICK."
1051   (with-rcirc-process-buffer process
1052     (let* ((nick (rcirc-user-nick nick))
1053            (chans (gethash nick rcirc-nick-table))
1054            (record (assoc-string channel chans t)))
1055       (if record
1056           (setcdr record (current-time))
1057         (puthash nick (cons (cons channel (current-time))
1058                             chans)
1059                  rcirc-nick-table)))))
1060
1061 (defun rcirc-nick-remove (process nick)
1062   "Remove NICK from table."
1063   (with-rcirc-process-buffer process
1064     (remhash nick rcirc-nick-table)))
1065
1066 (defun rcirc-remove-nick-channel (process nick channel)
1067   "Remove the CHANNEL from list associated with NICK."
1068   (with-rcirc-process-buffer process
1069     (let* ((nick (rcirc-user-nick nick))
1070            (chans (gethash nick rcirc-nick-table))
1071            (newchans
1072             ;; instead of assoc-string-delete-all:
1073             (let ((record (assoc-string channel chans t)))
1074               (when record
1075                 (setcar record 'delete)
1076                 (assq-delete-all 'delete chans)))))
1077       (if newchans
1078           (puthash nick newchans rcirc-nick-table)
1079         (remhash nick rcirc-nick-table)))))
1080
1081 (defun rcirc-channel-nicks (process channel)
1082   "Return the list of nicks in CHANNEL sorted by last activity."
1083   (with-rcirc-process-buffer process
1084     (let (nicks)
1085       (maphash
1086        (lambda (k v)
1087          (let ((record (assoc-string channel v t)))
1088            (if record
1089                (setq nicks (cons (cons k (cdr record)) nicks)))))
1090        rcirc-nick-table)
1091       (mapcar (lambda (x) (car x))
1092               (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x))))))))
1093 \f
1094 ;;; activity tracking
1095 (or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
1096     (setq minor-mode-alist
1097           (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist)))
1098
1099 (defun rcirc-toggle-ignore-buffer-activity (&optional all)
1100   "Toggle the value of `rcirc-ignore-buffer-activity-flag'.
1101 If ALL is non-nil, instead toggle the value of
1102 `rcirc-ignore-all-activity-flag'."
1103   (interactive "P")
1104   (if all
1105       (progn
1106         (setq rcirc-ignore-all-activity-flag
1107               (not rcirc-ignore-all-activity-flag))
1108         (message (if rcirc-ignore-all-activity-flag
1109                      "Hide all buffer activity"
1110                    "Display buffer activity"))
1111         (rcirc-update-activity-string))
1112     (setq rcirc-ignore-buffer-activity-flag
1113           (not rcirc-ignore-buffer-activity-flag))
1114     (message (if rcirc-ignore-buffer-activity-flag
1115                  "Ignore activity in this buffer"
1116                "Notice activity in this buffer")))
1117   (force-mode-line-update))
1118
1119 (defvar rcirc-switch-to-buffer-function 'switch-to-buffer
1120   "Function to use when switching buffers.
1121 Possible values are `switch-to-buffer', `pop-to-buffer', and
1122 `display-buffer'.")
1123
1124 (defun rcirc-switch-to-server-buffer ()
1125   "Switch to the server buffer associated with current channel buffer."
1126   (interactive)
1127   (funcall rcirc-switch-to-buffer-function (process-buffer rcirc-process)))
1128
1129 (defun rcirc-jump-to-first-unread-line ()
1130   "Move the point to the first unread line in this buffer."
1131   (interactive)
1132   (when (marker-position overlay-arrow-position)
1133     (goto-char overlay-arrow-position)))
1134
1135 (defvar rcirc-last-non-irc-buffer nil
1136   "The buffer to switch to when there is no more activity.")
1137
1138 (defun rcirc-next-active-buffer (arg)
1139   "Go to the ARGth rcirc buffer with activity.
1140 The function given by `rcirc-switch-to-buffer-function' is used to
1141 show the buffer."
1142   (interactive "p")
1143   (if rcirc-activity
1144       (progn
1145         (unless (eq major-mode 'rcirc-mode)
1146           (setq rcirc-last-non-irc-buffer (current-buffer)))
1147         (if (and (> arg 0)
1148                  (<= arg (length rcirc-activity)))
1149             (funcall rcirc-switch-to-buffer-function
1150                      (nth (1- arg) rcirc-activity))
1151           (message "Invalid arg: %d" arg)))
1152     (if (eq major-mode 'rcirc-mode)
1153         (if (not (and rcirc-last-non-irc-buffer
1154                       (buffer-live-p rcirc-last-non-irc-buffer)))
1155             (message "No IRC activity.  Start something.")
1156           (message "No more IRC activity.  Go back to work.")
1157           (funcall rcirc-switch-to-buffer-function rcirc-last-non-irc-buffer)
1158           (setq rcirc-last-non-irc-buffer nil))
1159       (message "No IRC activity."))))
1160
1161 (defvar rcirc-activity-hooks nil
1162   "Hook to be run when there is channel activity.
1163
1164 Functions are called with a single argument, the buffer with the
1165 activity.  Only run if the buffer is not visible and
1166 `rcirc-ignore-buffer-activity-flag' is non-nil.")
1167
1168 (defun rcirc-record-activity (buffer type)
1169   "Record BUFFER activity with TYPE."
1170   (with-current-buffer buffer
1171     (when (not (get-buffer-window (current-buffer) t))
1172       (add-to-list 'rcirc-activity (current-buffer))
1173       (if (not rcirc-activity-type)
1174           (setq rcirc-activity-type type))
1175       (rcirc-update-activity-string)))
1176   (run-hook-with-args 'rcirc-activity-hooks buffer))
1177
1178 (defun rcirc-clear-activity (buffer)
1179   "Clear the BUFFER activity."
1180   (setq rcirc-activity (delete buffer rcirc-activity))
1181   (with-current-buffer buffer
1182     (setq rcirc-activity-type nil)))
1183
1184 ;; TODO: add mouse properties
1185 (defun rcirc-update-activity-string ()
1186   "Update mode-line string."
1187   (setq rcirc-activity-string
1188         (cond (rcirc-ignore-all-activity-flag
1189                " DND")
1190               ((not rcirc-activity)
1191                "")
1192               (t
1193                (concat " ["
1194                        (mapconcat
1195                         (lambda (b)
1196                           (let ((s (rcirc-short-buffer-name b)))
1197                             (with-current-buffer b
1198                               (if (not (eq rcirc-activity-type 'nick))
1199                                   s
1200                                 (rcirc-facify s 'rcirc-mode-line-nick)))))
1201                         rcirc-activity ",")
1202                        "]")))))
1203
1204 (defun rcirc-short-buffer-name (buffer)
1205   "Return a short name for BUFFER to use in the modeline indicator."
1206   (with-current-buffer buffer
1207     (or rcirc-short-buffer-name (buffer-name))))
1208
1209 (defvar rcirc-current-buffer nil)
1210 (defun rcirc-window-configuration-change ()
1211   "Go through visible windows and remove buffers from activity list.
1212 Also, clear the overlay arrow if the current buffer is now hidden."
1213   (let ((current-now-hidden t))
1214     (walk-windows (lambda (w)
1215                     (let ((buf (window-buffer w)))
1216                       (rcirc-clear-activity buf)
1217                       (when (eq buf rcirc-current-buffer)
1218                         (setq current-now-hidden nil)))))
1219     (when (and rcirc-current-buffer current-now-hidden)
1220       (with-current-buffer rcirc-current-buffer
1221         (when (eq major-mode 'rcirc-mode)
1222           (marker-position overlay-arrow-position)
1223           (set-marker overlay-arrow-position nil)))))
1224
1225   ;; remove any killed buffers from list
1226   (setq rcirc-activity
1227         (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf))
1228                           rcirc-activity)))
1229   (rcirc-update-activity-string)
1230   (setq rcirc-current-buffer (current-buffer)))
1231
1232 \f
1233 ;;; buffer name abbreviation
1234 (defun rcirc-update-short-buffer-names ()
1235   (let ((bufalist
1236          (apply 'append (mapcar (lambda (process)
1237                                   (with-rcirc-process-buffer process
1238                                     rcirc-buffer-alist))
1239                                 (rcirc-process-list)))))
1240     (dolist (i (rcirc-abbreviate bufalist))
1241       (with-current-buffer (cdr i)
1242         (setq rcirc-short-buffer-name (car i))))))
1243
1244 (defun rcirc-abbreviate (pairs)
1245   (apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs))))
1246
1247 (defun rcirc-rebuild-tree (tree &optional acc)
1248   (let ((ch (char-to-string (car tree))))
1249     (dolist (x (cdr tree))
1250       (if (listp x)
1251           (setq acc (append acc
1252                            (mapcar (lambda (y)
1253                                      (cons (concat ch (car y))
1254                                            (cdr y)))
1255                                    (rcirc-rebuild-tree x))))
1256         (setq acc (cons (cons ch x) acc))))
1257     acc))
1258
1259 (defun rcirc-make-trees (pairs)
1260   (let (alist)
1261     (mapc (lambda (pair)
1262             (if (consp pair)
1263                 (let* ((str (car pair))
1264                        (data (cdr pair))
1265                        (char (unless (zerop (length str))
1266                                (aref str 0)))
1267                        (rest (unless (zerop (length str))
1268                                (substring str 1)))
1269                        (part (if char (assq char alist))))
1270                   (if part
1271                       ;; existing partition
1272                       (setcdr part (cons (cons rest data) (cdr part)))
1273                     ;; new partition
1274                     (setq alist (cons (if char
1275                                           (list char (cons rest data))
1276                                         data)
1277                                       alist))))
1278               (setq alist (cons pair alist))))
1279           pairs)
1280     ;; recurse into cdrs of alist
1281     (mapc (lambda (x)
1282             (when (and (listp x) (listp (cadr x)))
1283               (setcdr x (if (> (length (cdr x)) 1)
1284                             (rcirc-make-trees (cdr x))
1285                           (setcdr x (list (cdadr x)))))))
1286           alist)))
1287 \f
1288 ;;; /commands these are called with 3 args: PROCESS, TARGET, which is
1289 ;; the current buffer/channel/user, and ARGS, which is a string
1290 ;; containing the text following the /cmd.
1291
1292 (defmacro defun-rcirc-command (command argument docstring interactive-form
1293                                        &rest body)
1294   "Define a command."
1295   `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
1296      (,@argument &optional process target)
1297      ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values of"
1298               "\nbuffer local variables `rcirc-process' and `rcirc-target',"
1299               "\nwill be used.")
1300      ,interactive-form
1301      (let ((process (or process rcirc-process))
1302            (target (or target rcirc-target)))
1303        ,@body)))
1304
1305 (defun-rcirc-command msg (message)
1306   "Send private MESSAGE to TARGET."
1307   (interactive "i")
1308   (if (null message)
1309       (progn
1310         (setq target (completing-read "Message nick: "
1311                                       (with-rcirc-process-buffer rcirc-process
1312                                         rcirc-nick-table)))
1313         (when (> (length target) 0)
1314           (setq message (read-string (format "Message %s: " target)))
1315           (when (> (length message) 0)
1316             (rcirc-send-message process target message))))
1317     (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message))
1318         (message "Not enough args, or something.")
1319       (setq target (match-string 1 message)
1320             message (match-string 2 message))
1321       (rcirc-send-message process target message))))
1322
1323 (defun-rcirc-command query (nick)
1324   "Open a private chat buffer to NICK."
1325   (interactive (list (completing-read "Query nick: "
1326                                       (with-rcirc-process-buffer rcirc-process
1327                                         rcirc-nick-table))))
1328   (let ((existing-buffer (rcirc-get-buffer process nick)))
1329     (switch-to-buffer (or existing-buffer
1330                           (rcirc-get-buffer-create process nick)))
1331     (when (not existing-buffer)
1332       (rcirc-cmd-whois nick))))
1333
1334 (defun-rcirc-command join (args)
1335   "Join CHANNEL."
1336   (interactive "sJoin channel: ")
1337   (let* ((channel (car (split-string args)))
1338          (buffer (rcirc-get-buffer-create process channel)))
1339     (when (not (eq (selected-window) (minibuffer-window)))
1340       (funcall rcirc-switch-to-buffer-function buffer))
1341     (rcirc-send-string process (concat "JOIN " args))))
1342
1343 (defun-rcirc-command part (channel)
1344   "Part CHANNEL."
1345   (interactive "sPart channel: ")
1346   (let ((channel (if (> (length channel) 0) channel target)))
1347     (rcirc-send-string process (concat "PART " channel " :" rcirc-id-string))))
1348
1349 (defun-rcirc-command quit (reason)
1350   "Send a quit message to server with REASON."
1351   (interactive "sQuit reason: ")
1352   (rcirc-send-string process (concat "QUIT :"
1353                                      (if (not (zerop (length reason)))
1354                                          reason
1355                                        rcirc-id-string))))
1356
1357 (defun-rcirc-command nick (nick)
1358   "Change nick to NICK."
1359   (interactive "i")
1360   (when (null nick)
1361     (setq nick (read-string "New nick: " (rcirc-nick process))))
1362   (rcirc-send-string process (concat "NICK " nick)))
1363
1364 (defun-rcirc-command names (channel)
1365   "Display list of names in CHANNEL or in current channel if CHANNEL is nil.
1366 If called interactively, prompt for a channel when prefix arg is supplied."
1367   (interactive "P")
1368   (if (interactive-p)
1369       (if channel
1370           (setq channel (read-string "List names in channel: " target))))
1371   (let ((channel (if (> (length channel) 0)
1372                      channel
1373                    target)))
1374     (rcirc-send-string process (concat "NAMES " channel))))
1375
1376 (defun-rcirc-command topic (topic)
1377   "List TOPIC for the TARGET channel.
1378 With a prefix arg, prompt for new topic."
1379   (interactive "P")
1380   (if (and (interactive-p) topic)
1381       (setq topic (read-string "New Topic: " rcirc-topic)))
1382   (rcirc-send-string process (concat "TOPIC " target
1383                                      (when (> (length topic) 0)
1384                                        (concat " :" topic)))))
1385
1386 (defun-rcirc-command whois (nick)
1387   "Request information from server about NICK."
1388   (interactive (list
1389                 (completing-read "Whois: "
1390                                  (with-rcirc-process-buffer rcirc-process
1391                                    rcirc-nick-table))))
1392   (rcirc-send-string process (concat "WHOIS " nick)))
1393
1394 (defun-rcirc-command mode (args)
1395   "Set mode with ARGS."
1396   (interactive (list (concat (read-string "Mode nick or channel: ")
1397                              " " (read-string "Mode: "))))
1398   (rcirc-send-string process (concat "MODE " args)))
1399
1400 (defun-rcirc-command list (channels)
1401   "Request information on CHANNELS from server."
1402   (interactive "sList Channels: ")
1403   (rcirc-send-string process (concat "LIST " channels)))
1404
1405 (defun-rcirc-command oper (args)
1406   "Send operator command to server."
1407   (interactive "sOper args: ")
1408   (rcirc-send-string process (concat "OPER " args)))
1409
1410 (defun-rcirc-command quote (message)
1411   "Send MESSAGE literally to server."
1412   (interactive "sServer message: ")
1413   (rcirc-send-string process message))
1414
1415 (defun-rcirc-command kick (arg)
1416   "Kick NICK from current channel."
1417   (interactive (list
1418                 (concat (completing-read "Kick nick: "
1419                                          (rcirc-channel-nicks rcirc-process
1420                                                               rcirc-target))
1421                         (read-from-minibuffer "Kick reason: "))))
1422   (let* ((arglist (split-string arg))
1423          (argstring (concat (car arglist) " :"
1424                             (mapconcat 'identity (cdr arglist) " "))))
1425     (rcirc-send-string process (concat "KICK " target " " argstring))))
1426
1427 (defun rcirc-cmd-ctcp (args &optional process target)
1428   (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
1429       (let ((target (match-string 1 args))
1430             (request (match-string 2 args)))
1431         (rcirc-send-string process
1432                            (format "PRIVMSG %s \C-a%s\C-a"
1433                                    target (upcase request))))
1434     (rcirc-print process (rcirc-nick process) "ERROR" nil
1435                  "usage: /ctcp NICK REQUEST")))
1436
1437 (defun rcirc-cmd-me (args &optional process target)
1438   (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a"
1439                                      target args)))
1440 \f
1441 (defun rcirc-message-leader (sender face)
1442   "Return a string with SENDER propertized with FACE."
1443   (rcirc-facify (concat "<" (rcirc-user-nick sender) "> ") face))
1444
1445 (defun rcirc-facify (string face)
1446   "Return a copy of STRING with FACE property added."
1447   (propertize (or string "") 'face face 'rear-nonsticky t))
1448
1449 ;; shy grouping must be used within this regexp
1450 (defvar rcirc-url-regexp
1451   "\\b\\(?:\\(?:www\\.\\|\\(?:s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\
1452 \\|wais\\|mailto\\):\\)\\(?://[-a-zA-Z0-9_.]+:[0-9]*\\)?\\(?:[-a-zA-Z0-9_=!?#$\
1453 @~`%&*+|\\/:;.,]\\|\\w\\)+\\(?:[-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
1454   "Regexp matching URL's.  Set to nil to disable URL features in rcirc.")
1455
1456 (defun rcirc-browse-url (&optional arg)
1457   "Prompt for url to browse based on urls in buffer."
1458   (interactive)
1459   (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
1460         (initial-input (car rcirc-urls))
1461         (history (cdr rcirc-urls)))
1462     (browse-url (completing-read "rcirc browse-url: "
1463                                  completions nil nil initial-input 'history)
1464                 arg)))
1465
1466 (defun rcirc-browse-url-at-point (point)
1467   "Send URL at point to `browse-url'."
1468   (interactive "d")
1469   (let ((beg (previous-single-property-change point 'mouse-face))
1470         (end (next-single-property-change point 'mouse-face)))
1471     (browse-url (buffer-substring-no-properties beg end))))
1472
1473 (defun rcirc-browse-url-at-mouse (event)
1474   "Send URL at mouse click to `browse-url'."
1475   (interactive "e")
1476   (let ((position (event-end event)))
1477     (with-current-buffer (window-buffer (posn-window position))
1478       (rcirc-browse-url-at-point (posn-point position)))))
1479
1480 (defun rcirc-map-regexp (function regexp string)
1481   "Return a copy of STRING after calling FUNCTION for each REGEXP match.
1482 FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING."
1483   (let ((start 0))
1484     (while (string-match regexp string start)
1485       (setq start (match-end 0))
1486       (funcall function (match-beginning 0) (match-end 0) string)))
1487   string)
1488
1489 (defvar rcirc-nick-syntax-table
1490   (let ((table (make-syntax-table text-mode-syntax-table)))
1491     (mapc (lambda (c) (modify-syntax-entry c "w" table))
1492           "[]\\`_^{|}-")
1493     (modify-syntax-entry ?' "_" table)
1494     table)
1495   "Syntax table which includes all nick characters as word constituents.")
1496
1497 (defun rcirc-mangle-text (process text)
1498   "Return TEXT with properties added based on various patterns."
1499   ;; ^B
1500   (setq text
1501         (rcirc-map-regexp (lambda (start end string)
1502                             (add-text-properties
1503                              start end
1504                              (list 'face 'bold 'rear-nonsticky t)
1505                              string))
1506                           "\ 2.*?\ 2"
1507                           text))
1508   (while (string-match "\\(.*\\)[\ 2\ 1]\\(.*\\)" text) ; deal with \1f
1509     (setq text (concat (match-string 1 text)
1510                        (match-string 2 text))))
1511   ;; my nick
1512   (setq text
1513         (with-syntax-table rcirc-nick-syntax-table
1514           (rcirc-map-regexp (lambda (start end string)
1515                               (add-text-properties
1516                                start end
1517                                (list 'face 'rcirc-nick-in-message
1518                                      'rear-nonsticky t)
1519                                string))
1520                             (concat "\\b"
1521                                     (regexp-quote (rcirc-nick process))
1522                                     "\\b")
1523                             text)))
1524   ;; urls
1525   (setq text
1526         (rcirc-map-regexp
1527          (lambda (start end string)
1528            (let ((orig-face (get-text-property start 'face string)))
1529              (add-text-properties start end
1530                                   (list 'face (list orig-face 'bold)
1531                                         'rear-nonsticky t
1532                                         'mouse-face 'highlight
1533                                         'keymap rcirc-browse-url-map)
1534                                   string))
1535              (push (substring string start end) rcirc-urls))
1536            rcirc-url-regexp
1537            text))
1538   text)
1539
1540 \f
1541 ;;; handlers
1542 ;; these are called with the server PROCESS, the SENDER, which is a
1543 ;; server or a user, depending on the command, the ARGS, which is a
1544 ;; list of strings, and the TEXT, which is the original server text,
1545 ;; verbatim
1546 (defun rcirc-handler-001 (process sender args text)
1547   (rcirc-handler-generic process "001" sender args text)
1548   ;; set the real server name
1549   (with-rcirc-process-buffer process
1550     (setq rcirc-server sender)
1551     (setq rcirc-nick (car args))
1552     (rcirc-update-prompt)
1553     (when rcirc-auto-authenticate-flag (rcirc-authenticate))
1554     (rcirc-join-channels process rcirc-startup-channels)))
1555
1556 (defun rcirc-handler-PRIVMSG (process sender args text)
1557   (let ((target (if (rcirc-channel-p (car args))
1558                     (car args)
1559                   (rcirc-user-nick sender)))
1560         (message (or (cadr args) "")))
1561     (if (string-match "^\C-a\\(.*\\)\C-a$" message)
1562         (rcirc-handler-CTCP process target sender (match-string 1 message))
1563       (rcirc-print process sender "PRIVMSG" target message t))
1564     ;; update nick timestamp
1565     (if (member target (rcirc-nick-channels process sender))
1566         (rcirc-put-nick-channel process sender target))))
1567
1568 (defun rcirc-handler-NOTICE (process sender args text)
1569   (let ((target (car args))
1570         (message (cadr args)))
1571     (if (string-match "^\C-a\\(.*\\)\C-a$" message)
1572         (rcirc-handler-CTCP-response process target sender
1573                                      (match-string 1 message))
1574       (rcirc-print process sender "NOTICE"
1575                    (cond ((rcirc-channel-p target)
1576                           target)
1577                          ;;; -ChanServ- [#gnu] Welcome...
1578                          ((string-match "^\\[\\(#[^ ]+\\)\\]" message)
1579                           (match-string 1 message))
1580                          (sender
1581                           (if (string= sender (rcirc-server process))
1582                               (process-buffer process)
1583                             (rcirc-user-nick sender))))
1584                  message t))))
1585     ;; do we need this:
1586     ;;(and sender (rcirc-put-nick-channel process sender target))))
1587
1588 (defun rcirc-handler-WALLOPS (process sender args text)
1589   (let ((target (rcirc-user-nick sender)))
1590     (rcirc-print process sender "WALLOPS" target (car args) t)))
1591
1592 (defun rcirc-handler-JOIN (process sender args text)
1593   (let ((channel (car args))
1594         (nick (rcirc-user-nick sender)))
1595     (rcirc-get-buffer-create process channel)
1596     (rcirc-print process sender "JOIN" channel "")
1597
1598     ;; print in private chat buffer if it exists
1599     (when (rcirc-get-buffer rcirc-process nick)
1600       (rcirc-print process sender "JOIN" nick channel))
1601
1602     (rcirc-put-nick-channel process sender channel)))
1603
1604 ;; PART and KICK are handled the same way
1605 (defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
1606   (rcirc-print process sender response channel (concat channel " " args))
1607
1608   ;; print in private chat buffer if it exists
1609   (when (rcirc-get-buffer rcirc-process nick)
1610     (rcirc-print process sender response nick (concat channel " " args)))
1611
1612   (if (not (string= nick (rcirc-nick process)))
1613       ;; this is someone else leaving
1614       (rcirc-remove-nick-channel process nick channel)
1615     ;; this is us leaving
1616     (mapc (lambda (n)
1617             (rcirc-remove-nick-channel process n channel))
1618           (rcirc-channel-nicks process channel))
1619
1620     ;; if the buffer is still around, make it inactive
1621     (let ((buffer (rcirc-get-buffer process channel)))
1622       (when buffer
1623         (with-current-buffer buffer
1624           (setq rcirc-target nil))))))
1625
1626 (defun rcirc-handler-PART (process sender args text)
1627   (rcirc-handler-PART-or-KICK process "PART"
1628                               (car args) sender (rcirc-user-nick sender)
1629                               (cadr args)))
1630
1631 (defun rcirc-handler-KICK (process sender args text)
1632   (rcirc-handler-PART-or-KICK process "KICK" (car args) sender (cadr args)
1633                               (caddr args)))
1634
1635 (defun rcirc-handler-QUIT (process sender args text)
1636   (let ((nick (rcirc-user-nick sender)))
1637     (mapc (lambda (channel)
1638             (rcirc-print process sender "QUIT" channel (apply 'concat args)))
1639           (rcirc-nick-channels process nick))
1640
1641     ;; print in private chat buffer if it exists
1642     (let ((buffer (rcirc-get-buffer rcirc-process nick)))
1643       (when buffer
1644         (rcirc-print process sender "QUIT" buffer (apply 'concat args))))
1645
1646     (rcirc-nick-remove process nick)))
1647
1648 (defun rcirc-handler-NICK (process sender args text)
1649   (let* ((old-nick (rcirc-user-nick sender))
1650          (new-nick (car args))
1651          (channels (rcirc-nick-channels process old-nick)))
1652     ;; print message to nick's channels
1653     (dolist (target channels)
1654       (rcirc-print process sender "NICK" target new-nick))
1655     ;; update private chat buffer, if it exists
1656     (let ((chat-buffer (rcirc-get-buffer process old-nick)))
1657       (when chat-buffer
1658         (with-current-buffer chat-buffer
1659           (rcirc-print process sender "NICK" old-nick new-nick)
1660           (setq rcirc-target new-nick)
1661           (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))))
1662     ;; remove old nick and add new one
1663     (with-rcirc-process-buffer process
1664       (let ((v (gethash old-nick rcirc-nick-table)))
1665         (remhash old-nick rcirc-nick-table)
1666         (puthash new-nick v rcirc-nick-table))
1667       ;; if this is our nick...
1668       (when (string= old-nick rcirc-nick)
1669         (setq rcirc-nick new-nick)
1670         (rcirc-update-prompt t)
1671         ;; reauthenticate
1672         (when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
1673
1674 (defun rcirc-handler-PING (process sender args text)
1675   (rcirc-send-string process (concat "PONG " (car args))))
1676
1677 (defun rcirc-handler-PONG (process sender args text)
1678   ;; do nothing
1679   )
1680
1681 (defun rcirc-handler-TOPIC (process sender args text)
1682   (let ((topic (cadr args)))
1683     (rcirc-print process sender "TOPIC" (car args) topic)
1684     (with-current-buffer (rcirc-get-buffer process (car args))
1685       (setq rcirc-topic topic))))
1686
1687 (defun rcirc-handler-332 (process sender args text)
1688   "RPL_TOPIC"
1689   (let ((buffer (or (rcirc-get-buffer process (cadr args))
1690                     (rcirc-get-temp-buffer-create process (cadr args)))))
1691     (with-current-buffer buffer
1692       (setq rcirc-topic (caddr args)))))
1693
1694 (defun rcirc-handler-333 (process sender args text)
1695   "Not in rfc1459.txt"
1696   (let ((buffer (or (rcirc-get-buffer process (cadr args))
1697                     (rcirc-get-temp-buffer-create process (cadr args)))))
1698     (with-current-buffer buffer
1699       (let ((setter (caddr args))
1700             (time (current-time-string
1701                    (seconds-to-time
1702                     (string-to-number (cadddr args))))))
1703         (rcirc-print process sender "TOPIC" (cadr args)
1704                      (format "%s (%s on %s)" rcirc-topic setter time))))))
1705
1706 (defun rcirc-handler-477 (process sender args text)
1707   "ERR_NOCHANMODES"
1708   (rcirc-print process sender "477" (cadr args) (caddr args)))
1709
1710 (defun rcirc-handler-MODE (process sender args text)
1711   (let ((target (car args))
1712         (msg (mapconcat 'identity (cdr args) " ")))
1713     (rcirc-print process sender "MODE"
1714                  (if (string= target (rcirc-nick process))
1715                      nil
1716                    target)
1717                  msg)
1718
1719     ;; print in private chat buffers if they exist
1720     (mapc (lambda (nick)
1721             (let ((existing-buffer (rcirc-get-buffer process nick)))
1722               (when existing-buffer
1723                 (rcirc-print process sender "MODE" existing-buffer msg))))
1724           (cddr args))))
1725
1726 (defun rcirc-get-temp-buffer-create (process channel)
1727   "Return a buffer based on PROCESS and CHANNEL."
1728   (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
1729     (get-buffer-create tmpnam)))
1730
1731 (defun rcirc-handler-353 (process sender args text)
1732   "RPL_NAMREPLY"
1733   (let ((channel (caddr args)))
1734     (mapc (lambda (nick)
1735             (rcirc-put-nick-channel process nick channel))
1736           (split-string (cadddr args) " " t))
1737     (with-current-buffer (rcirc-get-temp-buffer-create process channel)
1738       (goto-char (point-max))
1739       (insert (car (last args)) " "))))
1740
1741 (defun rcirc-handler-366 (process sender args text)
1742   "RPL_ENDOFNAMES"
1743   (let* ((channel (cadr args))
1744          (buffer (rcirc-get-temp-buffer-create process channel)))
1745     (with-current-buffer buffer
1746       (rcirc-print process sender "NAMES" channel
1747                    (buffer-substring (point-min) (point-max))))
1748     (kill-buffer buffer)))
1749
1750 (defun rcirc-handler-433 (process sender args text)
1751   "ERR_NICKNAMEINUSE"
1752   (rcirc-handler-generic process "433" sender args text)
1753   (let* ((new-nick (concat (cadr args) "`")))
1754     (with-rcirc-process-buffer process
1755       (rcirc-cmd-nick new-nick nil process))))
1756
1757 (defun rcirc-authenticate ()
1758   "Send authentication to process associated with current buffer.
1759 Passwords are read from `rcirc-authinfo-file-name' (which see)."
1760   (interactive)
1761   (let ((password-alist
1762          (with-temp-buffer
1763            (insert-file-contents-literally rcirc-authinfo-file-name)
1764            (goto-char (point-min))
1765            (read (current-buffer)))))
1766     (with-rcirc-process-buffer rcirc-process
1767       (dolist (i password-alist)
1768         (let ((server (car i))
1769               (nick (cadr i))
1770               (method (caddr i))
1771               (args (cdddr i)))
1772           (when (and (string-match server rcirc-server)
1773                      (string-match nick rcirc-nick))
1774             (cond ((equal method 'nickserv)
1775                    (rcirc-send-string
1776                     rcirc-process
1777                     (concat
1778                      "PRIVMSG nickserv :identify "
1779                      (car args))))
1780                   ((equal method 'chanserv)
1781                    (rcirc-send-string
1782                     rcirc-process
1783                     (concat
1784                      "PRIVMSG chanserv :identify "
1785                      (car args) " " (cadr args))))
1786                   ((equal method 'bitlbee)
1787                    (rcirc-send-string
1788                     rcirc-process
1789                     (concat "PRIVMSG #bitlbee :identify " (car args))))
1790                   (t
1791                    (message "No %S authentication method defined"
1792                             method)))))))))
1793
1794 (defun rcirc-handler-INVITE (process sender args text)
1795   (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
1796
1797 (defun rcirc-handler-ERROR (process sender args text)
1798   (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
1799
1800 (defun rcirc-handler-CTCP (process target sender text)
1801   (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
1802       (let* ((request (upcase (match-string 1 text)))
1803              (args (match-string 2 text))
1804              (nick (rcirc-user-nick sender))
1805              (handler (intern-soft (concat "rcirc-handler-ctcp-" request))))
1806         (if (not (fboundp handler))
1807             (rcirc-print process sender "ERROR"
1808                          (rcirc-get-buffer process target)
1809                          (format "%s sent unsupported ctcp: %s" nick text)
1810                          t)
1811           (funcall handler process target sender args)
1812           (if (not (string= request "ACTION"))
1813               (rcirc-print process sender "CTCP"
1814                            (rcirc-get-buffer process target)
1815                            (format "%s" text) t))))))
1816
1817 (defun rcirc-handler-ctcp-VERSION (process target sender args)
1818   (rcirc-send-string process
1819                      (concat "NOTICE " (rcirc-user-nick sender)
1820                              " :\C-aVERSION " rcirc-id-string
1821                              "\C-a")))
1822
1823 (defun rcirc-handler-ctcp-ACTION (process target sender args)
1824   (rcirc-print process sender "ACTION" target args t))
1825
1826 (defun rcirc-handler-ctcp-TIME (process target sender args)
1827   (rcirc-send-string process
1828                      (concat "NOTICE " (rcirc-user-nick sender)
1829                              " :\C-aTIME " (current-time-string) "\C-a")))
1830
1831 (defun rcirc-handler-CTCP-response (process target sender message)
1832   (rcirc-print process sender "CTCP" nil message t))
1833 \f
1834 (defgroup rcirc-faces nil
1835   "Faces for rcirc."
1836   :group 'rcirc
1837   :group 'faces)
1838
1839 (defface rcirc-my-nick
1840   '((((type tty) (class color)) (:foreground "blue" :weight bold))
1841     (((class color) (background light)) (:foreground "Blue"))
1842     (((class color) (background dark)) (:foreground "LightSkyBlue"))
1843     (t (:inverse-video t :bold t)))
1844   "The face used to highlight my messages."
1845   :group 'rcirc-faces)
1846
1847 (defface rcirc-other-nick
1848   '((((type tty) (class color)) (:foreground "yellow" :weight light))
1849     (((class grayscale) (background light))
1850      (:foreground "Gray90" :bold t :italic t))
1851     (((class grayscale) (background dark))
1852      (:foreground "DimGray" :bold t :italic t))
1853     (((class color) (background light)) (:foreground "DarkGoldenrod"))
1854     (((class color) (background dark)) (:foreground "LightGoldenrod"))
1855     (t (:bold t :italic t)))
1856   "The face used to highlight other messages."
1857   :group 'rcirc-faces)
1858
1859 (defface rcirc-server
1860   '((((type tty pc) (class color) (background light)) (:foreground "red"))
1861     (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1862     (((class grayscale) (background light))
1863      (:foreground "DimGray" :bold t :italic t))
1864     (((class grayscale) (background dark))
1865      (:foreground "LightGray" :bold t :italic t))
1866     (((class color) (background light)) (:foreground "gray40"))
1867     (((class color) (background dark)) (:foreground "chocolate1"))
1868     (t (:bold t :italic t)))
1869   "The face used to highlight server messages."
1870   :group 'rcirc-faces)
1871
1872 (defface rcirc-nick-in-message
1873   '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1874     (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
1875     (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1876     (((class color) (background light)) (:foreground "Purple"))
1877     (((class color) (background dark)) (:foreground "Cyan"))
1878     (t (:bold t)))
1879   "The face used to highlight instances of nick within messages."
1880   :group 'rcirc-faces)
1881
1882 (defface rcirc-prompt
1883   '((((background dark)) (:foreground "cyan"))
1884     (t (:foreground "dark blue")))
1885   "The face to use to highlight prompts."
1886   :group 'rcirc-faces)
1887
1888 (defface rcirc-mode-line-nick
1889   '((t (:bold t)))
1890   "The face used indicate activity directed at you."
1891   :group 'rcirc-faces)
1892 \f
1893 ;; When using M-x flyspell-mode, only check words after the prompt
1894 (put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
1895 (defun rcirc-looking-at-input ()
1896   "Returns true if point is past the input marker."
1897   (>= (point) rcirc-prompt-end-marker))
1898 \f
1899
1900 (provide 'rcirc)
1901
1902 ;; arch-tag: b471b7e8-6b5a-4399-b2c6-a3c78dfc8ffb
1903 ;;; rcirc.el ends here