X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-filter.el;h=cf329892571d14912401520db539fea5d74ece43;hp=97a25a6b0516d51ae990fd52fe7a1edbe91c0c4a;hb=6d046bcb1450df250fb33796a99749ea68d88702;hpb=fe7ce5e9a344721b1ecdd4d9ec1adce5dc908a49 diff --git a/lisp/riece-filter.el b/lisp/riece-filter.el index 97a25a6..cf32989 100644 --- a/lisp/riece-filter.el +++ b/lisp/riece-filter.el @@ -24,18 +24,15 @@ ;;; Code: -(eval-when-compile (require 'riece-inlines)) - (require 'riece-handle) (require 'riece-misc) (require 'riece-server) ;riece-close-server +(require 'riece-identity) +(require 'riece-debug) (defun riece-handle-numeric-reply (prefix number name string) (let ((base-number (* (/ number 100) 100)) function) - (condition-case nil - (require (intern (format "riece-%03d" base-number))) - (error)) (setq function (intern-soft (format "riece-handle-%03d-message" number))) (unless (and function (symbol-function function)) @@ -44,21 +41,9 @@ (format "riece-handle-default-%03d-message" base-number)))) (if (and function (symbol-function function)) - (condition-case error - (funcall function prefix number name - (riece-decode-coding-string string)) - (error - (if riece-debug - (message "Error occurred in `%S': %S" function error))))))) - -(defun riece-default-handle-numeric-reply - (client-prefix prefix number name string) - (riece-insert - (list riece-dialogue-buffer riece-others-buffer) - (concat client-prefix - (riece-concat-server-name - (mapconcat #'identity (riece-split-parameters string) " ")) - "\n"))) + (riece-ignore-errors (symbol-name function) + (funcall function prefix number name + (riece-decode-coding-string string)))))) (defun riece-handle-message (prefix message string) (if (and prefix @@ -68,77 +53,112 @@ (riece-parse-user-at-host (substring prefix (1+ (match-beginning 0)))))) (setq message (downcase message) string (riece-decode-coding-string string)) - (unless (run-hook-with-args-until-success - (intern (concat "riece-" message "-hook")) - prefix string) - (let ((function (intern-soft (concat "riece-handle-" message "-message")))) + (let ((function (intern-soft (concat "riece-handle-" message "-message"))) + (hook (intern (concat "riece-" message "-hook"))) + (after-hook (intern (concat "riece-after-" message "-hook")))) + (unless (riece-ignore-errors (symbol-name hook) + (run-hook-with-args-until-success hook prefix string)) (if function - (condition-case error - (funcall function prefix string) - (error - (if riece-debug - (message "Error occurred in `%S': %S" function error)))))) - (run-hook-with-args-until-success - (intern (concat "riece-after-" message "-hook")) - prefix string))) + (riece-ignore-errors (symbol-name function) + (funcall function prefix string))) + (riece-ignore-errors (symbol-name after-hook) + (run-hook-with-args-until-success after-hook prefix string))))) + +;;; stolen (and renamed) from gnus-async.el. +(defun riece-get-semaphore (semaphore) + "Wait until SEMAPHORE is released." + (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2) + (sleep-for 1))) + +(defun riece-release-semaphore (semaphore) + "Release SEMAPHORE." + (setcdr (symbol-value semaphore) nil)) + +(defmacro riece-filter-with-semaphore (&rest forms) + `(unwind-protect + (progn + (riece-get-semaphore 'riece-filter-semaphore) + ,@forms) + (riece-release-semaphore 'riece-filter-semaphore))) + +(put 'riece-filter-with-semaphore 'lisp-indent-function 0) +(put 'riece-filter-with-semaphore 'edebug-form-spec '(body)) + +(defsubst riece-chomp-string (string) + (if (string-match "\r\\'" string) + (substring string 0 (match-beginning 0)) + string)) (defun riece-filter (process input) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char riece-read-point) - (unless riece-debug - (delete-region (riece-line-beginning-position) (point-min)) - (setq riece-read-point (point))) - (insert input) - (goto-char (prog1 riece-read-point - (setq riece-read-point (point)))) - (beginning-of-line) - (catch 'contiguous - (while (not (eobp)) - (save-excursion - (if (looking-at - ":\\([^ ]+\\) +\\([0-5][0-9][0-9]\\) +\\([^ ]+\\) +\\(.*\\)\r\n") - (riece-handle-numeric-reply - (match-string 1) ;prefix - (string-to-number (match-string 2)) ;number - (match-string 3) ;name - (match-string 4)) ;reply string - (if (looking-at "\\(:\\([^ ]+\\) +\\)?\\([^ ]+\\) +\\(.*\\)\r\n") - (riece-handle-message - (match-string 2) ;optional prefix - (match-string 3) ;command - (match-string 4)) ;params & trailing - (if (looking-at ".*\r\n") - (if riece-debug - (message "Weird message from server: %s" - (buffer-substring (point) (progn - (end-of-line) - (point))))) - (throw 'contiguous nil))))) - (forward-line))))) + (riece-filter-with-semaphore + (save-excursion + (set-buffer (process-buffer process)) + (goto-char riece-read-point) + (unless riece-debug + (delete-region (riece-line-beginning-position) (point-min)) + (setq riece-read-point (point))) + (insert input) + (goto-char (prog1 riece-read-point + (setq riece-read-point (point)))) + (beginning-of-line) + (while (and (not (eobp)) + (looking-at ".*\n")) ;the input line is not finished + (save-excursion + (if (looking-at + ":\\([^ ]+\\) +\\([0-5][0-9][0-9]\\) +\\([^ ]+\\) +\\(.*\\)\n") + (riece-handle-numeric-reply + (match-string 1) ;prefix + (string-to-number (match-string 2)) ;number + (match-string 3) ;name + (riece-chomp-string (match-string 4))) ;reply string + (if (looking-at "\\(:\\([^ ]+\\) +\\)?\\([^ ]+\\) +\\(.*\\)\n") + (riece-handle-message + (match-string 2) ;optional prefix + (match-string 3) ;command + (riece-chomp-string (match-string 4))) ;params & trailing + (if riece-debug + (message "Weird message from server: %s" + (buffer-substring (point) (progn + (end-of-line) + (point)))))))) + (forward-line))))) (eval-when-compile - (autoload 'riece "riece")) + (autoload 'riece-exit "riece")) (defun riece-sentinel (process status) (if riece-reconnect-with-password - (unwind-protect - (riece) - (setq riece-reconnect-with-password nil)) + (let ((server-name + (with-current-buffer (process-buffer process) + riece-server-name))) + (riece-close-server-process process) + (riece-open-server + (if (equal server-name "") + riece-server + (riece-server-name-to-server server-name)) + server-name)) (let ((server-name (with-current-buffer (process-buffer process) riece-server-name))) - (if (and (process-id process) ;not a network connection - (string-match "^exited abnormally with code \\([0-9]+\\)" - status)) - (if server-name - (message "Connection to \"%s\" closed: %s" - server-name (match-string 1 status)) - (message "Connection closed: %s" (match-string 1 status))) - (if server-name + (if riece-debug + (if (equal server-name "") + (message "Connection closed: %s" + (substring status 0 (1- (length status)))) (message "Connection to \"%s\" closed: %s" - server-name (substring status 0 (1- (length status)))) - (message "Connection closed: %s" - (substring status 0 (1- (length status)))))) - (riece-close-server server-name)))) + server-name (substring status 0 (1- (length status))))) + (if (equal server-name "") + (message "Connection closed") + (message "Connection to \"%s\" closed" server-name))) + (let ((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) + (riece-close-server-process process) + ;; If no server process is available, exit. + (unless riece-server-process-alist + (riece-exit))))) (provide 'riece-filter)