From 625aafd1d2928e4c74d15c0a1d776097aed8bb3c Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Mon, 19 Jul 2004 00:11:44 +0000 Subject: [PATCH] * riece-server.el (riece-open-server): Call protocol interface. (riece-quit-server-process): Ditto. * riece-options.el (riece-protocol): New user option. * riece-server.el: Don't require 'riece-filter. * riece-irc.el: New file split from riece-server.el. * COMPILE (riece-modules): Add riece-irc. * Makefile.am (EXTRA_DIST): Add riece-irc.el. --- lisp/COMPILE | 1 + lisp/ChangeLog | 13 ++++++ lisp/Makefile.am | 2 +- lisp/riece-irc.el | 99 ++++++++++++++++++++++++++++++++++++++++ lisp/riece-options.el | 5 +++ lisp/riece-server.el | 102 ++++++++++++------------------------------ 6 files changed, 148 insertions(+), 74 deletions(-) create mode 100644 lisp/riece-irc.el diff --git a/lisp/COMPILE b/lisp/COMPILE index 709cb1d..0b5240d 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -42,6 +42,7 @@ riece-500 riece-commands + riece-irc riece ;; add-ons diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dccb8d7..5cc1241 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2004-07-19 Daiki Ueno + + * riece-server.el (riece-open-server): Call protocol interface. + (riece-quit-server-process): Ditto. + + * riece-options.el (riece-protocol): New user option. + + * riece-server.el: Don't require 'riece-filter. + + * riece-irc.el: New file split from riece-server.el. + * COMPILE (riece-modules): Add riece-irc. + * Makefile.am (EXTRA_DIST): Add riece-irc.el. + 2004-07-18 Daiki Ueno * riece.el: Don't require 'riece-filter. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 746eb36..c63edb8 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -5,7 +5,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-filter.el riece-globals.el riece-handle.el riece-highlight.el \ riece-identity.el riece-message.el riece-misc.el riece-mode.el \ riece-naming.el riece-options.el riece-server.el riece-signal.el \ - riece-user.el riece-version.el riece-xemacs.el riece.el \ + riece-user.el riece-version.el riece-xemacs.el riece-irc.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ riece-ndcc.el riece-rdcc.el riece-log.el riece-mini.el \ riece-doctor.el riece-alias.el riece-layout.el riece-skk-kakutei.el \ diff --git a/lisp/riece-irc.el b/lisp/riece-irc.el new file mode 100644 index 0000000..f44e199 --- /dev/null +++ b/lisp/riece-irc.el @@ -0,0 +1,99 @@ +;;; riece-irc.el --- IRC protocol +;; Copyright (C) 1998-2004 Daiki Ueno + +;; Author: Daiki Ueno +;; Created: 1998-09-28 +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; This program 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 program 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. + +;;; Code: + +(require 'riece-filter) +(require 'riece-server) + +(defun riece-irc-open-server (server server-name) + (riece-server-keyword-bind server + (let (selective-display + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + process) + (if (equal server-name "") + (message "Connecting to IRC server...") + (message "Connecting to %s..." server-name)) + (setq process + (funcall function (riece-server-process-name server-name) + (concat " *IRC*" server-name) + host service)) + (if (equal server-name "") + (message "Connecting to IRC server...done") + (message "Connecting to %s...done" server-name)) + (riece-reset-process-buffer process) + (with-current-buffer (process-buffer process) + (setq riece-server-name server-name)) + (set-process-sentinel process 'riece-sentinel) + (set-process-filter process 'riece-filter) + (if (equal server-name "") + (message "Logging in to IRC server...") + (message "Logging in to %s..." server-name)) + (if riece-reconnect-with-password ;password incorrect or not set. + (unwind-protect + (setq password + (condition-case nil + (let (inhibit-quit) + (if (equal server-name "") + (riece-read-passwd "Password: ") + (riece-read-passwd (format "Password for %s: " + server-name)))) + (quit + (if (equal server-name "") + (message "Password: Quit") + (message (format "Password for %s: Quit" + server-name))) + 'quit))) + (setq riece-reconnect-with-password nil))) + (if (eq password 'quit) + (delete-process process) + (if password + (riece-process-send-string process + (format "PASS %s\r\n" password))) + (riece-process-send-string process + (format "USER %s * * :%s\r\n" + (user-real-login-name) + (or username + "No information given"))) + (riece-process-send-string process (format "NICK %s\r\n" nickname)) + (with-current-buffer (process-buffer process) + (setq riece-last-nickname riece-real-nickname + riece-nick-accepted 'sent + riece-coding-system coding)) + process)))) + +(defun riece-irc-quit-server-process (process &optional message) + (if riece-quit-timeout + (riece-run-at-time riece-quit-timeout nil + (lambda (process) + (if (rassq process riece-server-process-alist) + (delete-process process))) + process)) + (riece-process-send-string process + (if message + (format "QUIT :%s\r\n" message) + "QUIT\r\n"))) + +(provide 'riece-irc) \ No newline at end of file diff --git a/lisp/riece-options.el b/lisp/riece-options.el index 776de9d..d7b4cdb 100644 --- a/lisp/riece-options.el +++ b/lisp/riece-options.el @@ -170,6 +170,11 @@ way is to put Riece variables on .emacs or file loaded from there." :type 'string :group 'riece-server) +(defcustom riece-protocol 'irc + "Protocol support." + :type 'symbol + :group 'riece-server) + (defcustom riece-default-password (getenv "IRCPASSWORD") "Your password." :type '(radio (string :tag "Password") diff --git a/lisp/riece-server.el b/lisp/riece-server.el index bac3c99..1500d46 100644 --- a/lisp/riece-server.el +++ b/lisp/riece-server.el @@ -29,7 +29,6 @@ (require 'riece-coding) ;riece-default-coding-system (require 'riece-identity) (require 'riece-compat) -(require 'riece-filter) (eval-and-compile (defvar riece-server-keyword-map @@ -39,8 +38,7 @@ (:username riece-username) (:password) (:function riece-default-open-connection-function) - (:coding riece-default-coding-system) - (:protocol)) + (:coding riece-default-coding-system)) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -129,66 +127,36 @@ the `riece-server-keyword-map' variable." "Type \\[riece-command-open-server] to open server."))) (riece-process-send-string process string))) -(eval-when-compile - (autoload 'riece-exit "riece")) (defun riece-open-server (server server-name) - (riece-server-keyword-bind server - (let (selective-display - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) - process) - (if (equal server-name "") - (message "Connecting to IRC server...") - (message "Connecting to %s..." server-name)) - (setq process - (funcall function (riece-server-process-name server-name) - (concat " *IRC*" server-name) - host service)) - (if (equal server-name "") - (message "Connecting to IRC server...done") - (message "Connecting to %s...done" server-name)) - (riece-reset-process-buffer process) + (let ((protocol (or (plist-get server :protocol) + riece-protocol)) + function + process) + (condition-case nil + (require (intern (concat "riece-" (symbol-name protocol)))) + (error)) + (setq function (intern-soft (concat "riece-" + (symbol-name protocol) + "-open-server"))) + (unless function + (error "\"%S\" is not supported" protocol)) + (setq process (funcall function server server-name)) + (when process (with-current-buffer (process-buffer process) - (setq riece-server-name server-name)) - (set-process-sentinel process 'riece-sentinel) - (set-process-filter process 'riece-filter) - (if (equal server-name "") - (message "Logging in to IRC server...") - (message "Logging in to %s..." server-name)) - (if riece-reconnect-with-password ;password incorrect or not set. - (unwind-protect - (setq password - (condition-case nil - (let (inhibit-quit) - (if (equal server-name "") - (riece-read-passwd "Password: ") - (riece-read-passwd (format "Password for %s: " - server-name)))) - (quit - (if (equal server-name "") - (message "Password: Quit") - (message (format "Password for %s: Quit" - server-name))) - 'quit))) - (setq riece-reconnect-with-password nil))) - (if (eq password 'quit) - (delete-process process) - (if password - (riece-process-send-string process - (format "PASS %s\r\n" password))) - (riece-process-send-string process - (format "USER %s * * :%s\r\n" - (user-real-login-name) - (or username - "No information given"))) - (riece-process-send-string process (format "NICK %s\r\n" nickname)) - (with-current-buffer (process-buffer process) - (setq riece-last-nickname riece-real-nickname - riece-nick-accepted 'sent - riece-coding-system coding)) - (setq riece-server-process-alist - (cons (cons server-name process) - riece-server-process-alist)))))) + (make-local-variable 'riece-protocol) + (setq riece-protocol protocol)) + (setq riece-server-process-alist + (cons (cons server-name process) + riece-server-process-alist))))) + +(defun riece-quit-server-process (process &optional message) + (let ((function (intern-soft + (concat "riece-" + (with-current-buffer (process-buffer process) + (symbol-name riece-protocol)) + "-quit-server-process")))) + (if function + (funcall function process message)))) (defun riece-reset-process-buffer (process) (save-excursion @@ -236,18 +204,6 @@ the `riece-server-keyword-map' variable." (throw 'found t)) (setq alist (cdr alist))))))) -(defun riece-quit-server-process (process &optional message) - (if riece-quit-timeout - (riece-run-at-time riece-quit-timeout nil - (lambda (process) - (if (rassq process riece-server-process-alist) - (delete-process process))) - process)) - (riece-process-send-string process - (if message - (format "QUIT :%s\r\n" message) - "QUIT\r\n"))) - (provide 'riece-server) ;;; riece-server.el ends here -- 2.25.1