Removed the Bigloo/STkLos in the `legacy' directory.

Removed the `legacy' directory.

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-25

1 files changed, 0 insertions, 219 deletions

diff --git a/legacy/stklos/prog.stk b/legacy/stklos/prog.stk
deleted file mode 100644
index 6301ece..0000000
--- a/legacy/stklos/prog.stk
+++ /dev/null
@@ -1,219 +0,0 @@
-;;;;
-;;;; prog.stk	-- All the stuff for the prog markup
-;;;; 
-;;;; Copyright © 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;;; 
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2 of the License, or
-;;;; (at your option) any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
-;;;; USA.
-;;;; 
-;;;;           Author: Erick Gallesio [eg@essi.fr]
-;;;;    Creation date: 31-Aug-2003 23:42 (eg)
-;;;; Last file update: 22-Oct-2003 19:35 (eg)
-;;;;
-
-(define-module SKRIBE-PROG-MODULE
-  (export make-prog-body resolve-line)
-
-;;; ======================================================================
-;;;
-;;; COMPATIBILITY
-;;;
-;;; ======================================================================
-(define pregexp-match 	regexp-match)
-(define pregexp-replace regexp-replace)
-(define pregexp-quote   regexp-quote)
-
-
-(define (node-body-set! b v)
-  (slot-set! b 'body v))
-
-;;;
-;;; FIXME: Tout le module peut se factoriser
-;;;        définir en bigloo  node-body-set
-
-
-;*---------------------------------------------------------------------*/
-;*    *lines* ...                                                      */
-;*---------------------------------------------------------------------*/
-(define *lines* (make-hashtable))
-
-;*---------------------------------------------------------------------*/
-;*    make-line-mark ...                                               */
-;*---------------------------------------------------------------------*/
-(define (make-line-mark m lnum b)
-   (let* ((ls (number->string lnum))
-	  (n (list (mark ls) b)))
-      (hashtable-put! *lines* m n)
-      n))
-
-;*---------------------------------------------------------------------*/
-;*    resolve-line ...                                                 */
-;*---------------------------------------------------------------------*/
-(define (resolve-line id)
-   (hashtable-get *lines* id))
-
-;*---------------------------------------------------------------------*/
-;*    extract-string-mark ...                                          */
-;*---------------------------------------------------------------------*/
-(define (extract-string-mark line mark regexp)
-   (let ((m (pregexp-match regexp line)))
-      (if (pair? m)
-	  (values (substring (car m)
-			     (string-length mark)
-			     (string-length (car m)))
-		  (pregexp-replace regexp line ""))
-	  (values #f line))))
-   
-;*---------------------------------------------------------------------*/
-;*    extract-mark ...                                                 */
-;*    -------------------------------------------------------------    */
-;*    Extract the prog mark from a line.                               */
-;*---------------------------------------------------------------------*/
-(define (extract-mark line mark regexp)
-   (cond
-      ((not regexp)
-       (values #f line))
-      ((string? line)
-       (extract-string-mark line mark regexp))
-      ((pair? line)
-       (let loop ((ls line)
-		  (res '()))
-	  (if (null? ls)
-	      (values #f line)
-	      (receive (m l)
-		 (extract-mark (car ls) mark regexp)
-		 (if (not m)
-		     (loop (cdr ls) (cons l res))
-		     (values m (append (reverse! res) (cons l (cdr ls)))))))))
-      ((node? line)
-       (receive (m l)
-	  (extract-mark (node-body line) mark regexp)
-	  (if (not m)
-	      (values #f line)
-	      (begin
-		 (node-body-set! line l)
-		 (values m line)))))
-      (else
-       (values #f line))))
-
-;*---------------------------------------------------------------------*/
-;*    split-line ...                                                   */
-;*---------------------------------------------------------------------*/
-(define (split-line line)
-   (cond
-      ((string? line)
-       (let ((l (string-length line)))
-	  (let loop ((r1 0)
-		     (r2 0)
-		     (res '()))
-	     (cond
-		((= r2 l)
-		 (if (= r1 r2)
-		     (reverse! res)
-		     (reverse! (cons (substring line r1 r2) res))))
-		((char=? (string-ref line r2) #\Newline)
-		 (loop (+ r2 1)
-		       (+ r2 1)
-		       (if (= r1 r2)
-			   (cons 'eol res)
-			   (cons* 'eol (substring line r1 r2) res))))
-		(else
-		 (loop r1
-		       (+ r2 1)
-		       res))))))
-      ((pair? line)
-       (let loop ((ls line)
-		  (res '()))
-	  (if (null? ls)
-	      res
-	      (loop (cdr ls) (append res (split-line (car ls)))))))
-      (else
-       (list line))))
-
-;*---------------------------------------------------------------------*/
-;*    flat-lines ...                                                   */
-;*---------------------------------------------------------------------*/
-(define (flat-lines lines)
-   (apply append (map split-line lines)))
-
-;*---------------------------------------------------------------------*/
-;*    collect-lines ...                                                */
-;*---------------------------------------------------------------------*/
-(define (collect-lines lines)
-   (let loop ((lines (flat-lines lines))
-	      (res '())
-	      (tmp '()))
-      (cond
-	 ((null? lines)
-	  (reverse! (cons (reverse! tmp) res)))
-	 ((eq? (car lines) 'eol)
-	  (cond
-	     ((null? (cdr lines))
-	      (reverse! (cons (reverse! tmp) res)))
-	     ((and (null? res) (null? tmp))
-	      (loop (cdr lines)
-		    res
-		    '()))
-	     (else
-	      (loop (cdr lines)
-		    (cons (reverse! tmp) res)
-		    '()))))
-	 (else
-	  (loop (cdr lines)
-		res
-		(cons (car lines) tmp))))))
-      
-;*---------------------------------------------------------------------*/
-;*    make-prog-body ...                                               */
-;*---------------------------------------------------------------------*/
-(define (make-prog-body src lnum-init ldigit mark)
-   (define (int->str i rl)
-      (let* ((s (number->string i))
-	     (l (string-length s)))
-	 (if (= l rl)
-	     s
-	     (string-append (make-string (- rl l) #\space) s))))
- 
-   (let* ((regexp (and mark
-		       (format "~a[-a-zA-Z_][-0-9a-zA-Z_]+"
-			       (pregexp-quote mark))))
-	  (src (cond
-		  ((not (pair? src)) (list src))
-		  ((and (pair? (car src)) (null? (cdr src))) (car src))
-		  (else src)))
-	  (lines (collect-lines src))
-	  (lnum (if (integer? lnum-init) lnum-init 1))
-	  (s (number->string (+ (if (integer? ldigit)
-				    (max lnum (expt 10 (- ldigit 1)))
-				    lnum)
-				(length lines))))
-	  (cs (string-length s)))
-     (let loop ((lines lines)
-		 (lnum lnum)
-		 (res '()))
-	 (if (null? lines)
-	     (reverse! res)
-	     (receive (m l)
-		      (extract-mark (car lines) mark regexp)
-		(let ((n (new markup
- 			    (markup '&prog-line)
- 			    (ident (and lnum-init (int->str lnum cs)))
- 			    (body (if m (make-line-mark m lnum l) l)))))
- 		   (loop (cdr lines)
- 			 (+ lnum 1)
- 			 (cons n res))))))))
-
-)
\ No newline at end of file