about summary refs log tree commit diff
path: root/src/guile/skribilo/coloring/lisp.scm
diff options
context:
space:
mode:
authorLudovic Courtes2006-01-18 23:22:29 +0000
committerLudovic Courtes2006-01-18 23:22:29 +0000
commit8bdcb386f3ce26a9031ca123b4d43af0b5a3721a (patch)
tree49d12a11c44138755cb93fbfbf11a436128828f0 /src/guile/skribilo/coloring/lisp.scm
parent72c195ec8923ca616648ccf64b002a80bcda1415 (diff)
downloadskribilo-8bdcb386f3ce26a9031ca123b4d43af0b5a3721a.tar.gz
skribilo-8bdcb386f3ce26a9031ca123b4d43af0b5a3721a.tar.lz
skribilo-8bdcb386f3ce26a9031ca123b4d43af0b5a3721a.zip
More fixes in the hope to get the manual compiled.
* doc/skr/api.skr (define-markup?): Accept `define-public'.
  (define-markup-options): Accept any kind of `define' symbol.
  (define-markup-rest): Likewise.

* doc/user/bib.skb (bibliography): Use `src/bib1.sbib'.
  (bib-table?): Provide a definition.
  (default-bib-table): Likewise.
  (make-bib-table): Likewise.
  (bibliography): Fixed a `ref'.
  (example): Fixed file name.  This example does not work yet.

* doc/user/footnote.skb (footnote): Documented `label', removed
  `number'.

* doc/user/table.skb (th): Documented `rowspan'.

* src/guile/skribilo.scm (skribilo-options): Added `-S'/`--source-path'.
  Honor it.

* src/guile/skribilo/coloring/lisp.scm: Use `(ice-9 match)'.  Rewrote all
  the `match-case' code into corresponding `match' statements.
  (definition-search): Fixed, using `source-property' and `port-line'.
  Does not work yet due to a bug in guile-reader's source position
  recording (shows 1 line earlier).  Added a READ parameter.

* src/guile/skribilo/skribe/api.scm: Mark SYMBOL as replaced instead of
  blindly overriding the core binding.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-28
Diffstat (limited to 'src/guile/skribilo/coloring/lisp.scm')
-rw-r--r--src/guile/skribilo/coloring/lisp.scm96
1 files changed, 51 insertions, 45 deletions
diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm
index 589e70a..33ecc48 100644
--- a/src/guile/skribilo/coloring/lisp.scm
+++ b/src/guile/skribilo/coloring/lisp.scm
@@ -30,6 +30,7 @@
   :use-module (skribilo source)
   :use-module (skribilo lib)
   :use-module (skribilo runtime)
+  :use-module (ice-9 match)
   :autoload   (skribilo reader)  (make-reader)
   :export (skribe scheme stklos bigloo lisp))
 
@@ -48,14 +49,16 @@
 ;;;
 ;;; DEFINITION-SEARCH
 ;;;
-(define (definition-search inp tab test)
-  (let Loop ((exp (%read inp)))
+(define (definition-search inp read tab def?)
+  (let Loop ((exp (read inp)))
     (unless (eof-object? exp)
-      (if (test exp)
-	  (let ((start (and (%epair? exp) (%epair-line exp)))
-		(stop  (port-current-line inp)))
-	    (source-read-lines (port-file-name inp) start stop tab))
-	  (Loop (%read inp))))))
+      (if (def? exp)
+	  (let ((start (and (pair? exp) (source-property exp 'line)))
+		(stop  (port-line inp)))
+	    (format (current-error-port) "READ-LINES: `~a' ~a->~a~%"
+		    exp start stop)
+	    (source-read-lines (port-filename inp) start stop tab))
+	  (Loop (read inp))))))
 
 
 (define (lisp-family-fontifier s read)
@@ -75,15 +78,15 @@
 (define (lisp-extractor iport def tab)
   (definition-search
     iport
+    read
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or defun defmacro) ?fun ?- . ?-)
-		(and (eq? def fun) exp))
-	 ((defvar ?var . ?-)
-		(and (eq? var def) exp))
-	 (else
-		#f)))))
+      (match exp
+	 (((or 'defun 'defmacro) fun _ . _)
+	  (and (eq? def fun) exp))
+	 (('defvar var . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
 
 (define (init-lisp-keys)
   (unless *lisp-keys*
@@ -117,15 +120,15 @@
 (define (scheme-extractor iport def tab)
   (definition-search
     iport
+    %skribilo-module-reader
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or define define-macro) (?fun . ?-) . ?-)
-	     (and (eq? def fun) exp))
-	 ((define (and (? symbol?) ?var) . ?-)
-	     (and (eq? var def) exp))
-	 (else
-	     #f)))))
+      (match exp
+	 (((or 'define 'define-macro) (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (('define (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
 
 
 (define (init-scheme-keys)
@@ -161,14 +164,15 @@
 (define (stklos-extractor iport def tab)
   (definition-search
     iport
+    %skribilo-module-reader
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or define define-generic define-method define-macro)
-	   (?fun . ?-) . ?-)
-		(and (eq? def fun) exp))
-	 (((or define define-module) (and (? symbol?) ?var) . ?-)
-		(and (eq? var def) exp))
+      (match exp
+	 (((or 'define 'define-generic 'define-method 'define-macro)
+	   (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (((or 'define 'define-module) (? symbol? var) . _)
+	  (and (eq? var def) exp))
 	 (else
 		#f)))))
 
@@ -214,17 +218,18 @@
 (define (skribe-extractor iport def tab)
   (definition-search
     iport
+    (make-reader 'skribe)
     tab
     (lambda (exp)
-      (match-case exp
-	(((or define define-macro define-markup) (?fun . ?-) . ?-)
-	   (and (eq? def fun) exp))
-	((define (and (? symbol?) ?var) . ?-)
-	   (and (eq? var def) exp))
-	((markup-output (quote ?mk) . ?-)
-	   (and (eq? mk def) exp))
-	(else
-	   #f)))))
+      (match exp
+	(((or 'define 'define-macro 'define-markup 'define-public)
+	  (fun . _) . _)
+	 (and (eq? def fun) exp))
+	(('define (? symbol? var) . _)
+	 (and (eq? var def) exp))
+	(('markup-output (quote mk) . _)
+	 (and (eq? mk def) exp))
+	(else #f)))))
 
 
 (define (init-skribe-keys)
@@ -275,17 +280,18 @@
 (define (bigloo-extractor iport def tab)
   (definition-search
     iport
+    %skribilo-module-reader
     tab
     (lambda (exp)
-      (match-case exp
-	 (((or define define-inline define-generic
-	       define-method define-macro define-expander)
-	   (?fun . ?-) . ?-)
-		(and (eq? def fun) exp))
-	 (((or define define-struct define-library) (and (? symbol?) ?var) . ?-)
-		(and (eq? var def) exp))
-	 (else
-		#f)))))
+      (match exp
+	 (((or 'define 'define-inline 'define-generic
+	       'define-method 'define-macro 'define-expander)
+	   (fun . _) . _)
+	  (and (eq? def fun) exp))
+	 (((or 'define 'define-struct 'define-library)
+	   (? symbol? var) . _)
+	  (and (eq? var def) exp))
+	 (else #f)))))
 
 (define bigloo
   (new language