Permalink
Browse files

Relative loads for Emacs Lisp files. Adds functions __FILE__ and

load-relative.
  • Loading branch information...
rocky committed Nov 9, 2009
0 parents commit 75cbd6499d3f85d38e210b1f4c5fe231cb99ce51
Showing with 414 additions and 0 deletions.
  1. +16 −0 .gitignore
  2. +1 −0 AUTHORS
  3. +33 −0 Makefile.am
  4. 0 NEWS
  5. +19 −0 README
  6. +2 −0 autogen.sh
  7. +13 −0 configure.ac
  8. +28 −0 load-relative.el
  9. +2 −0 test/.gitignore
  10. +7 −0 test/Makefile
  11. +266 −0 test/behave.el
  12. +1 −0 test/load-file1.el
  13. +1 −0 test/load-file2.el
  14. +1 −0 test/load-file3.el
  15. +24 −0 test/test-load.el
@@ -0,0 +1,16 @@
+/*.elc
+/*~
+/COPYING
+/INSTALL
+/Makefile
+/Makefile.in
+/aclocal.m4
+/autom4te.cache
+/config.log
+/config.status
+/configure
+/elc-stamp
+/elc-temp
+/elisp-comp
+/install-sh
+/missing
@@ -0,0 +1 @@
+rockyb@rubyforge.org
@@ -0,0 +1,33 @@
+lisp_files := $(wildcard *.el)
+test_files := $(wildcard test/test-*.el)
+
+EXTRA_DIST = $(lisp_files) $(test_files) test/behave.el
+
+CHECK_FILES = $(notdir $(test_files:.el=.run))
+
+lisp_LISP = $(lisp_files)
+
+check: $(CHECK_FILES)
+
+
+# FIGURE out how to DRY the run rules.
+test-load.run:
+ (cd $(srcdir)/test && $(EMACS) -batch -Q -l $(@:.run=.el) )
+
+.PHONY: $(CHECK_FILES)
+
+if MAINTAINER_MODE
+
+CL = ChangeLog
+ChangeLog:
+ git log --pretty --numstat --summary | $(GIT2CL) > $@
+
+ACLOCAL_AMFLAGS=-I .
+
+endif
+
+test: check
+
+
+
+
0 NEWS
No changes.
19 README
@@ -0,0 +1,19 @@
+Here we add two functions load-relative and __FILE__
+
+load-relative(symbol) loads an Emacs Lisp file relative to another
+(presumably currently running) Emacs Lisp file.
+
+Example:
+
+(provide 'foo-bar)
+(load-relative "baz" 'foo-bar)
+
+__FILE__(symbol) returns the file that symbol was defined it, however
+if you are currently running load, that file name is given instead.
+If symbol is not defined and you are not loading a file, then nil is
+returned.
+
+The symbol parameter is an artifact in both load-relative and __FILE__
+that I would like to remove. Right now I don't see how to.
+
+
@@ -0,0 +1,2 @@
+#!/bin/sh
+autoreconf -i
@@ -0,0 +1,13 @@
+AC_INIT(emacs-load-relaitve, 0.01vc,)
+AC_CONFIG_SRCDIR(load-relative.el)
+AM_INIT_AUTOMAKE
+AM_MAINTAINER_MODE
+
+##
+## Find out where to install the debugger emacs lisp files
+##
+AM_PATH_LISPDIR
+AM_CONDITIONAL(INSTALL_EMACS_LISP, test "x$lispdir" != "x")
+
+AC_CONFIG_FILES([Makefile])
+AC_OUTPUT
@@ -0,0 +1,28 @@
+(provide 'load-relative)
+(defun __FILE__ (symbol)
+ "Return the string name of file of the currently running Emacs Lisp program,
+or nil.
+
+SYMBOL should be some symbol defined in the file, but it is not
+used if Emacs is currently running `load' of a file. The simplest
+thing to do is call `provide' prior to this and use the value
+given for that for SYMBOL. For example:
+ (provide 'something)
+ (__FILE__ 'something)
+"
+ (cond
+ (load-file-name)
+ ((symbol-file symbol))
+ (t nil)))
+
+(defun load-relative (file symbol)
+ "Load an Emacs Lisp file relative to some other currently loaded Emacs
+Lisp file.
+
+FILE is Emacs Lisp file you want to load, and SYMBOL should a symbol define
+another Emacs Lisp file that you want FILE loaded relative to. If this is
+called inside a `load', then SYMBOL is ignored and `load-file-name' is
+used instead."
+ (let ((prefix (file-name-directory (or (__FILE__ symbol) "./"))))
+ (load (concat prefix file))))
+
@@ -0,0 +1,2 @@
+/*~
+/Makefile
@@ -0,0 +1,7 @@
+# Whatever it is you want to do, it should be forwarded to the
+# to top-level irectories
+PHONY=check all
+all: check
+
+%:
+ $(MAKE) -C .. $@
@@ -0,0 +1,266 @@
+;;; behave.el --- Emacs Lisp Behaviour-Driven Development framework
+;;; Some changes have been made by rocky
+
+;; Copyright (C) 2007 Phil Hagelberg
+
+;; Author: Phil Hagelberg
+;; URL: http://dev.technomancy.us/wiki/behave.el
+;; Created: 19 Jan 2007
+;; Version: 0.1
+;; Keywords: bdd specification specs
+
+;; This file is NOT 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 file 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 Emacs; see the file COPYING, or type `C-h C-c'. If not,
+;; write to the Free Software Foundation at this address:
+
+;; Free Software Foundation
+;; 51 Franklin Street, Fifth Floor
+;; Boston, MA 02110-1301
+;; USA
+
+;;; Commentary:
+
+;; behave.el allows you to write executable specifications for your
+;; Emacs Lisp code. Executable specifications allow you to check that
+;; your code is working correctly in an automated fashion that you can
+;; use to drive the focus of your development. (It's related to
+;; Test-Driven Development.) You can read up on it at
+;; http://behaviour-driven.org.
+
+;; Specifications and contexts both must have docstrings so that when
+;; the specifications aren't met it is easy to see what caused the
+;; failure. Each specification should live within a context. In each
+;; context, you can set up relevant things to test, such as necessary
+;; buffers or data structures. (Be sure to use lexical-let for setting
+;; up the variables you need--since the specify macro uses lambdas,
+;; closures will be made for those variables.) Everything within the
+;; context is executed normally.
+
+;; Each context can be tagged with the TAG form. This allows you to
+;; group your contexts by tags. When you execute the specs, M-x behave
+;; will ask you to give some tags, and it will execute all contexts
+;; that match those tags.
+
+;; When you want to run the specs, evaluate them and press M-x
+;; behave. Enter the tags you want to run (or "all"), and they will be
+;; executed with results in the *behave* buffer. You can also do M-x
+;; specifications to show a list of all the specified behaviours of
+;; the code.
+
+;;; Implementation
+
+;; Contexts are stored in the *behave-contexts* list as structs. Each
+;; context has a "specs" slot that contains a list of its specs, which
+;; are stored as closures. The expect form ensures that expectations
+;; are met and signals behave-spec-failed if they are not.
+
+;; Warning: the variables CONTEXT and SPEC-DESC are used within macros
+;; in such a way that they could shadow variables of the same name in
+;; the code being tested. Future versions will use gensyms to solve
+;; this issue, but in the mean time avoid relying upon variables with
+;; those names.
+
+;;; To do:
+
+;; See open tickets on my Trac:
+;; [Rocky: the below link is defunct]
+;; http://dev.technomancy.us/phil/query?status=new&status=assigned&status=reopened&component=behave&order=priority
+
+;; Main issues: more expect predicates
+
+;;; Usage:
+
+;; See meta.el for specifications for behave.el. Evaluate meta.el and
+;; M-x specifications meta RET to see the specifications explained.
+
+(eval-when-compile (require 'cl))
+(require 'cl)
+
+(defvar *behave-contexts* '()
+ "A list of contexts and their specs.")
+
+(defvar *behave-default-tags* "all")
+
+(defstruct context
+ (description :type string "Description not set yet")
+ tags
+ (specs '()) ;; list of its specifications stored as closures.
+ refreshing-vars)
+
+(put 'behave-spec-failed 'error-conditions '(failure))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Core Macros
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro context (description &rest body)
+ "Defines a context for specifications to run in."
+ (setq *behave-contexts* (delete (context-find description) *behave-contexts*))
+ `(lexical-let ((context (make-context)))
+ (setf (context-description context) ,description)
+ (add-to-list '*behave-contexts* context)
+ ,@body))
+
+(defmacro specify (description &rest body)
+ "Add a specification and its description to the current context."
+ `(push (lambda () ,description
+ (let ((spec-desc ,description))
+ ,@body)) (context-specs context)))
+
+(defmacro tag (&rest tags)
+ "Give a context tags for easy reference. (Must be used within a context.)"
+ `(setf (context-tags context)
+ (append '(,@tags) (context-tags context))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Assertion tests
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun assert-equal (expected actual &optional opt-fail-message)
+ "expectation is that ACTUAL should be equal to EXPECTED."
+ (if (not (equal actual expected))
+ (let* ((fail-message
+ (if opt-fail-message
+ (format "\n\tMessage: %s" opt-fail-message)
+ ""))
+ (context-mess
+ (if (boundp 'context)
+ (context-description context)
+ "unset")))
+ (signal 'behave-spec-failed
+ (format
+ "Context: %s%s\n\tSpecification: %s\n\tExpected: %s\n\tGot: %s"
+ context-mess
+ fail-message spec-desc expected actual))))
+ t)
+
+(defun assert-t (actual &optional opt-fail-message)
+ "expectation is that ACTUAL is t."
+ (assert-nil (not actual)))
+
+(defun assert-nil (actual &optional opt-fail-message)
+ "expectation is that ACTUAL is nil."
+ (if actual
+ (let* ((fail-message
+ (if opt-fail-message
+ (format "\n\tMessage: %s" opt-fail-message)
+ ""))
+ (context-mess
+ (if (boundp 'context)
+ (context-description context)
+ "unset")))
+ (signal 'behave-spec-failed
+ (format
+ "Context: %s%s\n\tSpecification: %s"
+ context-mess fail-message spec-desc))))
+ t)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Context-management
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun behave-clear-contexts ()
+ (interactive)
+ (setq *behave-contexts* '())
+ (message "Behave: contexts cleared"))
+
+(defun context-find (description)
+ "Find a context by its description."
+ (find description *behave-contexts*
+ :test (lambda (description context) (equal description (context-description context)))))
+
+(defun context-find-by-tag (tag)
+ (remove-if (lambda (context) (not (find tag (context-tags context))))
+ *behave-contexts*))
+
+(defun context-find-by-tags (tags)
+ (if (find 'all tags)
+ *behave-contexts*
+ (delete nil (remove-duplicates (mapcan 'context-find-by-tag tags)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Execution
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun behave (&optional tags)
+ "Execute all contexts that match given tags"
+ (interactive)
+ (let ((tags-string (or tags (read-string (concat "Execute specs matching these tags (default " *behave-default-tags* "): ")
+ nil nil *behave-default-tags*)))
+ (start-time (cadr (current-time)))
+ (failures nil)
+ (spec-count 0))
+ (setq *behave-default-tags* tags-string) ; update default for next time
+ (with-output-to-temp-buffer "*behave*"
+ (princ (concat "Running specs tagged \"" tags-string "\":\n\n"))
+ (dolist (context (context-find-by-tags (mapcar 'intern (split-string tags-string " "))))
+ (execute-context context))
+ (behave-describe-failures failures start-time))
+ (if noninteractive
+ (progn
+ (switch-to-buffer "*behave*")
+ (message "%s" (buffer-substring (point-min) (point-max)))))
+ (length failures)))
+
+(defun execute-context (context)
+ (condition-case failure
+ (mapcar #'execute-spec (reverse (context-specs context)))
+ (error (princ "E")
+ (switch-to-buffer "*behave*")
+ (overlay-put (make-overlay (point) (- (point) 1)) 'face '(foreground-color . "red"))
+ (switch-to-buffer nil)
+ (add-to-list 'failures (list "Error:" failure) t))
+ (failure (princ "F")
+ (switch-to-buffer "*behave*")
+ (overlay-put (make-overlay (point) (- (point) 1)) 'face '(foreground-color . "red"))
+ (switch-to-buffer nil)
+ (add-to-list 'failures (cdr failure) t))))
+
+(defun execute-spec (spec)
+ (incf spec-count)
+ (funcall spec)
+ (princ "."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Reporting
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun behave-describe-failures (failures start-time)
+ (princ (concat "\n\n" (number-to-string (length failures)) " problem" (unless (= 1 (length failures)) "s") " in "
+ (number-to-string spec-count)
+ " specification" (unless (= 1 spec-count) "s")
+ ". (" (number-to-string (- (cadr (current-time)) start-time)) " seconds)\n\n"))
+ (dolist (failure failures)
+ (behave-report-result failure)))
+
+(defun behave-report-result (failure)
+ (princ failure)
+ (princ "\n\n"))
+
+(defun specifications (&optional tags)
+ "Show specifications for all contexts that match given tags"
+ (interactive)
+ (let ((tags-string (or tags (read-string (concat "Show specs matching these tags (default " *behave-default-tags* "): ")
+ nil nil *behave-default-tags*))))
+ (with-output-to-temp-buffer "*behave*"
+ (princ "Specifications:\n")
+ (mapcar #'specify-context (context-find-by-tags (mapcar 'intern (split-string tags-string " ")))))))
+
+(defun specify-context (context)
+ (princ (concat "\n" (context-description context) "...\n"))
+ (dolist (spec (context-specs context))
+ (princ (concat " * " (caddr spec) "\n"))))
+
+(provide 'behave)
@@ -0,0 +1 @@
+(setq loaded-file "load-file1")
Oops, something went wrong.

0 comments on commit 75cbd64

Please sign in to comment.