summaryrefslogtreecommitdiff
path: root/legacy/bigloo/c.scm
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/c.scm
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/c.scm')
-rw-r--r--legacy/bigloo/c.scm134
1 files changed, 134 insertions, 0 deletions
diff --git a/legacy/bigloo/c.scm b/legacy/bigloo/c.scm
new file mode 100644
index 0000000..07290ce
--- /dev/null
+++ b/legacy/bigloo/c.scm
@@ -0,0 +1,134 @@
+;*=====================================================================*/
+;* 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))))
+