cgit.sxemacs.org Git - riece/blob - lisp/riece-eval.el

   1 ;;; riece-eval.el --- eval add-on
   2 ;; Copyright (C) 2005 OHASHI Akira
   3
   4 ;; Author: OHASHI Akira <bg66@koka-in.org>
   5 ;; Keywords: IRC, riece
   6
   7 ;; This file is part of Riece.
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This add-on evaluate an input string as lisp object and send a result
  27 ;; as notice. Note the risky of this add-on.
  28
  29 ;; To use, add the following line to your ~/.riece/init.el:
  30 ;; (add-to-list 'riece-addons 'riece-eval)
  31
  32 ;;; Code:
  33
  34 (require 'pp)
  35 (require 'riece-message)
  36
  37 (defgroup riece-eval nil
  38   "Evaluate an input string as lisp object."
  39   :prefix "riece-"
  40   :group 'riece)
  41
  42 (defcustom riece-eval-regexp "^, "
  43   "*Pattern of string evaluating."
  44   :type 'string
  45   :group 'riece-eval)
  46
  47 (defcustom riece-eval-ignore-error nil
  48   "*If non-nil, an error is ignored."
  49   :type 'boolean
  50   :group 'riece-eval)
  51
  52 (defvar riece-eval-enabled nil)
  53
  54 (defconst riece-eval-description
  55   "Evaluate an input string as lisp object.")
  56
  57 (defun riece-eval-display-message-function (message)
  58   (when (and riece-eval-enabled
  59              (riece-message-own-p message)
  60              (string-match riece-eval-regexp (riece-message-text message)))
  61     (let ((form (substring (riece-message-text message) 2))
  62           object string)
  63       (condition-case err
  64           (progn
  65             (setq object (eval (read form)))
  66             (setq string
  67                   (cond
  68                    ((stringp object) object)
  69                    ((and (listp object)
  70                          (not (eq object nil)))
  71                     (let ((string (pp-to-string object)))
  72                       (substring string 0 (1- (length string)))))
  73                    ((numberp object)
  74                     (number-to-string object))
  75                    ((eq object nil) "")
  76                    (t (pp-to-string object)))))
  77         (error
  78          (unless riece-eval-ignore-error
  79              (setq string (format "Error evaluating %s: %s" form err)))))
  80       (unless (equal string "")
  81         (riece-send-string
  82          (format "NOTICE %s :%s\r\n"
  83                  (riece-identity-prefix (riece-message-target message))
  84                  string))
  85         (riece-display-message
  86          (riece-make-message (riece-current-nickname)
  87                              (riece-message-target message)
  88                              string 'notice))))))
  89
  90 (defun riece-eval-insinuate ()
  91   (add-hook 'riece-after-display-message-functions
  92             'riece-eval-display-message-function))
  93
  94 (defun riece-eval-enable ()
  95   (setq riece-eval-enabled t))
  96
  97 (defun riece-eval-disable ()
  98   (setq riece-eval-enabled nil))
  99
 100 (provide 'riece-eval)
 101
 102 ;;; riece-eval.el ends here