cgit.sxemacs.org Git - riece/blob - lisp/riece-irc.el

   1 ;;; riece-irc.el --- IRC protocol
   2 ;; Copyright (C) 1998-2004 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'riece-filter)
  28 (require 'riece-server)
  29
  30 (defun riece-irc-open-server (server server-name)
  31   (riece-server-keyword-bind server
  32     (let (selective-display
  33           (coding-system-for-read 'binary)
  34           (coding-system-for-write 'binary)
  35           process)
  36       (if (equal server-name "")
  37           (message "Connecting to IRC server...")
  38         (message "Connecting to %s..." server-name))
  39       (setq process
  40             (funcall function (riece-server-process-name server-name)
  41                      (concat " *IRC*" server-name)
  42                      host service))
  43       (if (equal server-name "")
  44           (message "Connecting to IRC server...done")
  45         (message "Connecting to %s...done" server-name))
  46       (riece-reset-process-buffer process)
  47       (with-current-buffer (process-buffer process)
  48         (setq riece-server-name server-name))
  49       (set-process-sentinel process 'riece-sentinel)
  50       (set-process-filter process 'riece-filter)
  51       (if (equal server-name "")
  52           (message "Logging in to IRC server...")
  53         (message "Logging in to %s..." server-name))
  54       (if riece-reconnect-with-password ;password incorrect or not set.
  55           (unwind-protect
  56               (setq password
  57                     (condition-case nil
  58                         (let (inhibit-quit)
  59                           (if (equal server-name "")
  60                               (riece-read-passwd "Password: ")
  61                             (riece-read-passwd (format "Password for %s: "
  62                                                        server-name))))
  63                       (quit
  64                        (if (equal server-name "")
  65                            (message "Password: Quit")
  66                          (message (format "Password for %s: Quit"
  67                                           server-name)))
  68                        'quit)))
  69             (setq riece-reconnect-with-password nil)))
  70       (if (eq password 'quit)
  71           (delete-process process)
  72         (if password
  73             (riece-process-send-string process
  74                                        (format "PASS %s\r\n" password)))
  75         (riece-process-send-string process
  76                                    (format "USER %s * * :%s\r\n"
  77                                            (user-real-login-name)
  78                                            (or username
  79                                                "No information given")))
  80         (riece-process-send-string process (format "NICK %s\r\n" nickname))
  81         (with-current-buffer (process-buffer process)
  82           (setq riece-last-nickname riece-real-nickname
  83                 riece-nick-accepted 'sent
  84                 riece-coding-system coding))
  85         process))))
  86
  87 (defun riece-irc-quit-server-process (process &optional message)
  88   (if riece-quit-timeout
  89       (riece-run-at-time riece-quit-timeout nil
  90                          (lambda (process)
  91                            (if (rassq process riece-server-process-alist)
  92                                (delete-process process)))
  93                          process))
  94   (riece-process-send-string process
  95                              (if message
  96                                  (format "QUIT :%s\r\n" message)
  97                                "QUIT\r\n")))
  98
  99 (provide 'riece-irc)