cgit.sxemacs.org Git - packages/blob - xemacs-packages/liece/lisp/liece-filter.el

   1 ;;; liece-filter.el --- Process filters for IRC process.
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Revised: 1998-11-25
   7 ;; Keywords: IRC, liece
   8
   9 ;; This file is part of Liece.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (require 'liece-inlines)
  33 (require 'liece-misc)
  34 (require 'liece-intl)
  35 (require 'liece-handler)
  36
  37 (defvar liece-current-function nil)
  38
  39 (defun* liece-handle-message (prefix message line)
  40   (let ((hook (intern (concat "liece-" message "-hook")))
  41         (after-hook (intern (concat "liece-after-" message "-hook")))
  42         (number (car (read-from-string message)))
  43         function)
  44     (if (run-hook-with-args-until-success hook prefix line)
  45         (return-from liece-handle-message))
  46     (if (not (numberp number))
  47         (setq function (liece-handler-find-function message '(prefix line) "generic"))
  48       (let ((base (format "%03d" (- number (mod number 100)))))
  49         (require (intern (concat "liece-" base)) nil 'noerror)
  50         (setq function (liece-handler-find-function message '(prefix line) base))
  51         (or function
  52             (setq function
  53                   (let ((default (concat "liece-handle-" base "-messages")))
  54                     `(lambda (prefix line)
  55                        (funcall (intern ,default) ,message prefix line)))))))
  56     (if function
  57         (funcall function prefix line))
  58     (run-hook-with-args after-hook prefix line)))
  59
  60 (defun liece-parse-user-at-host ()
  61   (let ((cookie
  62          (and (stringp liece-user-at-host)
  63               (> (length liece-user-at-host) 2)
  64               (string-to-char liece-user-at-host))))
  65     (cond
  66      ((null cookie)
  67       (setq liece-user-at-host-type 'invalid))
  68      ((or (eq cookie ?^) (eq cookie ?=))
  69       (setq liece-user-at-host (substring liece-user-at-host 1)
  70             liece-user-at-host-type 'fake))
  71      ((or (eq cookie ?~) (eq cookie ?-))
  72       (setq liece-user-at-host (substring liece-user-at-host 1)
  73             liece-user-at-host-type 'not-verified))
  74      ((eq cookie ?+)
  75       (setq liece-user-at-host (substring liece-user-at-host 1)
  76             liece-user-at-host-type 'ok))
  77      (t (setq liece-user-at-host-type 'ok)))))
  78
  79 (defun liece-parse-line (line)
  80   (let (prefix message)
  81     (when (or (string-match "^\\(:[^! ]*\\)!\\([^ ]*\\) +\\([^ ]+\\) +:?"
  82                             line)
  83               (string-match "^\\(:[^ ]*\\)?\\(\\) *\\([^ ]+\\) +:?"
  84                             line)
  85               (string-match "^\\(:[^! \t]*\\)!\\([^ \t]*\\) +\\([^ \t]+\\) +:?"
  86                             line)
  87               (string-match "^\\(:[^ ]*\\)?\\(\\) *\\([^ \t]+\\) +:?"
  88                             line))
  89       (setq prefix (if (match-beginning 1)
  90                        (substring (match-string 1 line) 1))
  91             liece-user-at-host (match-string 2 line)
  92             message (downcase (match-string 3 line))
  93             line (liece-coding-decode-charset-string
  94                   (substring line (match-end 0))))
  95
  96       (liece-parse-user-at-host)
  97       (setq liece-current-function (list prefix message))
  98       (liece-handle-message prefix message line)
  99       (setq liece-current-function '("" "")))))
 100
 101 (defun liece-filter (process output)
 102   "Filter function for IRC server process."
 103   (with-current-buffer (process-buffer process)
 104     (goto-char (point-max))
 105     (insert (liece-convert-received-input output))
 106     (goto-char (point-min))
 107     (while (progn (end-of-line) (and (not (eobp)) (eq (char-after) ?\n)))
 108       (if (eq (char-after (1- (point))) ?\r) ; cut off preceding LF
 109           (delete-region (1- (point)) (point)))
 110       (liece-parse-line (buffer-substring (point-min) (point)))
 111       (delete-region (point-min) (progn (beginning-of-line 2) (point))))))
 112
 113 (defun liece-sentinel (proc status)
 114   "Sentinel function for Liece process."
 115   (cond
 116    ((or (not liece-server-process) (liece-server-opened)))
 117    ((not (or liece-reconnect-automagic liece-reconnect-with-password))
 118     (if (process-id proc)
 119         (liece-sentinel-error proc status)
 120       (liece-message (_ "Connection closed. (%s)")
 121                       (substring status 0 (1- (length status)))))
 122     (liece-close-server))
 123    (liece-reconnect-with-password
 124     (liece))
 125    (t
 126     (condition-case nil
 127         (progn
 128           (set-process-filter liece-server-process nil)
 129           (set-process-sentinel liece-server-process nil))
 130       (wrong-type-argument nil))
 131     (setq liece-server-process nil)
 132     (liece))))
 133
 134 (defun liece-sentinel-error (proc status)
 135   (if (not (string-match "^exited abnormally with code \\([0-9]+\\)" status))
 136       (liece-message (_ "Connection closed. (%s)")
 137                       (substring status 0 (1- (length status))))
 138     (let ((status (string-to-int (match-string 1 status))))
 139       (cond
 140        ((= 99 status) ;; unsupported command
 141         (liece-message (_ "Please use a newer \"%s\".") liece-dcc-program))
 142        ((= 98 status) ;; bad argment number
 143         (liece-message (_ "Please use a newer \"%s\".") liece-dcc-program))
 144        ((= 97 status)
 145         (liece-message (_ "Cannot connect to IRC server.")))
 146        (t
 147         (liece-message (_ "Server connection closed.")))))))
 148
 149 (provide 'liece-filter)
 150
 151 ;;; liece-filter.el ends here