/usr/share/gnucash/scm/substring-search.scm is in gnucash-common 1:2.6.15-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | ; IMPLEMENTS Substring search
; AUTHOR Ken Dickey
; DATE 1991 August 6
; LAST UPDATED
; NOTES
;Based on "A Very Fast Substring Search Algorithm", Daniel M. Sunday,
;CACM v33, #8, August 1990.
;;
;; SUBSTRING-SEARCH-MAKER takes a string (the "pattern") and returns a function
;; which takes a string (the "target") and either returns #f or the index in
;; the target in which the pattern first occurs as a substring.
;;
;; E.g.: ((substring-search-maker "test") "This is a test string") -> 10
;; ((substring-search-maker "test") "This is a text string") -> #f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (substring-search-maker pattern-string)
(define num-chars-in-charset 256) ;; update this, e.g. for iso latin 1
(define (build-shift-vector pattern-string)
(let* ((pat-len (string-length pattern-string))
(shift-vec (make-vector num-chars-in-charset
(+ pat-len 1)))
(max-pat-index (- pat-len 1)))
(let loop ((index 0))
(vector-set! shift-vec
(char->integer
(string-ref pattern-string index))
(- pat-len index))
(if (< index max-pat-index)
(loop (+ index 1))
shift-vec))))
(let ((shift-vec (build-shift-vector pattern-string))
(pat-len (string-length pattern-string)))
(lambda (target-string)
(let* ((tar-len (string-length target-string))
(max-tar-index (- tar-len 1))
(max-pat-index (- pat-len 1)))
(let outer ( (start-index 0))
(if (> (+ pat-len start-index) tar-len)
#f
(let inner ( (p-ind 0) (t-ind start-index) )
(cond
((> p-ind max-pat-index) ; nothing left to check
#f) ; fail
((char=? (string-ref pattern-string p-ind)
(string-ref target-string t-ind))
(if (= p-ind max-pat-index)
start-index ;; success -- return start index of match
(inner (+ p-ind 1) (+ t-ind 1)) ; keep checking
))
((> (+ pat-len start-index) max-tar-index) #f) ; fail
(else
(outer (+ start-index
(vector-ref
shift-vec
(char->integer
(string-ref target-string
(+ start-index pat-len)))))))))))))))
;;; Functions to split up strings
;;; Provides the generic facility to split based on *any* character
;;; We make use of splitting on spaces and on colons...
;;; Find the next occurance of [somechar] in the string [string]
;;; starting at [startpos]
(define (split-on-somechar sourcestring somechar)
(define (next-somechar string startpos endpos somechar)
(let loop
; initialize
((pos startpos))
(cond
((>= pos endpos) endpos) ; Reached end of string
((char=? (string-ref string pos) somechar) pos) ; Reached "somechar"
(else
(loop (+ pos 1))))))
(let loop
((pos 0)
(endpos (string-length sourcestring))
(result '()))
(cond
((>= pos endpos) result)
(else
(let ((nextwhatever
(next-somechar sourcestring pos endpos somechar)))
(loop
(+ nextwhatever 1)
endpos
(append result
(list
(substring sourcestring pos nextwhatever)))))))))
|