From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
---
 skribe/src/bigloo/asm.scm | 99 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 skribe/src/bigloo/asm.scm

(limited to 'skribe/src/bigloo/asm.scm')

diff --git a/skribe/src/bigloo/asm.scm b/skribe/src/bigloo/asm.scm
new file mode 100644
index 0000000..03196ac
--- /dev/null
+++ b/skribe/src/bigloo/asm.scm
@@ -0,0 +1,99 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/bigloo/asm.scm                   */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Mon Sep  1 12:08:39 2003                          */
+;*    Last change :  Tue Jan 20 06:07:44 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    ASM fontification                                                */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    The module                                                       */
+;*---------------------------------------------------------------------*/
+(module skribe_asm
+
+   (include "new.sch")
+   
+   (import  skribe_types
+	    skribe_lib
+	    skribe_resolve
+	    skribe_eval
+	    skribe_api
+	    skribe_param
+	    skribe_source)
+
+   (export  asm))
+
+;*---------------------------------------------------------------------*/
+;*    asm ...                                                          */
+;*---------------------------------------------------------------------*/
+(define asm
+   (new language
+      (name "asm")
+      (fontifier asm-fontifier)
+      (extractor #f)))
+
+;*---------------------------------------------------------------------*/
+;*    asm-fontifier ...                                                */
+;*---------------------------------------------------------------------*/
+(define (asm-fontifier s)
+   (let ((g (regular-grammar ()
+	       ((: "/*" (* (or (out #\*) (: (+ #\*) (out #\/ #\*))))
+			(+ #\*) "/")
+		;; bold comments
+		(let ((c (new markup
+			    (markup '&source-line-comment)
+			    (body (the-string)))))
+		   (cons c (ignore))))
+	       ((: "//" (* all))
+		;; italic comments
+		(let ((c (new markup
+			    (markup '&source-comment)
+			    (body (the-string)))))
+		   (cons c (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 #\tab #\space))
+		   (+ (out #\: #\Space #\Tab #\Newline)) #\:)
+		;; labels
+		(let ((c (new markup
+			    (markup '&source-define)
+			    (body (the-string)))))
+		   (cons c (ignore))))
+	       ((or (in "<>=!/\\+*-([])")
+		    #\/
+		    (+ (out #\; #\Space #\Tab #\Newline #\( #\) #\[ #\] #\" #\< #\> #\= #\! #\/ #\/ #\+ #\* #\-)))
+		;; 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(asm)" "Unexpected character" c)))))))
+      (read/rp g (open-input-string s))))
+
-- 
cgit v1.2.3