home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / irchat-pj / 2.5 / irchat-pj-2.5.6p.tar.gz / irchat-pj-2.5.6p.tar / irchat-pj-2.5.6p / irchat-filter.el < prev    next >
Lisp/Scheme  |  2001-09-16  |  6KB  |  150 lines
  1. ;;;
  2. ;;; $Id: irchat-filter.el,v 1.11 2001/09/01 14:06:20 simm Exp $
  3. ;;;
  4. ;;; see file irchat-copyright.el for change log and copyright info
  5.  
  6. (require 'pure-generic)
  7. (require 'pure-cs)
  8. (require 'pure-pr-filter)
  9.  
  10. ;;;
  11. ;;;  These are defsubst just for speed, as it is expensive to call funtions at
  12. ;;;  emacs lisp (also evals are expensive)
  13. ;;;
  14. (defsubst irchat-current-minute ()
  15.   (string-to-int (substring (current-time-string) 14 16)))
  16. (defvar irchat-minute 0)
  17.  
  18. (defun irchat-pj-apply (func &rest args)
  19.   "Apply with error handling"
  20.   (if (fboundp func)
  21.       (condition-case nil
  22.       (apply 'apply func args)
  23.     (error
  24.      (message "irchat-pj: ERROR: function %s:" func)
  25.      (let ((i 0) (rest args))
  26.        (while rest
  27.          (message "\targs[%d]: \"%s\"" i (car rest))
  28.          (setq i (1+ i) rest (cdr rest))))
  29.      (ding)))
  30.     (message "irchat-pj: ERROR: No such function: %s" func)))
  31.  
  32. (defun irchat-handle (line)
  33.   "Called when we have at least one line of output from the IRC server."
  34.   (let ((obuf (current-buffer))
  35.     prefix userhost (cmd "") arg)
  36.     (while (string-match "^\\([^\r]*\\)\r+\\(.*\\)" line)
  37.       (setq line (concat (match-string 1 line)
  38.              (match-string 2 line))))
  39.     (if (string-match "^:\\([^ ]+\\) *\\(.*\\)" line)
  40.     (setq prefix (match-string 1 line)
  41.           line (match-string 2 line)))
  42.     (if (and prefix (string-match "^\\([^!]*\\)!\\(.*\\)" prefix))
  43.     (setq userhost (match-string 2 prefix)
  44.           prefix (match-string 1 prefix)))
  45.     (if (string-match "^ *\\([^ ]+\\) *\\(.*\\)" line)
  46.     (setq arg (list (match-string 1 line))
  47.           line (match-string 2 line)))
  48.     (while (string-match "^\\([^:][^ ]*\\) +\\(.*\\)" line)
  49.       (nconc arg (list (match-string 1 line)))
  50.       (setq line (match-string 2 line)))
  51.     (if (not (string= line ""))
  52.     (if (string-match "^:\\(.*\\)" line)
  53.         (nconc arg (list (match-string 1 line)))
  54.       (nconc arg (list line))))
  55.     (if (and prefix userhost
  56.          (not (string= (get (intern prefix) 'userhost) userhost)))
  57.     (put (intern prefix) 'userhost userhost))
  58.     (if (car arg)
  59.     (setq cmd (downcase (car arg))
  60.           arg (cdr arg)))
  61.     (if (and (boundp (setq hook
  62.                (intern (concat "irchat-handle-" cmd "-hook"))))
  63.          (eval hook)
  64.          (eval (list (eval hook) (cons prefix arg))))
  65.     nil
  66.       (setq fun (intern (concat "irchat-handle-" cmd)))
  67.       ;; modified by simm@irc.fan.gr.jp, Thu, 10 Jun 1999
  68.       (if (or (eq fun 'irchat-handle-join)
  69.               (eq fun 'irchat-handle-nick)
  70.               (eq fun 'irchat-handle-part)
  71.               (eq fun 'irchat-handle-quit))
  72.           (irchat-pj-apply fun prefix userhost arg)
  73.         (if (fboundp fun)
  74.             (irchat-pj-apply fun prefix arg)
  75.           (if irchat-debugging
  76.               (irchat-insert-special (format "No handle-%s (%s) %s\n" cmd prefix
  77.                                              (prin1-to-string arg))))
  78.           (let* ((cmd-number (string-to-int cmd))
  79.                  (default-number (/ cmd-number 100)) tmp)
  80.             (setq fun (intern (concat "irchat-handle-"
  81.                                       (format "%d00s" default-number))))
  82.             (if (and (> cmd-number 0)
  83.                      (fboundp fun))
  84.                 (irchat-pj-apply fun cmd-number prefix arg)
  85.               (setq tmp (format "Unknown MESSAGE: [%s] [%s] [%s]\n" 
  86.                                 prefix cmd (prin1-to-string arg)))
  87.               (message tmp)
  88.               (irchat-insert0 tmp))))))
  89.     (set-buffer obuf)))
  90.  
  91. (defun irchat-pj-parser (proc)
  92.   "Parser function for IRC connection."
  93.   (let* ((str (buffer-substring (point-min) (point-max)))
  94.      (cs  (pure-cs-detect-string
  95.            str irchat-pj-cs-8bit-coding-system irchat-pj-cs-detect-function)))
  96.     (save-excursion
  97.       (set-buffer irchat-pj-debug-buffer)
  98.       (goto-char (point-max))
  99.       (insert str "\n"))
  100.     (if (eq cs pure-cs-default-coding-system)
  101.     (setq str (pure-cs-decode-string str cs))
  102.       (pure-cs-hide-region (point-min) (point-max))
  103.       (pure-cs-unhide-region (point-min) (point-max) cs)
  104.       (pure-cs-buffer-multibyte)
  105.       (setq str (buffer-substring (point-min) (point-max)))
  106.       (pure-cs-buffer-unibyte))
  107.     (irchat-handle str)))
  108.  
  109. (defun irchat-sentinel (proc status)
  110.   "Sentinel function for IRC server process."
  111.   (and irchat-server-process
  112.        (not (irchat-server-opened))
  113.        (cond ((or irchat-reconnect-automagic irchat-reconnect-with-password)
  114.           (or (and irchat-grow-tail
  115.                (not irchat-reconnect-with-password)
  116.                (setq irchat-nickname (concat irchat-nickname irchat-grow-tail))
  117.                (irchat 'always))
  118.           (irchat)))
  119.          (irchat-fatal-error-message
  120.           (error (format "IRC ERROR: %s" irchat-fatal-error-message)))
  121.          ((process-id proc)
  122.           (irchat-sentinel2 proc status))
  123.          (t
  124.           (error (format "IRC ERROR: Connection closed. (%s)"
  125.                  (substring status 0 (1- (length status)))))))))
  126.  
  127. (defun irchat-sentinel2 (proc status)
  128.   (if (string-match "^exited abnormally with code \\([0-9]+\\)" status)
  129.       (let ((status (string-to-int (match-string 1 status))))
  130.     (cond
  131.      ((= 99 status);; unsupported command
  132.       (error (format "IRC ERROR: Please use a newer \"%s\"."
  133.              irchat-pj-dcc-program)))
  134.      ((= 98 status);; bad argment number
  135.       (error (format "IRC ERROR: Please use a newer \"%s\"."
  136.              irchat-pj-dcc-program)))
  137.      ((= 97 status)
  138.       (error (format "IRC ERROR: Cannot connect to IRC server.")))
  139.      (t
  140.       (error (format "IRC ERROR: Server connection closed.")))))
  141.     (error (format "IRC ERROR: Connection closed. (%s)"
  142.            (substring status 0 (1- (length status)))))))
  143.  
  144. ;; That's all
  145. (provide 'irchat-filter)
  146.  
  147. ;;;
  148. ;;; eof
  149. ;;;
  150.