X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-server.el;h=e0ffa2843c1507a6f044d6bdff8aff0d621d23ef;hp=93183848b2618d10edefc1a206783b7ee3fdbf61;hb=5cf6550175a81a3ded3c789d55cc3dd56b397e49;hpb=0c52f46bc4c1ccf77b0aa4cf966e92487f8e84af diff --git a/lisp/riece-server.el b/lisp/riece-server.el index 9318384..e0ffa28 100644 --- a/lisp/riece-server.el +++ b/lisp/riece-server.el @@ -105,9 +105,30 @@ the `riece-server-keyword-map' variable." (put 'riece-with-server-buffer 'lisp-indent-function 1) (put 'riece-with-server-buffer 'edebug-form-spec '(form body)) +(defun riece-flush-send-queue (process reset) + (with-current-buffer (process-buffer process) + (let ((length 0) + string) + (if reset + (setq riece-send-size 0)) + (while (and riece-send-queue + (<= riece-send-size riece-max-send-size)) + (setq string (riece-encode-coding-string (car riece-send-queue)) + length (length string)) + (if (> length riece-max-send-size) + (message "Long message (%d > %d)" length riece-max-send-size) + (setq riece-send-size (+ riece-send-size length)) + (if (<= riece-send-size riece-max-send-size) + (process-send-string process string))) + (setq riece-send-queue (cdr riece-send-queue))) + (if riece-send-queue + (riece-run-at-time riece-send-delay nil + #'riece-flush-send-queue process t))))) + (defun riece-process-send-string (process string) (with-current-buffer (process-buffer process) - (process-send-string process (riece-encode-coding-string string)))) + (setq riece-send-queue (nconc riece-send-queue (list string)))) + (riece-flush-send-queue process nil)) (defun riece-current-server-name () (or riece-overriding-server-name @@ -127,70 +148,38 @@ 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)) + (condition-case nil + (setq process (funcall function server server-name)) + (error)) + (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) - (progn - (riece-close-server-process process) - ;; If no server process is available, exit. - (unless riece-server-process-alist - (riece-exit))) - (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 @@ -211,6 +200,9 @@ the `riece-server-keyword-map' variable." (make-local-variable 'riece-server-name) (make-local-variable 'riece-read-point) (setq riece-read-point (point-min)) + (make-local-variable 'riece-send-queue) + (make-local-variable 'riece-send-size) + (setq riece-send-size 0) (make-local-variable 'riece-obarray) (setq riece-obarray (make-vector riece-obarray-size 0)) (make-local-variable 'riece-coding-system) @@ -218,11 +210,7 @@ the `riece-server-keyword-map' variable." (erase-buffer))) (defun riece-close-server-process (process) - (if riece-debug - (delete-process process) - (set-process-filter process nil) - (set-process-sentinel process nil) - (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))) @@ -242,21 +230,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) - (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