X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-server.el;h=1500d46b6e79e5e3c19440cd27ce513c199c072a;hb=625aafd1d2928e4c74d15c0a1d776097aed8bb3c;hp=62e26bb42e769503686134ae0f5f09f7b2bc6bc6;hpb=4006a97f4992512ecd83e7a72f690b21d5bccd92;p=riece diff --git a/lisp/riece-server.el b/lisp/riece-server.el index 62e26bb..1500d46 100644 --- a/lisp/riece-server.el +++ b/lisp/riece-server.el @@ -37,7 +37,7 @@ (:nickname riece-nickname) (:username riece-username) (:password) - (:function #'open-network-stream) + (:function riece-default-open-connection-function) (:coding riece-default-coding-system)) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -103,6 +103,7 @@ the `riece-server-keyword-map' variable." (error "Server closed")))) (put 'riece-with-server-buffer 'lisp-indent-function 1) +(put 'riece-with-server-buffer 'edebug-form-spec '(form body)) (defun riece-process-send-string (process string) (with-current-buffer (process-buffer process) @@ -127,53 +128,36 @@ the `riece-server-keyword-map' variable." (riece-process-send-string process string))) (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 - ;; XEmacs signals an error when the keyboard cannot be grabbed. - (condition-case nil - (setq password (riece-read-passwd "Password: ")) - (error)) - (setq riece-reconnect-with-password nil))) - (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)) + (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 (set-buffer (process-buffer process)) @@ -200,9 +184,7 @@ the `riece-server-keyword-map' variable." (erase-buffer))) (defun riece-close-server-process (process) - (if riece-debug - (delete-process process) - (kill-buffer (process-buffer process))) + (kill-buffer (process-buffer process)) (setq riece-server-process-alist (delq (rassq process riece-server-process-alist) riece-server-process-alist))) @@ -222,22 +204,6 @@ the `riece-server-keyword-map' variable." (throw 'found t)) (setq alist (cdr alist))))))) -(eval-when-compile - (autoload 'riece-exit "riece")) -(defun riece-quit-server-process (process &optional message) - (riece-run-at-time riece-quit-timeout nil - (lambda (process) - (when (rassq process riece-server-process-alist) - (riece-close-server-process process) - ;; If no server process is available, exit. - (unless riece-server-process-alist - (riece-exit)))) - 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