diff --git a/s48/cavespider/search-util.scm b/s48/cavespider/search-util.scm new file mode 100644 index 0000000..5ee2ab8 --- /dev/null +++ b/s48/cavespider/search-util.scm @@ -0,0 +1,82 @@ +;;; +;;; Copyright (c) 2012 Johan Ceuppens +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. +;;; 3. The name of the authors may not be used to endorse or promote products +;;; derived from this software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, +;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +(define (file-contents->keyword file-contents-str keyword) + ;;(display file-contents-str) + (let ((s "") + (ret '())) + + (do ((i 0 (+ i 1))) + ((>= i (string-length file-contents-str)) + ret) + (cond ((not (eq? #\h (string-ref file-contents-str i))) + (set! s "")) + ((eq? #\h (string-ref file-contents-str i)) + + (let ((s2 "")) + + (do ((j i (+ j 1))) + ((cond ((string=? s2 keyword) + + (let ((s3 "")) + (do ((k j (+ k 1))) + ((cond ((eq? (string-ref file-contents-str k) + #\");;FIXME + + (set! j k)(set! i k)(set! s2 "")) + ((eq? (string-ref file-contents-str k) + #\/) + (set! ret (append ret (list s3))) + + (set! j k) + (set! i k)) + ((>= k (string-length file-contents-str));;FIXME prev + (set! s2 "")(set! i k)(set! j k)) + )) + (set! s3 (string-append + s3 + (string (string-ref file-contents-str k)))) + ) + + )) + ((not (string<=? s2 keyword)) + (set! s "") + + (set! i j)) + )) + + (set! s2 (string-append + s2 + (string (string-ref file-contents-str j)))) + (display "s2=")(display s) + + (set! i j))))) + (set! s (string-append s (string (string-ref file-contents-str i)))) + ;;(display "s=")(display (string-ref file-contents-str i)) + ) + ret))