X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-server.el;h=25d67a4a6565a9c897d41d2992fb53e0c4217ea9;hp=565dd10d32bfe629160356252f6ab125f0a4d40d;hb=a9b170f31e6f1c743d3527cd90694c86a6db9e52;hpb=5f04241c69249d982cb80e93cb17087c4ef66162 diff --git a/lisp/riece-server.el b/lisp/riece-server.el index 565dd10..25d67a4 100644 --- a/lisp/riece-server.el +++ b/lisp/riece-server.el @@ -26,10 +26,9 @@ (require 'riece-options) (require 'riece-globals) ;for server local variables. -(require 'riece-misc) ;riece-process-send-string, etc. (require 'riece-coding) ;riece-default-coding-system (require 'riece-identity) -(require 'riece-display) +(require 'riece-compat) (eval-and-compile (defvar riece-server-keyword-map @@ -39,7 +38,7 @@ (:username riece-username) (:password) (:function #'open-network-stream) - (:coding-system riece-default-coding-system)) + (:coding riece-default-coding-system)) "Mapping from keywords to default values. All keywords that can be used must be listed here.")) @@ -63,29 +62,6 @@ the `riece-server-keyword-map' variable." (put 'riece-server-keyword-bind 'lisp-indent-function 1) (put 'riece-server-keyword-bind 'edebug-form-spec '(form body)) -(defun riece-start-server (server &optional server-name) - (if server-name - (message "Connecting to IRC server on %s..." server-name) - (message "Connecting to IRC server...")) - (prog1 (riece-open-server server server-name) - (if server-name - (message "Connecting to IRC server on %s...done" server-name) - (message "Connecting to IRC server...done")))) - -(defun riece-clear-system () - (while riece-buffer-list - (if (and (get-buffer (car riece-buffer-list)) - (buffer-live-p (car riece-buffer-list))) - (funcall riece-buffer-dispose-function (car riece-buffer-list))) - (setq riece-buffer-list (cdr riece-buffer-list))) - (setq riece-channel-buffer-alist nil - riece-user-list-buffer-alist nil - riece-current-channels nil - riece-current-channel nil - riece-channel-indicator "None" - riece-channel-list-indicator "No channel") - (delete-other-windows)) - (defun riece-server-parse-string (string) "Convert a STRING set as `riece-server' and return a property list." (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string) @@ -111,20 +87,58 @@ the `riece-server-keyword-map' variable." riece-save-variables-are-dirty t)) (cdr entry))) +(defun riece-server-process-name (server-name) + (if (equal server-name "") + "IRC" + (format "IRC<%s>" server-name))) + +(defun riece-server-process (server-name) + (get-process (riece-server-process-name server-name))) + +(defmacro riece-with-server-buffer (server-name &rest body) + `(let ((process (riece-server-process ,server-name))) + (if process + (with-current-buffer (process-buffer process) + ,@body) + (error "Server closed")))) + +(put 'riece-with-server-buffer 'lisp-indent-function 1) + +(defun riece-process-send-string (process string) + (with-current-buffer (process-buffer process) + (process-send-string process (riece-encode-coding-string string)))) + +(defun riece-send-string (string) + (let* ((server-name + (or riece-overriding-server-name + ;already in the server buffer + (if (local-variable-p 'riece-server-name (current-buffer)) + riece-server-name + (if riece-current-channel + (riece-identity-server riece-current-channel) + (if (riece-server-opened "") + ""))))) + (process (riece-server-process server-name))) + (unless process + (error "%s" (substitute-command-keys + "Type \\[riece-command-open-server] to open server."))) + (riece-process-send-string process string))) + (defun riece-open-server (server server-name) - "Open chat server on HOST. -If HOST is nil, use value of environment variable \"IRCSERVER\". -If optional argument SERVICE is non-nil, open by the service name." + (if (equal server-name "") + (message "Connecting to IRC server...") + (message "Connecting to %s..." server-name)) (riece-server-keyword-bind server (let* (selective-display (coding-system-for-read 'binary) (coding-system-for-write 'binary) (process - (funcall function "IRC" (if server-name - (format " *IRC*%s" server-name) - " *IRC*") + (funcall function (riece-server-process-name server-name) + (concat " *IRC*" server-name) host service))) (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 (or password @@ -134,7 +148,6 @@ If optional argument SERVICE is non-nil, open by the service name." (or password (riece-read-passwd "Password: "))))) - (setq riece-reconnect-with-password nil) (riece-process-send-string process (format "USER %s * * :%s\r\n" (user-real-login-name) @@ -144,8 +157,12 @@ If optional argument SERVICE is non-nil, open by the service name." (with-current-buffer (process-buffer process) (setq riece-last-nickname riece-real-nickname riece-nick-accepted 'sent - riece-coding-system coding-system)) - process))) + riece-coding-system coding)) + (setq riece-process-list + (cons process riece-process-list)))) + (if (equal server-name "") + (message "Connecting to IRC server...done") + (message "Connecting to %s...done" server-name))) (defun riece-reset-process-buffer (process) (save-excursion @@ -172,71 +189,30 @@ If optional argument SERVICE is non-nil, open by the service name." (buffer-disable-undo) (erase-buffer))) -(defun riece-close-server-process (process &optional quit-message) - (if (eq 'riece-filter (process-filter process)) - (set-process-filter process nil)) - (if (eq 'riece-sentinel (process-sentinel process)) - (set-process-sentinel process nil)) - (when (memq (process-status process) '(open run)) - (riece-process-send-string process - (if quit-message - (format "QUIT :%s\r\n" quit-message) - "QUIT\r\n")) - (delete-process process) - (unless riece-debug - (kill-buffer (process-buffer process))))) - -(eval-when-compile - (autoload 'riece-exit "riece")) -(defun riece-close-server (server-name &optional quit-message) - ;; Remove channels which belong to the server. - (let ((riece-overriding-server-name server-name) - (channels riece-current-channels)) - (while channels - (if (and (car channels) - (equal (riece-identity-server (car channels)) - server-name)) - (riece-part-channel (car channels))) - (setq channels (cdr channels))) - (riece-redisplay-buffers)) - ;; Close now. - (let (process) - (if server-name - (let ((entry (assoc server-name riece-server-process-alist))) - (setq process (cdr entry) - riece-server-process-alist - (delq entry riece-server-process-alist))) - (setq process riece-server-process - riece-server-process nil)) - (riece-close-server-process process quit-message) - ;; If no server process is available, exit. - (if (and (null riece-server-process) - (null riece-server-process-alist)) - (riece-exit)))) - -(defun riece-close-all-server (&optional quit-message) - (let ((process-list - (delq nil (cons riece-server-process - (mapcar #'cdr riece-server-process-alist))))) - (while process-list - (riece-close-server-process (car process-list) quit-message) - (setq process-list (cdr process-list))) - (setq riece-server-process nil - riece-server-process-alist nil) - (riece-exit))) +(defun riece-close-server-process (process) + (if riece-debug + (delete-process process) + (kill-buffer (process-buffer process))) + (setq riece-process-list (delq process riece-process-list))) (defun riece-server-opened (&optional server-name) - (let ((processes - (delq nil - (if server-name - (cdr (assoc server-name riece-server-process-alist)) - (cons riece-server-process - (mapcar #'cdr riece-server-process-alist)))))) + (let ((process-list riece-process-list)) (catch 'found - (while processes - (if (memq (process-status (car processes)) '(open run)) + (while process-list + (if (memq (process-status (car process-list)) '(open run)) (throw 'found t)) - (setq processes (cdr processes)))))) + (setq process-list (cdr process-list)))))) + +(defun riece-quit-server-process (process &optional message) + (run-at-time riece-quit-timeout nil + (lambda (process) + (if (memq process riece-process-list) + (kill-process (process-buffer process)))) + process) + (riece-process-send-string process + (if message + (format "QUIT :%s\r\n" message) + "QUIT\r\n"))) (provide 'riece-server)