From 42e397a7d41c5e71e783e0033b5171b933595588 Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Sun, 4 Dec 2005 21:20:44 +0000
Subject: Added the `~' markup.  Added SRFI-62 and SRFI-30 support to the
 Skribe reader.

* NEWS: Added actual news.

* src/guile/skribilo/skribe/api.scm (~): New markup.

* src/guile/skribilo/engine/html.scm: Added a writer for `~'.

* src/guile/skribilo/engine/latex.scm: Likewise.

* src/guile/skribilo/engine/lout.scm: Likewise.

* src/guile/skribilo/evaluator.scm (skribe-include): Added a `:reader'
  argument.

* src/guile/skribilo/reader/skribe.scm (*skribe-reader*): Renamed to
  `%skribe-reader'.
  (%make-skribe-reader): Moved the sharp reader code to...
  (&sharp-reader): ... here.  Added support for SRFI-62 and SRFI-30
  (Bigloo supports both).

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-16
---
 src/guile/skribilo/engine/html.scm   |  8 ++++++
 src/guile/skribilo/engine/latex.scm  |  6 ++--
 src/guile/skribilo/engine/lout.scm   |  4 +--
 src/guile/skribilo/evaluator.scm     |  8 ++++--
 src/guile/skribilo/reader/skribe.scm | 56 +++++++++++++++++++-----------------
 src/guile/skribilo/skribe/api.scm    | 16 ++++++++++-
 6 files changed, 62 insertions(+), 36 deletions(-)

(limited to 'src')

diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 01708c8..b5c7a55 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -1410,6 +1410,14 @@
 	      ((html-markup-class "p") n e))
    :after "</p>")
 
+;*---------------------------------------------------------------------*/
+;*    ~ ...                                                            */
+;*---------------------------------------------------------------------*/
+(markup-writer '~
+   :before "&nbsp;"
+   :after #f
+   :action #f)
+
 ;*---------------------------------------------------------------------*/
 ;*    footnote ...                                                     */
 ;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm
index 2a59b4f..90e32cf 100644
--- a/src/guile/skribilo/engine/latex.scm
+++ b/src/guile/skribilo/engine/latex.scm
@@ -478,9 +478,9 @@
 	     colors))
 
 ;*---------------------------------------------------------------------*/
-;*    &~ ...                                                           */
+;*    ~ ...                                                           */
 ;*---------------------------------------------------------------------*/
