From e9509518623d016880392237a298d4561a3b6a0b Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Mon, 31 Oct 2005 16:03:18 +0000 Subject: Removed useless files, integrated packages. * src/guile/skribilo/packages: New directory and files. * bin: Removed. * skr: Removed (files moved to `src/guile/skribilo/packages'). * skribe: Removed. * doc/skr/env.skr (*courtes-mail*): New. * doc/user/user.skb: Removed postal addresses, added my name. * src/guile/skribilo/engine/lout.scm: Uncommented the slide-related markup writers. * src/guile/skribilo/evaluator.scm (%evaluate): Try weird things with source properties. * src/guile/skribilo/reader/skribe.scm: Comply with the new guile-reader API. * src/guile/skribilo/types.scm: Removed the special `initialize' method for ASTs which was supposed to set their location. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7 --- skribe/src/common/index.scm | 126 -------------------------------------------- 1 file changed, 126 deletions(-) delete mode 100644 skribe/src/common/index.scm (limited to 'skribe/src/common/index.scm') diff --git a/skribe/src/common/index.scm b/skribe/src/common/index.scm deleted file mode 100644 index 65c271f..0000000 --- a/skribe/src/common/index.scm +++ /dev/null @@ -1,126 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/src/common/index.scm */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sun Aug 24 08:01:45 2003 */ -;* Last change : Wed Feb 4 14:58:05 2004 (serrano) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* Skribe indexes */ -;* ------------------------------------------------------------- */ -;* Implementation: @label index@ */ -;* bigloo: @path ../bigloo/index.bgl@ */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* index? ... */ -;*---------------------------------------------------------------------*/ -(define (index? obj) - (hashtable? obj)) - -;*---------------------------------------------------------------------*/ -;* *index-table* ... */ -;*---------------------------------------------------------------------*/ -(define *index-table* #f) - -;*---------------------------------------------------------------------*/ -;* make-index-table ... */ -;*---------------------------------------------------------------------*/ -(define (make-index-table ident) - (make-hashtable)) - -;*---------------------------------------------------------------------*/ -;* default-index ... */ -;*---------------------------------------------------------------------*/ -(define (default-index) - (if (not *index-table*) - (set! *index-table* (make-index-table "default-index"))) - *index-table*) - -;*---------------------------------------------------------------------*/ -;* resolve-the-index ... */ -;*---------------------------------------------------------------------*/ -(define (resolve-the-index loc i c indexes split char-offset header-limit col) - ;; fetch the descriminating index name letter - (define (index-ref n) - (let ((name (markup-option n 'name))) - (if (>= char-offset (string-length name)) - (skribe-error 'the-index "char-offset out of bound" char-offset) - (string-ref name char-offset)))) - ;; sort a bucket of entries (the entries in a bucket share there name) - (define (sort-entries-bucket ie) - (sort ie - (lambda (i1 i2) - (or (not (markup-option i1 :note)) - (markup-option i2 :note))))) - ;; accumulate all the entries starting with the same letter - (define (letter-references refs) - (let ((letter (index-ref (car (car refs))))) - (let loop ((refs refs) - (acc '())) - (if (or (null? refs) - (not (char-ci=? letter (index-ref (car (car refs)))))) - (values (char-upcase letter) acc refs) - (loop (cdr refs) (cons (car refs) acc)))))) - ;; merge the buckets that comes from different index tables - (define (merge-buckets buckets) - (if (null? buckets) - '() - (let loop ((buckets buckets) - (res '())) - (cond - ((null? (cdr buckets)) - (reverse! (cons (car buckets) res))) - ((string=? (markup-option (car (car buckets)) 'name) - (markup-option (car (cadr buckets)) 'name)) - ;; we merge - (loop (cons (append (car buckets) (cadr buckets)) - (cddr buckets)) - res)) - (else - (loop (cdr buckets) - (cons (car buckets) res))))))) - (let* ((entries (apply append (map hashtable->list indexes))) - (sorted (map sort-entries-bucket - (merge-buckets - (sort entries - (lambda (e1 e2) - (string-cistring (gensym s)) :text s)) - (h (new handle (loc loc) (ast m))) - (r (ref :handle h :text s))) - (ast-loc-set! m loc) - (ast-loc-set! r loc) - (loop next-refs - (cons r lrefs) - (append lr (cons m body))))))))))) - -- cgit v1.2.3