X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-server.el;h=74bf56c5f5d513f549600fa91679ebf38779bb35;hp=6b7e1e69fe57bbed34a1dbbb79d53e1598b2b7e2;hb=27a2334fe77f8c4372ed47ca04c4c45f749d2181;hpb=66ed542609a4125ab4b379b02d76e09d352b6685 diff --git a/lisp/riece-server.el b/lisp/riece-server.el index 6b7e1e6..74bf56c 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 &optional 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,66 +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) - (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 @@ -206,6 +199,9 @@ the `riece-server-keyword-map' variable." (make-local-variable 'riece-channel-filter) (make-local-variable 'riece-server-name) (make-local-variable 'riece-read-point) + (make-local-variable 'riece-send-queue) + (make-local-variable 'riece-send-size) + (setq riece-send-size 0) (setq riece-read-point (point-min)) (make-local-variable 'riece-obarray) (setq riece-obarray (make-vector riece-obarray-size 0)) @@ -234,18 +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) - (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