-(markup-writer '&~
+(markup-writer '~
    :before "~"
    :action #f)
 
@@ -1468,7 +1468,7 @@
 		 (if t
 		     (begin
 			(output t e)
-			(output "~" e (markup-writer-get '&~ e))))))
+			(output "~" e (markup-writer-get '~ e))))))
    :after (lambda (n e)
 	     (let* ((c (handle-ast (markup-body n)))
 		    (id (markup-ident c)))
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index 6d3dbfa..1ae5cd0 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -941,9 +941,9 @@
 			   (list r g b)))))))
 
 ;*---------------------------------------------------------------------*/
-;*    &~ ...                                                           */
+;*    ~ ...                                                           */
 ;*---------------------------------------------------------------------*/
-(markup-writer '&~ :before "~" :action #f)
+(markup-writer '~ :before "~" :action #f)
 
 (define (lout-page-orientation orientation)
   ;; Return a string representing the Lout page orientation name for symbol
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index e4ef208..5af52aa 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -158,7 +158,9 @@
 ;;;
 ;;; SKRIBE-INCLUDE
 ;;;
-(define* (skribe-include file :optional (path (*document-path*)))
+(define* (skribe-include file :key (path (*document-path*))
+			           (reader %default-reader))
+  ;; FIXME: We should default to `*skribilo-current-reader*'.
   (unless (every string? path)
     (skribe-error 'skribe-include "illegal path" path))
 
@@ -172,11 +174,11 @@
 
     (with-input-from-file path
       (lambda ()
-	(let Loop ((exp (%default-reader (current-input-port)))
+	(let Loop ((exp (reader (current-input-port)))
 		   (res '()))
 	  (if (eof-object? exp)
 	      (if (and (pair? res) (null? (cdr res)))
 		    (car res)
 		    (reverse! res))
-	      (Loop (%default-reader (current-input-port))
+	      (Loop (reader (current-input-port))
 		    (cons (%evaluate exp) res))))))))
diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm
index 5c71cc1..410ef01 100644
--- a/src/guile/skribilo/reader/skribe.scm
+++ b/src/guile/skribilo/reader/skribe.scm
@@ -44,37 +44,39 @@
 the Skribe syntax."
   (if (string> version "1.2d")
       (error "make-skribe-reader: unsupported version" version)
-      *skribe-reader*))
+      %skribe-reader))
 
-
-(define (%make-skribe-reader)
+(define &sharp-reader
+  ;; The reader for what comes after a `#' character.
   (let* ((dsssl-keyword-reader  ;; keywords à la `#!key'
           (r:make-token-reader #\!
-                                (r:token-reader-procedure
-                                 (r:standard-token-reader 'keyword))))
-         (sharp-reader (r:make-reader (cons dsssl-keyword-reader
-                                            (map r:standard-token-reader
-                                                 '(character srfi-4
-						   vector
-                                                   number+radix
-                                                   boolean)))
-				      #f ;; use default fault handler
-				      'reader/record-positions))
-	 (colon-keywords ;; keywords à la `:key' fashion
-	  (r:make-token-reader #\:
 			       (r:token-reader-procedure
-				(r:standard-token-reader 'keyword))))
-	 (square-bracket-free-symbol-misc-chars
-	  (let* ((tr (r:standard-token-reader 'guile-symbol-misc-chars))
-		 (tr-spec (r:token-reader-specification tr))
-		 (tr-proc (r:token-reader-procedure tr)))
-	  (r:make-token-reader (filter (lambda (chr)
-					 (not (or (eq? chr #\[)
-						  (eq? chr #\]))))
-				       tr-spec)
-			       tr-proc))))
+				(r:standard-token-reader 'keyword)))))
+      (r:make-reader (cons dsssl-keyword-reader
+			   (map r:standard-token-reader
+				'(character srfi-4 vector
+				  number+radix boolean
+				  srfi30-block-comment
+				  srfi62-sexp-comment)))
+		     #f ;; use default fault handler
+		     'reader/record-positions)))
+
+(define (%make-skribe-reader)
+  (let ((colon-keywords ;; keywords à la `:key' fashion
+	 (r:make-token-reader #\:
+			      (r:token-reader-procedure
+			       (r:standard-token-reader 'keyword))))
+	(square-bracket-free-symbol-misc-chars
+	 (let* ((tr (r:standard-token-reader 'guile-symbol-misc-chars))
+		(tr-spec (r:token-reader-specification tr))
+		(tr-proc (r:token-reader-procedure tr)))
+	   (r:make-token-reader (filter (lambda (chr)
+					  (not (or (eq? chr #\[)
+						   (eq? chr #\]))))
+					tr-spec)
+				tr-proc))))
 
-    (r:make-reader (cons* (r:make-token-reader #\# sharp-reader)
+    (r:make-reader (cons* (r:make-token-reader #\# &sharp-reader)
 			  colon-keywords
 			  square-bracket-free-symbol-misc-chars
 			  (map r:standard-token-reader
@@ -90,7 +92,7 @@ the Skribe syntax."
 		   )))
 
 ;; We actually cache an instance here.
-(define *skribe-reader* (%make-skribe-reader))
+(define %skribe-reader (%make-skribe-reader))
 
 
 
diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm
index 34528ac..a300606 100644
--- a/src/guile/skribilo/skribe/api.scm
+++ b/src/guile/skribilo/skribe/api.scm
@@ -255,6 +255,19 @@
 ;*---------------------------------------------------------------------*/
 (define-simple-markup paragraph)
 
+
+;*---------------------------------------------------------------------*/
+;*    ~ (unbreakable space) ...                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (~ #!rest opts #!key (class #f))
+  (new markup
+     (markup '~)
+     (ident (gensym '~))
+     (class class)
+     (required-options '())
+     (options (the-options opts :class))
+     (body (the-body opts))))
+
 ;*---------------------------------------------------------------------*/
 ;*    footnote ...                                                     */
 ;*---------------------------------------------------------------------*/
@@ -1062,7 +1075,8 @@
 		    (o (markup-option s 'used)))
 		(markup-option-add! s 'used (if (pair? o) (cons h o) (list h)))
 		n)
-	     (unref #f v 'bib))))
+	     (unref #f v 'bib)))) ; FIXME: This prevents source location
+				  ; info to be provided in the warning msg
    (define (bib-ref text)
       (if (pair? text)
 	  (new markup
-- 
cgit v1.2.3