gnu-emacs-sources
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

rcirc.el


From: Ryan Yeske
Subject: rcirc.el
Date: Wed, 08 Dec 2004 07:08:42 GMT
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3

;;; rcirc.el --- lightweight emacs irc client

;; Copyright (C) 2004  Ryan Yeske <address@hidden>

;; Author: Ryan Yeske 
;; X-RCS: $Id: rcirc.el,v 1.103 2004/12/08 06:59:51 rcyeske Exp $
;; URL: http://www.emmett.ca/~rcyeske/rcirc
;; Keywords: comm

;; This file is not currently part of GNU Emacs.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; rcirc is a lightweight irc client for emacs

;; Place this file somewhere in your `load-path' and put 
;; (autoload 'rcirc "rcirc.el" "Connect to IRC." t)
;; in your .emacs
;; Open a new irc connection with:
;; M-x rcirc RET

;; Tested with GNU Emacs 21.3

;;; Code:

(require 'ring)
(require 'cl)
(require 'time-date)

(defvar rcirc-server "irc.freenode.net"
  "The default server to connect to.")

(defvar rcirc-port 6667
  "The default port to connect to.")

(defvar rcirc-nick (user-login-name)
  "Your nick.")

(defvar rcirc-user-name (user-login-name)
  "Your user name.")

(defvar rcirc-user-full-name (user-full-name)
  "Your full name.")

(defvar rcirc-startup-channels nil
  "Channels to join at startup.")

(defvar rcirc-insert-marker nil
  "The place where insertion of new text in rcirc buffers should happen.")

(defvar rcirc-nick-table nil)

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

(defvar rcirc-activity-string ""
  "String displayed in modeline representing `rcirc-activity'.")

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

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

(defvar rcirc-input-ring-size 1024
  "Size of input history ring.")

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

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


(defun rcirc-version (&optional here)
  "Return rcirc version string.
If optional argument HERE is non-nil, insert string at point."
  (interactive "P")
  (let ((version "rcirc.el 0.2 $Revision: 1.103 $"))
    (if here
        (insert version) 
      (if (interactive-p)
          (message "%s" version)
        version))))

