From 89a424521b753ee7c2c67ebdc957865657f647c4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Mon, 31 Oct 2005 16:16:54 +0000
Subject: Moved the STkLos and Bigloo code to `legacy'.

Moved the STkLos and Bigloo code from `src' to `legacy'.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
---
 src/bigloo/c.scm | 134 -------------------------------------------------------
 1 file changed, 134 deletions(-)
 delete mode 100644 src/bigloo/c.scm

(limited to 'src/bigloo/c.scm')

diff --git a/src/bigloo/c.scm b/src/bigloo/c.scm
deleted file mode 100644
index 07290ce..0000000
--- a/src/bigloo/c.scm
+++ /dev/null
@@ -1,134 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/src/bigloo/c.scm                     */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Mon Sep  1 12:08:39 2003                          */
-;*    Last change :  Thu May 27 10:11:24 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    C fontification                                                  */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    The module                                                       */
-;*---------------------------------------------------------------------*/
-(module skribe_c
-
-   (include "new.sch")
-   
-   (import  skribe_types
-	    skribe_lib
-	    skribe_resolve
-	    skribe_eval
-	    skribe_api
-	    skribe_param
-	    skribe_source)
-
-   (export  C))
-
-;*---------------------------------------------------------------------*/
-;*    C stamps                                                         */
-;*---------------------------------------------------------------------*/
-(define *keyword* (gensym))
-(define *cpp* (gensym))
-
-;*---------------------------------------------------------------------*/
-;*    C keywords                                                       */
-;*---------------------------------------------------------------------*/
-(for-each (lambda (symbol)
-	     (putprop! symbol *keyword* #t))
-	  '(for class template while return try catch break continue
-		do if else typedef struct union goto switch case
-		static extern default finally throw))
-(let ((sharp (string->symbol "#")))
-   (for-each (lambda (symbol)
-		(putprop! (symbol-append sharp symbol) *cpp* #t))
-	     '(include define if ifdef ifdef else endif)))
-
-;*---------------------------------------------------------------------*/
-;*    C ...                                                            */
-;*---------------------------------------------------------------------*/
-(define C 
-   (new language
-      (name "C")
-      (fontifier c-fontifier)
-      (extractor #f)))
-
-;*---------------------------------------------------------------------*/
-;*    c-fontifier ...                                                  */
-;*---------------------------------------------------------------------*/
-(define (c-fontifier s)
-   (let ((g (regular-grammar ()
-	       ((: "/*" (* (or (out #\*) (: (+ #\*) (out #\/ #\*))))
-			(+ #\*) "/")
-		;; bold comments
-		(let ((str (split-string-newline (the-string))))
-		   (append (map (lambda (s)
-				   (if (eq? s 'eol)
-				       "\n"
-				       (new markup
-					  (markup '&source-line-comment)
-					  (body s))))
-				str)
-			   (ignore))))
-	       ((: "//" (* all))
-		;; italic comments
-		(let ((c (new markup
-			    (markup '&source-comment)
-			    (body (the-string)))))
-		   (cons c (ignore))))
-	       ((+ (or #\Newline #\Space))
-		;; separators
-		(let ((str (the-string)))
-		   (cons str (ignore))))
-	       ((in "{}")
-		;; brackets
-		(let ((str (the-string)))
-		   (let ((c (new markup
-			       (markup '&source-bracket)
-			       (body (the-string)))))
-		      (cons c (ignore)))))
-	       ((+ (out #\; #\Space #\Tab #\Newline #\( #\) #\{ #\} #\[ #\] #\" #\< #\> #\= #\! #\/ #\/ #\+ #\* #\-))
-		;; keywords
-		(let* ((string (the-string))
-		       (symbol (the-symbol)))
-		   (cond
-		      ((getprop symbol *keyword*)
-		       (let ((c (new markup
-				   (markup '&source-keyword)
-				   (ident (symbol->string (gensym)))
-				   (body string))))
-			  (cons c (ignore))))
-		      ((getprop symbol *cpp*)
-		       (let ((c (new markup
-				   (markup '&source-module)
-				   (ident (symbol->string (gensym)))
-				   (body string))))
-			  (cons c (ignore))))
-		      (else
-		       (cons string (ignore))))))
-	       ((in "<>=!/\\+*-([])")
-		;; regular text
-		(let ((s (the-string)))
-		   (cons s (ignore))))
-	       ((: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
-		;; strings
-		(let ((str (split-string-newline (the-string))))
-		   (append (map (lambda (s)
-				   (if (eq? s 'eol)
-				       "\n"
-				       (new markup
-					  (markup '&source-string)
-					  (body s))))
-				str)
-			   (ignore))))
-	       ((+ (or #\; #\" #\# #\tab))
-		(let ((str (the-string)))
-		   (cons str (ignore))))
-	       (else
-		(let ((c (the-failure)))
-		   (if (eof-object? c)
-		       '()
-		       (error "source(C)" "Unexpected character" c)))))))
-      (read/rp g (open-input-string s))))
-
-- 
cgit v1.2.3