Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

291 lines (200 sloc) 6.439 kB
;;; erbc3.el ---erbot lisp stuff which should be PERSISTENT ACROSS SESSIONS.
;; Time-stamp: <2007-11-23 11:30:12 deego>
;; Copyright (C) 2003 D. Goel
;; Emacs Lisp Archive entry
;; Filename: erbc3.el
;; Package: erbc3
;; Author: D. Goel <deego@gnufans.org>
;; Keywords:
;; Version:
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot
;; For latest version:
(defconst erbc3-home-page
"http://gnufans.net/~deego")
;; This file is NOT (yet) part of GNU Emacs.
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(defconst erbc3-version "0.dev")
(defun erbc3-version (&optional arg)
"Display erbc3's version string.
With prefix ARG, insert version string into current buffer at point."
(interactive "P")
(if arg
(insert (message "erbc3 version %s" erbc3-version))
(message "erbc3 version %s" erbc3-version)))
;;==========================================
;;; Requires:
(eval-when-compile (require 'cl))
;;; Code:
(defgroup erbc3 nil
"The group erbc3."
:group 'applications)
(defcustom erbc3-before-load-hook nil
"Hook to run before loading erbc3."
:group 'erbc3)
(defcustom erbc3-after-load-hook nil
"Hook to run after loading erbc3."
:group 'erbc3)
(run-hooks 'erbc3-before-load-hook)
;;; Real Code:
;; pf stands for persistent functions.
;; pv stands for persistent variables.
(defvar erbn-pf-file "~/public_html/data/userfunctions.el")
(defvar erbn-pv-file "~/public_html/data/uservariables.el")
(defun fsi-pfpv-load ()
(fsi-pf-load)
(fsi-pv-load))
(defun fsi-pf-load ()
(if (file-exists-p erbn-pf-file)
(fsi-ignore-errors-else-string (load erbn-pf-file))
(message "File does not exist: %s" erbn-pf-file)))
(defun fsi-pv-load ()
(when (file-exists-p erbn-pv-file)
(ignore-errors (load erbn-pv-file))))
(defun fsi-user-function-p (fcn)
(member
fcn
(erbutils-functions-in-file erbn-pf-file)))
(defun erbn-create-defun-new (sexps body)
(cons body sexps))
(defun erbn-create-defun-overwrite (sexps body fcn)
(cons body
(remove
(first (member-if
(lambda (arg) (equal (second arg) fcn))
sexps))
sexps)))
(defun erbn-write-sexps-to-file (file sexps &optional backup-rarity)
(unless backup-rarity (setq backup-rarity 1))
(when (zerop (random backup-rarity)) (erbutils-mkback-maybe file))
(find-file file)
(widen)
(delete-region (point-min) (point-max))
(insert "\n\n\n")
(insert
(mapconcat
(lambda (arg) (pp-to-string arg)) sexps "\n\n\n"))
(insert "\n\n\n")
(save-buffer))
(defvar erbn-tmp-sexps)
(defvar erbn-tmp-newbody)
(defun fsi-pv-get-variables-values ()
(let
((vars
(apropos-internal "^fs-" 'boundp)))
(mapcar
(lambda (v)
`(ignore-errors
(defvar ,v
(quote ,(eval v)))))
vars)))
(defcustom fs-pv-save-rarity 100000
"if this is 1000, then file is saved one in a thousand times... ")
;;;###autoload
(defun fsi-pv-save ()
(interactive)
(erbn-write-sexps-to-file
erbn-pv-file
(fs-pv-get-variables-values) 1000))
;; this should lead to a few saves every day... not too many, one hopes..
;;1000))
(defun erbn-readonly-check (sym)
(if (get sym 'readonly)
(error "The symbol %S can't be redefined or set! It is read-only!"
sym)))
(defmacro fsi-defun (fcn args &rest body)
;; the given fcn icould be a number or string, in which
;; case sandboxing won't touch it, so we need to override that case.
(let ((docp nil))
(unless
(and (listp body)
(> (length body) 0))
(error "Function body should have a length of 1 or more"))
(unless (and (symbolp fcn) (not (fsi-constant-object-p fcn)))
(error "Defun symbols only! :P"))
;; doc string exists, and is followed by more stuff..
(when (and (> (length body) 1)
(stringp (first body)))
(setq docp t))
(erbn-readonly-check fcn)
(erbn-write-sexps-to-file
erbn-pf-file
(erbn-create-defun-overwrite
(erbutils-file-sexps erbn-pf-file)
(if docp
(cons 'defun
(cons fcn
(cons args
(cons
(first body)
(cons
`(erblisp-check-args ,@args)
(cons
'(sit-for 0)
(cdr body)))))))
(cons 'defun
(cons fcn
(cons args
(cons
`(erblisp-check-args ,@args)
(cons
'(sit-for 0)
body))))))
fcn))
(fsi-pf-load)
`(quote ,fcn)))
(defun fsi-defalias (sym1 sym2)
(eval `(fsi-defun
,(erblisp-sandbox-quoted sym1) (&rest fs-bar)
(fs-apply (quote ,(erblisp-sandbox-quoted sym2)) fs-bar))))
(defun fsi-makunbound (&optional sym)
(unless sym (error "Syntax: , (makunbound 'symbol)"))
(setq sym
(erblisp-sandbox sym))
(makunbound sym))
(defun fsi-fmakunbound (&optional sym)
(unless sym (error "Syntax: , (fmakunbound 'symbol)"))
(setq sym
(erblisp-sandbox sym))
(erbn-readonly-check sym)
(let
;; this is to be returned..
((result (fmakunbound sym))
(sexps (erbutils-file-sexps erbn-pf-file)))
;; now we want to remove any definition of sym from the user
;; file:
(erbn-write-sexps-to-file
erbn-pf-file
(remove
(first
(member-if
(lambda (arg) (equal (second arg) sym))
sexps))
sexps))
(fsi-pf-load)
result))
(defvar erbn-tmpsetq nil)
(defmacro fsi-setq (&rest args)
`(let ((erbn-tmpsetq
(setq ,@args)))
(fs-pv-save)
erbn-tmpsetq))
(defun fsi-constant-object-p (object)
"If the object is a symbol like nil or t, a symbol that cannot be
redefunned, return true. "
(or (member object (list nil t))
(keywordp object)))
(erbutils-defalias-i '(type-of))
(provide 'erbc3)
(run-hooks 'erbc3-after-load-hook)
;;; erbc3.el ends here
Jump to Line
Something went wrong with that request. Please try again.