summaryrefslogtreecommitdiff
path: root/legacy/bigloo/api.sch
diff options
context:
space:
mode:
authorLudovic Court`es2005-11-02 10:08:38 +0000
committerLudovic Court`es2005-11-02 10:08:38 +0000
commitb76d5e1b252967521f210eac10ddbf089dde8c6a (patch)
tree00fc81c51256991c04799d79a749bbdd5b9fad30 /legacy/bigloo/api.sch
parentba63b8d4780428d9f63f6ace7f49361b77401112 (diff)
parentf553cb65b157b6df9563cefa593902d59301461b (diff)
downloadskribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.gz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.lz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.zip
Cleaned up the source tree and the installation process.
Patches applied: * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-6 Cosmetic changes. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7 Removed useless files, integrated packages. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-8 Removed useless files, integrated packages. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9 Moved the STkLos and Bigloo code to `legacy'. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10 Installed Autoconf/Automake machinery. Fixed a few things. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-11 Changes related to source-highlighting and to the manual. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10
Diffstat (limited to 'legacy/bigloo/api.sch')
-rw-r--r--legacy/bigloo/api.sch91
1 files changed, 91 insertions, 0 deletions
diff --git a/legacy/bigloo/api.sch b/legacy/bigloo/api.sch
new file mode 100644
index 0000000..390b8fa
--- /dev/null
+++ b/legacy/bigloo/api.sch
@@ -0,0 +1,91 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/api.sch */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Jul 21 18:15:25 2003 */
+;* Last change : Wed Oct 27 12:43:23 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Bigloo macros for the API implementation */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* define-pervasive-macro ... */
+;*---------------------------------------------------------------------*/
+(define-macro (define-pervasive-macro proto . body)
+ `(begin
+ (eval '(define-macro ,proto ,@body))
+ (define-macro ,proto ,@body)))
+
+;*---------------------------------------------------------------------*/
+;* define-markup ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-markup proto . body)
+ (define (s2k symbol)
+ (string->keyword (string-append ":" (symbol->string symbol))))
+ (if (not (pair? proto))
+ (error 'define-markup "Illegal markup definition" proto)
+ (let* ((id (car proto))
+ (args (cdr proto))
+ (dargs (dsssl-formals->scheme-formals args error)))
+ `(begin
+ ,(if (and (memq #!key args)
+ (memq '&skribe-eval-location args))
+ `(define-expander ,id
+ (lambda (x e)
+ (append
+ (cons ',id (map (lambda (x) (e x e)) (cdr x)))
+ (list :&skribe-eval-location
+ '(skribe-eval-location)))))
+ #unspecified)
+ (define ,(cons id dargs)
+ ,(make-dsssl-function-prelude proto
+ args `(begin ,@body)
+ error s2k))))))
+
+;*---------------------------------------------------------------------*/
+;* define-simple-markup ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-simple-markup markup)
+ `(define-markup (,markup #!rest opts #!key ident class loc)
+ (new markup
+ (markup ',markup)
+ (ident (or ident (symbol->string (gensym ',markup))))
+ (loc loc)
+ (class class)
+ (required-options '())
+ (options (the-options opts :ident :class :loc))
+ (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* define-simple-container ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-simple-container markup)
+ `(define-markup (,markup #!rest opts #!key ident class loc)
+ (new container
+ (markup ',markup)
+ (ident (or ident (symbol->string (gensym ',markup))))
+ (loc loc)
+ (class class)
+ (required-options '())
+ (options (the-options opts :ident :class :loc))
+ (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* define-processor-markup ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-processor-markup proc)
+ `(define-markup (,proc #!rest opts)
+ (new processor
+ (engine (find-engine ',proc))
+ (body (the-body opts))
+ (options (the-options opts)))))
+
+;*---------------------------------------------------------------------*/
+;* new (at runtime) */
+;*---------------------------------------------------------------------*/
+(eval '(define-macro (new id . inits)
+ (cons (symbol-append 'new- id)
+ (map (lambda (i)
+ (list 'list (list 'quote (car i)) (cadr i)))
+ inits))))