contrib/plum-support.el

   1 ;;; plum-support.el --- pirc support for plum
   2 ;; Copyright (C) 1999 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
   3 ;; See file irchat-copyright.el for original change log and copyright info.
   4
   5 ;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
   6 ;; Created: 1999-05-06
   7 ;; Revised: 1999-05-06
   8 ;; Keywords: IRC, irchat, pirc
   9
  10 ;; This file is not part of any package.
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'custom)
  30
  31 (defcustom plum-recent-header "plum"
  32   "String added in front of each recent logged message"
  33   :type 'string
  34   :group 'irchat-support)
  35
  36 (defconst plum-recent-time-header-regexp "[0-9][0-9]:[0-9][0-9]"
  37   "Regexp for timestamp preceding in message body")
  38
  39 (defconst plum-recent-privmsg-header-regexp
  40   "[<>(=]\\([^ <>)=]*\\)[<>)=]"
  41   "Regexp for whole message line (privmsg)")
  42
  43 (defconst plum-recent-join-header-regexp
  44   "\\+ [@+]?[^ ]* [^ ]* to \\([^ ]*\\)"
  45   "Regexp for whole message line (join)")
  46
  47 (defconst plum-recent-part-header-regexp
  48   "- [^ ]* from \\([^ ]*\\)"
  49   "Regexp for whole message line (part)")
  50
  51 (defconst plum-recent-kick-header-regexp
  52   "- [^ ]* by [^ ]* from \\([^ ]*\\) .*"
  53   "Regexp for whole message line (kick)")
  54
  55 (defconst plum-recent-mode-header-regexp
  56   "Mode by [^:]*: \\([^ ]*\\) .*"
  57   "Regexp for whole message line (mode)")
  58
  59 (defconst plum-recent-topic-header-regexp
  60   "Topic of channel \\([^ ]*\\) by [^:]*: .*"
  61   "Regexp for whole message line (nick)")
  62
  63 (defconst plum-recent-message-header-regexp
  64   (concat "^\\(" plum-recent-time-header-regexp "\\)? *"
  65           plum-recent-privmsg-header-regexp))
  66
  67 (defconst plum-recent-channel-header-regexp
  68   (concat "^\\(" plum-recent-time-header-regexp "\\)? *"
  69           (mapconcat (function identity)
  70                      (list plum-recent-join-header-regexp
  71                            plum-recent-part-header-regexp
  72                            plum-recent-kick-header-regexp
  73                            plum-recent-mode-header-regexp
  74                            plum-recent-topic-header-regexp)
  75                      "\\|")))
  76
  77 (defconst plum-recent-generic-header-regexp
  78   (concat "^\\(" plum-recent-time-header-regexp "\\)? *"))
  79
  80 (defvar plum-recent-log-buffer " *plum recent log")
  81
  82 (defun plum-parse-recent-after ()
  83   "Parse text after point as recent log message, then returns components"
  84   (save-excursion
  85     (let (time lparen rparen chnl nick)
  86       (cond
  87        ((looking-at plum-recent-message-header-regexp)
  88         (setq time (match-string 1))
  89         (goto-char (match-beginning 2))
  90         (setq lparen (char-before))
  91         (goto-char (match-end 2))
  92         (setq rparen (char-after))
  93         (skip-chars-backward "^: ")
  94         (skip-chars-forward "=")
  95         (setq nick (buffer-substring (point) (match-end 2)))
  96         (backward-char)
  97         (setq chnl (buffer-substring (match-beginning 2) (point)))
  98         (goto-char (match-end 0))
  99         (forward-char)
 100         (list 'message time lparen rparen chnl nick
 101               (buffer-substring (point) (line-end-position))))
 102        ((looking-at plum-recent-channel-header-regexp)
 103         (setq time (match-string 1)
 104               chnl (match-string 2))
 105         (goto-char (match-end 1))
 106         (forward-char)
 107         (list 'channel time chnl
 108               (buffer-substring (point) (line-end-position))))
 109        ((looking-at plum-recent-generic-header-regexp)
 110         (setq time (match-string 1))
 111         (goto-char (match-end 0))
 112         (list 'generic time (buffer-substring (point) (line-end-position)))))
 113       )))
 114
 115 (add-hook 'irchat-notice-hook 'plum-recent-add)
 116 (add-hook 'irchat-002-hook
 117           (function
 118            (lambda (header rest)
 119              (remove-hook 'irchat-notice-hook 'plum-recent-add) )))
 120
 121 (defun plum-recent-add (header rest)
 122   "Add recent log line into `plum-recent-log-buffer'."
 123   (let (fun from to body component type)
 124     (if header
 125         nil
 126       (and rest (string-match "^[^ ]* +:\\(.*\\)" rest)
 127            (with-temp-buffer
 128              (insert (match-string 1 rest) ?\n)
 129              (goto-char (point-min))
 130              (setq component (plum-parse-recent-after)
 131                    type (pop component))
 132              (cond
 133               ((eq type 'message)
 134                (setq from (nth 4 component)
 135                      to (cond
 136                          ((eq (nth 1 component) ?=)
 137                           (irchat-current-nickname))
 138                          ((eq (nth 1 component) ?<)
 139                           (irchat-channel-real (nth 3 component))))
 140                      body (concat "(" plum-recent-header " " (car component)
 141                                   ") " (nth 5 component))
 142                      fun (llhandler-lookup "irchat-handle-privmsg-msg"))
 143                (funcall fun from (concat to " :" body))
 144                t)
 145               (t nil)))))))
 146
 147
 148 (provide 'plum-support)
 149
 150 ;;; plum-support.el ends here.