;;;###autoload
(defun rcirc (server port nick)
  "Connect to IRC."
  (interactive (list (read-input "Server: " rcirc-server)
                     (read-input "Port: " (number-to-string rcirc-port))
                     (read-input "Nick: " rcirc-nick)))
  (or global-mode-string (setq global-mode-string '("")))
  (and (not (memq 'rcirc-activity-string global-mode-string))
       (setq global-mode-string 
             (append global-mode-string '(rcirc-activity-string))))
  (rcirc-connect server port nick rcirc-user-name rcirc-user-full-name)
  (add-hook 'window-configuration-change-hook 'rcirc-update-activity))


(defvar rcirc-process-output nil)
(defvar rcirc-last-buffer nil)
(defun rcirc-connect (server port nick user-name full-name)
  "Return a connection to SERVER on PORT."
  (save-excursion
    (message "Connecting to %s..." server)
    (let* ((inhibit-eol-conversion)
           (proc (open-network-stream server nil server port)))
      (set-process-coding-system proc 'raw-text-dos 'raw-text-dos)
      (set-process-filter proc 'rcirc-filter)
      (switch-to-buffer (get-buffer-create (process-name proc)))
      (set-process-buffer proc (current-buffer))
      (set-process-sentinel proc 'rcirc-sentinel)
      (rcirc-mode proc nil)
      (make-local-variable 'rcirc-nick-table)
      (setq rcirc-nick-table (make-hash-table :test 'equal))
      (make-local-variable 'rcirc-server)
      (setq rcirc-server server)
      (make-local-variable 'rcirc-nick)
      (setq rcirc-nick nick)
      (make-local-variable 'rcirc-process-output)
      (setq rcirc-process-output nil)
      (make-local-variable 'rcirc-last-buffer)
      (setq rcirc-last-buffer (current-buffer))
      (rcirc-send-string proc (concat "NICK " nick))
      (rcirc-send-string proc (concat "USER " user-name 
                                      " hostname servername :" 
                                      full-name))
      (message "Connecting to %s...done" server)
      proc)))

(defun rcirc-log (process text)
  (save-excursion
    (set-buffer (get-buffer-create "*rcirc log*"))
    (goto-char (point-max))
    (insert (concat "[" (process-name process) "] " text))))
               
(defun rcirc-sentinel (process sentinel)
  (rcirc-log process (format "SENTINEL: %S\n" sentinel)))

(defun rcirc-filter (process output)
  (with-current-buffer (process-buffer process)
    (setq rcirc-process-output (concat rcirc-process-output output))
    (when (= (aref rcirc-process-output (1- (length rcirc-process-output))) ?\n)
      (mapcar (lambda (line)
                (rcirc-log process (concat line "\n"))
                (unwind-protect
                    (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) 
\\(.+\\)$" line)
                        (let* ((sender (match-string 2 line))
                               (cmd (match-string 3 line))
                               (args (match-string 4 line))
                               (handler (intern (concat "rcirc-handler-" cmd))))
                          (string-match "^\\([^:]*\\):?\\(.+\\)?$" args)
                          (let* ((args1 (match-string 1 args))
                                 (args2 (match-string 2 args))
                                 (args (append (delete "" (split-string args1 " 
"))
                                               (list args2))))
                            (if (not (fboundp handler))
                                (rcirc-handler-generic process cmd sender args 
line)
                              (funcall handler process sender args line))))
                      (message "UNHANDLED: %s" line))))
              (delete "" (split-string rcirc-process-output "\n")))
      (setq rcirc-process-output nil))))

(defun rcirc-handler-generic (process cmd sender args text)
  "Generic server response handler."
  (rcirc-print process nil (rcirc-comment text)))

(defun rcirc-send-string (process string)
  "Send PROC a STRING plus a cr/lf."
  (rcirc-log process (concat string "\n"))
  (process-send-string process (concat string "\r\n")))

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

(defun rcirc-send-message (process victim message)
  "Send a VICTIM a privmsg with text MESSAGE."
  (mapcar (lambda (line)
            (setq line (if (string= line "") " " line))
            (rcirc-send-string process
                               (concat "PRIVMSG " victim " :" line))
            (rcirc-print process victim
                         (concat (rcirc-message-leader
                                  (rcirc-nick process)
                                  'rcirc-my-nick-face)
                                 line)
                         t))
          (split-string message "\n")))

(defvar rcirc-input-ring nil)
(defvar rcirc-input-ring-index 0)
(defun rcirc-prev-input-string (arg)
  (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))

(defun rcirc-insert-prev-input (arg)
  (interactive "p")
  (when (<= rcirc-insert-marker (point))
    (delete-region rcirc-insert-marker (line-end-position))
    (insert (rcirc-prev-input-string 0))
    (setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))

(defun rcirc-insert-next-input (arg)
  (interactive "p")
  (when (<= rcirc-insert-marker (point))
    (delete-region rcirc-insert-marker (line-end-position))
    (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
    (insert (rcirc-prev-input-string -1))))

(defvar rcirc-nick-completions nil)
(defun rcirc-complete-nick ()
  "Complete nick from text between the beginning of line and point."
  (interactive)
  (if (eq real-last-command 'rcirc-complete-nick)
      (setq rcirc-nick-completions
            (append (cdr rcirc-nick-completions)
                    (list (car rcirc-nick-completions))))
    (let ((start (line-beginning-position))
          (end (point)))
      (setq rcirc-nick-completions
            (all-completions (buffer-substring start end)
                             (mapcar (lambda (x) 
                                       (cons x nil))
                                     (rcirc-channel-nicks rcirc-process
                                                          
(rcirc-buffer-victim)))))))
  (let ((completion (car rcirc-nick-completions)))
    (when completion
      (delete-region (line-beginning-position) (point))
      (insert (concat completion ": ")))))

(defun rcirc-buffer-victim (&optional buffer)
  "Return the name of victim for the current buffer."
  (with-current-buffer (or buffer (current-buffer))
    rcirc-victim))

(defvar rcirc-mode-map nil
  "Keymap for rcirc mode.")
(if rcirc-mode-map
    ()
  (setq rcirc-mode-map (make-sparse-keymap))
  (define-key rcirc-mode-map (kbd "RET") 'rcirc-send-line)
  (define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
  (define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
  (define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick)
  (define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline))

(define-key global-map (kbd "C-c b") 'rcirc-switch-to-next-active-buffer)

(defun rcirc-mode (process victim)
  "Major mode for irc io buffers."
  (kill-all-local-variables)
  (use-local-map rcirc-mode-map)
  (setq mode-name "rcirc")
  (setq major-mode 'rcirc-mode)
  (make-local-variable 'rcirc-insert-marker)
  (setq rcirc-insert-marker (make-marker))
  (set-marker rcirc-insert-marker (point-max))
  (make-local-variable 'rcirc-input-ring)
  (setq rcirc-input-ring (make-ring rcirc-input-ring-size))
  (make-local-variable 'rcirc-process)
  (setq rcirc-process process)
  (make-local-variable 'rcirc-victim)
  (setq rcirc-victim victim)
  (run-hooks 'rcirc-mode-hook))

(defun rcirc-get-buffer-name (process victim)
  "Return buffer name based on PROCESS and VICTIM."
  (concat (and victim (downcase victim)) "@" (process-name process)))

(defun rcirc-get-buffer (process victim)
  "Return the buffer associated with the PROCESS and VICTIM.
If VICTIM is nil, return the process buffer."
  (if (not victim)
      (process-buffer process)
    (get-buffer (rcirc-get-buffer-name process victim))))

(defun rcirc-get-buffer-create (process victim)
  "Return the buffer named associated with the PROCESS and VICTIM.
Create and setup the buffer if it doesn't exist.  If VICTIM is nil,
return the process buffer."
  (if (not victim)
      (process-buffer process)
    (let ((bufname (rcirc-get-buffer-name process victim)))
      (when (not (buffer-live-p (get-buffer bufname)))
        (with-current-buffer (get-buffer-create bufname)
          (rcirc-mode process victim)))
      (get-buffer bufname))))

(defun rcirc-send-line ()
  "Send line to victim associated with the current buffer."
  (interactive)
  (if (< (point) rcirc-insert-marker)
      ;; copy the line down to the input area
      (let ((start (line-beginning-position))
            (end (line-end-position)))
        (goto-char (point-max))
        (insert (buffer-substring-no-properties start end)))
    ;; process input
    (goto-char (point-max))
    (let ((victim (rcirc-buffer-victim))
          (start rcirc-insert-marker))
      (when (not (equal 0 (- (point) rcirc-insert-marker)))
        ;; delete a trailing newline
        (when (eq (point) (line-beginning-position)) 
          (delete-backward-char 1))
        (let ((input (buffer-substring-no-properties
                      rcirc-insert-marker (point))))
          ;; process a /cmd
          (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input)
              (let ((command (intern (concat "rcirc-cmd-" 
                                             (match-string 1 input))))
                    (args (match-string 2 input)))
                (newline)
                (with-current-buffer (rcirc-get-buffer rcirc-process victim)
                  (rcirc-print rcirc-process victim input t)
                  (delete-region rcirc-insert-marker (point))
                  (if (fboundp command)
                      (funcall command rcirc-process victim args)
                    (rcirc-print rcirc-process victim
                                 (rcirc-comment
                                  (concat "*** (void-function "
                                          (symbol-name command)
                                          ")"))))))
            ;; send message to server
            (rcirc-send-message rcirc-process victim input)
            (delete-region rcirc-insert-marker (point)))
          ;; add to input-ring
          (with-current-buffer (rcirc-get-buffer rcirc-process victim)
            (ring-insert rcirc-input-ring input)
            (setq rcirc-input-ring-index 0)
            (set-marker rcirc-insert-marker (point)))))
      ;; flush undo
      (with-current-buffer (rcirc-get-buffer rcirc-process victim)
        (buffer-disable-undo)
        (buffer-enable-undo))))
  ;; update last buffer
  (let ((buffer (current-buffer)))
    (with-current-buffer (process-buffer rcirc-process)
      (setq rcirc-last-buffer buffer))))

(defvar rcirc-parent-buffer nil)
(defvar rcirc-window-configuration nil)
(defun rcirc-edit-multiline ()
  "Move current edit to a dedicated buffer."
  (interactive)
  (goto-char (point-max))
  (let ((text (buffer-substring rcirc-insert-marker (point)))
        (parent (buffer-name))
        (process rcirc-process))
    (delete-region rcirc-insert-marker (point))
    (setq rcirc-window-configuration (current-window-configuration))
    (pop-to-buffer (concat "*multiline " parent "*"))
    (rcirc-multiline-edit-mode)
    (setq rcirc-parent-buffer parent)
    (setq rcirc-process process)
    (insert text)))

(define-derived-mode rcirc-multiline-edit-mode
  text-mode "rcirc multi"
  "Major mode for multiline edits
\\{rcirc-multiline-edit-mode-map}"
  (make-local-variable 'rcirc-parent-buffer)
  (make-local-variable 'rcirc-process))
  
(define-key rcirc-multiline-edit-mode-map
  (kbd "C-c C-c") 'rcirc-multiline-edit-submit)

(defun rcirc-multiline-edit-submit ()
  "Send the text in buffer back to parent buffer."
  (interactive)
  (assert (and (eq major-mode 'rcirc-multiline-edit-mode)))
  (assert rcirc-parent-buffer)
  (let ((text (buffer-substring (point-min) (point-max)))
        (buffer (current-buffer)))
    (switch-to-buffer rcirc-parent-buffer)
    (goto-char (point-max))
    (insert text)
    (kill-buffer buffer)
    (set-window-configuration rcirc-window-configuration)))

(defun rcirc-last-buffer (process)
  "Return the last working buffer for PROCESS.
Used for displaying messages that don't have an explicit destination."
  (with-current-buffer (process-buffer process)
    (or (and rcirc-last-buffer
             (buffer-live-p rcirc-last-buffer)
             rcirc-last-buffer)
        (current-buffer))))

(defun rcirc-print (process victim message &optional no-activity)
  "Print MESSAGE in the buffer associated with VICTIM.
If NO-ACTIVITY is non-nil, don't record activity."
  (let ((buffer (if (not victim)
                    (rcirc-last-buffer process)
                  (rcirc-get-buffer-create process victim))))
    (with-current-buffer buffer
      (let ((moving (= (point) rcirc-insert-marker)))
        (save-excursion
          (goto-char rcirc-insert-marker)
          (insert (concat (format-time-string rcirc-time-format (current-time))
                          (rcirc-process-message message) "\n"))
          (set-marker rcirc-insert-marker (point)))
        (when moving (goto-char rcirc-insert-marker)))
      (walk-windows (lambda (w)
                      (if (eq (current-buffer) (window-buffer w))
                          (set-window-point w (point))))
                    t t)
      (or no-activity (rcirc-record-activity (current-buffer)))
      (run-hook-with-args 'rcirc-print-hooks victim message))))


;;; nick management
(defun rcirc-user-nick (user)
  "Return the nick from USER.  Removes any non-nick junk."
  (if (string-match "address@hidden([^! ]+\\)!?" user)
      (match-string 1 user)
    user))

(defun rcirc-nick-channels (process nick)
  "Return list of channels for NICK."
  (with-current-buffer (process-buffer process)
    (gethash nick rcirc-nick-table)))

(defun rcirc-put-nick-channel (process nick channel)
  "Add CHANNEL to list associated with NICK."
  (with-current-buffer (process-buffer process)
    (let* ((nick (rcirc-user-nick nick))
           (chans (gethash nick rcirc-nick-table))
           (record (member-if (lambda (x) (equal (aref x 0) channel)) chans)))
      (if record
          (aset (car record) 1 (current-time))
        (puthash nick (cons (vector channel (current-time))
                            chans)
                 rcirc-nick-table)))))

(defun rcirc-nick-remove (process nick)
  "Remove NICK from table."
  (with-current-buffer (process-buffer process)
    (remhash nick rcirc-nick-table)))

(defun rcirc-remove-nick-channel (process nick channel)
  "Remove the CHANNEL from list associated with NICK."
  (with-current-buffer (process-buffer process)
    (let* ((nick (rcirc-user-nick nick))
           (chans (gethash nick rcirc-nick-table))
           (newchans (delete-if (lambda (x) (equal (aref x 0) channel)) chans)))
      (if newchans
          (puthash nick newchans rcirc-nick-table)
        (remhash nick rcirc-nick-table)))))

(defun rcirc-channel-nicks (process channel)
  "Return the list of nicks in CHANNEL sorted by last activity."
  (with-current-buffer (process-buffer process)
    (let (nicks)
      (maphash
       (lambda (k v)
         (let ((record 
                (car-safe (member-if (lambda (x)
                                       (equal (aref x 0) channel))
                                     v))))
           (if record 
               (setq nicks (cons (vector k (aref record 1)) nicks)))))
       rcirc-nick-table)
      (mapcar (lambda (x) (aref x 0))
              (sort nicks (lambda (x y) (time-less-p (aref y 1) (aref x 
1))))))))

;;; activity tracking
(defun rcirc-switch-to-next-active-buffer ()
  "Go to the next rcirc buffer with activity."
  (interactive)
  (if rcirc-activity 
      (switch-to-buffer (car rcirc-activity))
    (message "No channel activity.  Go start something.")))

(defun rcirc-record-activity (buffer)
  "Record BUFFER activity."
  (with-current-buffer buffer
    (when (and (not rcirc-ignore-channel-activity)
               (not (get-buffer-window (current-buffer))))
      (add-to-list 'rcirc-activity (current-buffer) t)
      (rcirc-update-activity-string))))

(defun rcirc-clear-activity (buffer)
  "Clear the BUFFER activity."
  (setq rcirc-activity (delete buffer rcirc-activity)))

(defun rcirc-update-activity-string ()
  "Update mode-line string."
  (setq rcirc-activity-string
        (if rcirc-activity
            (concat " [" (mapconcat 'rcirc-short-buffer-name rcirc-activity 
",") "]")
          "")))

(defun rcirc-short-buffer-name (buffer)
  "Return a short name for BUFFER to use in the modeline indicator."
  (with-current-buffer buffer
    (or rcirc-victim (process-name rcirc-process))))

(defun rcirc-update-activity ()
  "Go through visible windows and remove buffers from activity list."
  (walk-windows (lambda (w) (rcirc-clear-activity (window-buffer w))))
  (rcirc-update-activity-string))


;;; /commands
;; these are called with 2 args: VICTIM, which is the current
;; buffer/channel/user, and ARGS, which is the text following the
;; /cmd.

(defun rcirc-cmd-msg (process victim args)
  (if (string-match "\\([^ ]+\\) \\(.+\\)" args)
      (let ((victim (match-string 1 args))
            (message (match-string 2 args)))
        (rcirc-send-message process victim message))
    (message "Not enough args, or something.")))

(defun rcirc-cmd-join (process sender args)
  (switch-to-buffer (rcirc-get-buffer-create process args))
  (rcirc-send-string process (concat "JOIN " args)))

(defun rcirc-cmd-part (process victim args)
  (let ((channel (if (string-match args "")
                     victim
                   args)))
    (rcirc-send-string process (concat "PART " channel " :" (rcirc-version)))))

(defun rcirc-cmd-nick (process victim args)
  (rcirc-send-string process (concat "NICK " args)))

(defun rcirc-cmd-names (process victim args)
  (rcirc-send-string process (concat "NAMES " victim)))

(defun rcirc-cmd-topic (process victim args)
  (rcirc-send-string process (concat "TOPIC " victim
                                        (and (not (equal "" args)) " :")
                                        args)))

(defun rcirc-cmd-whois (process victim args)
  (rcirc-send-string process (concat "WHOIS " args)))

(defun rcirc-cmd-mode (process victim args)
  (rcirc-send-string process (concat "MODE " args)))

(defun rcirc-cmd-list (process victim args)
  (rcirc-send-string process (concat "LIST " args)))

(defun rcirc-cmd-oper (process victim args)
  (rcirc-send-string process (concat "OPER " rcirc-nick args)))

(defun rcirc-cmd-quote (process victim args)
  (rcirc-send-string process args))

(defun rcirc-cmd-kick (process victim args)
  (rcirc-send-string process (concat "KICK " args)))

(defun rcirc-cmd-ctcp (process victim args)
  (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
      (let ((target (match-string 1 args))
            (request (match-string 2 args)))
        (rcirc-send-string process (concat "PRIVMSG " target " " request "")))
    (rcirc-print process victim (rcirc-comment "*** usage: /ctcp NICK 
REQUEST"))))

(defun rcirc-cmd-me (process victim args)
  (rcirc-send-string process (format "PRIVMSG %s :ACTION %s" 
                                     victim args)))

(defun rcirc-message-leader (sender face)
  "Return a string with SENDER propertized with FACE."
  (propertize (concat "<" (rcirc-user-nick sender) "> ") 'face face))
  
(defun rcirc-comment (string)
  "Return a copy of STRING with comment face property added."
  (propertize string 'face 'rcirc-server-face))

;;; handlers
;; these are called with the server PROCESS, the SENDER, which is a
;; server or a user, depending on the command, the ARGS, which is a
;; list of strings, and the TEXT, which is the original server text,
;; verbatim
(defun rcirc-handler-PRIVMSG (process sender args text)
  (let ((victim (car args))
        (message (cadr args)))
    (if (string-match "^\\(.*\\)$" message)
        (rcirc-handler-CTCP process victim sender (match-string 1 message))
      (rcirc-print process
                   (if (equal (aref victim 0) ?#)
                       victim
                     (rcirc-user-nick sender))
                   (concat (rcirc-message-leader sender
                                                 'rcirc-other-nick-face)
                           message)))
    (rcirc-put-nick-channel process sender victim)))

(defun rcirc-process-message (message)
  "Return a MESSAGE text with properties added based on various patterns."
  (while (string-match "^\\([^]+*\\)\\(.*\\)\\(.*\\)$" message)
    (setq message
          (concat (match-string 1 message)
                  (propertize (match-string 2 message) 'face 'bold)
                  (match-string 3 message))))
  message)

(defun rcirc-handler-JOIN (process sender args text)
  (let ((channel (car args)))
    (rcirc-print process channel (rcirc-comment text) t)
    (rcirc-put-nick-channel process sender channel)))

(defun rcirc-handler-PART (process sender args text)
  (let ((channel (car args))
        (reason (cadr args)))
    (rcirc-print process channel (rcirc-comment text) t)
    (rcirc-remove-nick-channel process sender channel)))

(defun rcirc-handler-QUIT (process sender args text)
  (let ((nick (rcirc-user-nick sender)))
    (mapcar (lambda (c)
              (rcirc-print process (aref c 0) (rcirc-comment text) t))
            (rcirc-nick-channels process nick))
    (rcirc-nick-remove process nick)))

(defun rcirc-handler-NICK (process sender args text)
  (let* ((old-nick (rcirc-user-nick sender))
         (new-nick (car args))
         (channels (rcirc-nick-channels process old-nick)))
    ;; print the nick change message to all of nick's channels
    (mapcar (lambda (c)
              (rcirc-print process (aref c 0) (rcirc-comment text) t))
            channels)
    ;; remove old nick and add new one
    (with-current-buffer (process-buffer process)
      (remhash old-nick rcirc-nick-table)
      (puthash new-nick channels rcirc-nick-table)
      ;; if this is our nick...
      (if (string= old-nick rcirc-nick)
          (setq rcirc-nick new-nick)))))

(defun rcirc-handler-KICK (process sender args text)
  (let ((nick (rcirc-user-nick sender)))
    (mapcar (lambda (c)
              (rcirc-print process (aref c 0) (rcirc-comment text) t))
            (rcirc-nick-channels process nick))
    (rcirc-nick-remove process nick)))

(defun rcirc-handler-PING (process sender args text)
  (rcirc-send-string process (concat "PONG " (car args))))

(defun rcirc-handler-TOPIC (process sender args text)
  (rcirc-print process (car args) (rcirc-comment text)))

(defun rcirc-handler-332 (process sender args text) 
  "RPL_TOPIC"
  (rcirc-print process (cadr args) (rcirc-comment text)))

(defun rcirc-handler-333 (process sender args text)
  "Not in rfc1459.txt"
  (rcirc-print process (cadr args) (rcirc-comment text)))

(defun rcirc-handler-353 (process sender args text)
  "RPL_NAMREPLY"
  (let ((channel (caddr args)))
    (rcirc-print process channel (rcirc-comment text))
    (mapcar (lambda (nick)
              (rcirc-put-nick-channel process nick channel))
            (delete "" (split-string (cadddr args) " ")))))

(defun rcirc-handler-366 (process sender args text)
  "RPL_ENDOFNAMES"
  (rcirc-print process (cadr args) (rcirc-comment text)))

(defun rcirc-handler-433 (process sender args text)
  "ERR_NICKNAMEINUSE"
  (rcirc-print process nil (rcirc-comment text))
  (let ((nick (cadr args)))
    (rcirc-cmd-nick process nil (concat nick "`"))))

(defun rcirc-handler-477 (process sender args text)
  "ERR_NOCHANMODES"
  (rcirc-print process (cadr args) (rcirc-comment text)))

(defun rcirc-handler-MODE (process sender args text)
  (rcirc-print process (car args) (rcirc-comment text)))

(defun rcirc-handler-CTCP (process victim sender text)
  (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
      (let* ((request (upcase (match-string 1 text)))
             (args (match-string 2 text))
             (nick (rcirc-user-nick sender))
             (handler (intern (concat "rcirc-handler-ctcp-" request))))
        (if (fboundp handler)
            (if (funcall handler process victim sender args)
                (rcirc-print process nick
                             (rcirc-comment
                              (format "*** ctcp from %s: %s" nick text))))
          (rcirc-print process nick
                       (rcirc-comment
                        (format "*** unhandled ctcp from %s: %s" nick 
text)))))))

(defun rcirc-handler-ctcp-VERSION (process victim sender args)
  (rcirc-send-string process
                     (concat "NOTICE " (rcirc-user-nick sender)
                             " :VERSION " (rcirc-version)
                             " - http://www.emmett.ca/~rcyeske/rcirc";
                             ""))
  t)

(defun rcirc-handler-ctcp-ACTION (process victim sender args)
  (rcirc-print process victim
               (format "*%s %s*" 
                       (propertize (rcirc-user-nick sender)
                                   'face 'rcirc-other-nick-face)
                       args))
  nil)


(defface rcirc-my-nick-face
  '((((type tty) (class color)) (:foreground "blue" :weight bold))
    (((class color) (background light)) (:foreground "Blue"))
    (((class color) (background dark)) (:foreground "LightSkyBlue"))
    (t (:inverse-video t :bold t)))
  "The rcirc face used to highlight my messages."
  :group 'rcirc)

(defface rcirc-other-nick-face
  '((((type tty) (class color)) (:foreground "yellow" :weight light))
    (((class grayscale) (background light))
     (:foreground "Gray90" :bold t :italic t))
    (((class grayscale) (background dark))
     (:foreground "DimGray" :bold t :italic t))
    (((class color) (background light)) (:foreground "DarkGoldenrod"))
    (((class color) (background dark)) (:foreground "LightGoldenrod"))
    (t (:bold t :italic t)))
  "The rcirc face used to highlight other messages."
  :group 'rcirc)

(defface rcirc-server-face
  '((((type tty pc) (class color) (background light)) (:foreground "red"))
    (((type tty pc) (class color) (background dark)) (:foreground "red1"))
    (((class grayscale) (background light))
     (:foreground "DimGray" :bold t :italic t))
    (((class grayscale) (background dark))
     (:foreground "LightGray" :bold t :italic t))
    (((class color) (background light)) (:foreground "gray40"))
    (((class color) (background dark)) (:foreground "chocolate1"))
    (t (:bold t :italic t)))
  "The rcirc face used to highlight server messages."
  :group 'rcirc)


(provide 'rcirc)
;;; rcirc.el ends here


reply via email to

[Prev in Thread] Current Thread [Next in Thread]