This file is indexed.

/usr/share/festival/util.scm is in festival-freebsoft-utils 0.10-3.

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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
;;; Miscellaneous utilities

;; Copyright (C) 2003, 2004, 2005, 2006, 2008 Brailcom, o.p.s.

;; Author: Milan Zamazal <pdm@brailcom.org>

;; COPYRIGHT NOTICE

;; 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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA.


;;; Commonly used Lisp constructs

(defmac (when form)
  `(if ,(cadr form)
       (begin
         ,@(cddr form))))

(defmac (unless form)
  `(if (not ,(cadr form))
       (begin
         ,@(cddr form))))

(defmac (prog1 form)
  `(let ((result ,(cadr form)))
     ,@(cddr form)
     result))

(define (let*-bindings bindings body)
  (if bindings
      `(let (,(car bindings))
         ,(let*-bindings (cdr bindings) body))
      `(progn ,@body)))

(defmac (let* form)
  (let ((bindings (cadr form))
        (body (cddr form)))
    (let*-bindings bindings body)))
  
(defmac (unwind-protect* form)
  (let ((protected-form (nth 1 form))
        (cleanup-forms (nth_cdr 2 form)))
    `(unwind-protect
       (prog1 ,protected-form
         ,@cleanup-forms)
       (begin
         ,@cleanup-forms))))

(define (first list)
  (car list))

(define (second list)
  (cadr list))

(define (third list)
  (nth 2 list))

(define (fourth list)
  (nth 3 list))

(define (butlast list)
  (if (null? (cdr list))
      '()
      (cons (car list) (butlast (cdr list)))))

(define (min x y)
  (if (< x y) x y))

(define (max x y)
  (if (>= x y) x y))

(define (abs x)
  (if (>= x 0) x (- 0 x)))

(define (remove-if test list)
  (let ((result '()))
    (while list
      (let ((elt (car list)))
        (unless (test elt)
          (push elt result)))
      (set! list (cdr list)))
    (reverse result)))

(define (identity x)
  x)

(define (complement func)
  (lambda args (not (apply func args))))

(define (apply* function list)
  (apply (if (eq? (typeof function) 'string) (intern function) function) list))

(defmac (dolist form)
  (let ((var (first (nth 1 form)))
        (items (second (nth 1 form)))
        (body (nth_cdr 2 form)))
    `(mapcar (lambda (,var) ,@body) ,items)))

;;; General utilities

(defmac (add-hook form)
  (let ((hook-var (nth 1 form))
        (hook (nth 2 form))
        (to-end? (nth 3 form)))
    `(if (member ,hook ,hook-var)
         ,hook-var
         (set! ,hook-var (if ,to-end?
                             (append ,hook-var (list ,hook))
                             (cons ,hook ,hook-var))))))

(define (assoc-set lst key value)
  (cons (cons key value)
        (remove (assoc key lst) lst)))

(define (avalue-get key alist)
  (cadr (assoc_string key alist)))

(define (avalue-set! key alist value)
  (set-cdr! (assoc_string key alist) (list value))
  alist)

(define (avg . args)
  (let ((n (length args)))
    (if (<= n 0)
        0
        (/ (apply + args) n))))

(define (dirname path)
  (path-as-directory
   (substring path 0 (- (length path) (length (basename path))))))

;; There is a bug in speech-tools preventing it to honor $TMPDIR.
;; We can work around the bug by setting some other environment variables.
(let ((tempdir (getenv "TMPDIR")))
  (when (and tempdir (not (equal? tempdir "")))
    (setenv "TEMP" tempdir)
    (setenv "TMP" tempdir)))
(define (make-temp-filename template)
  (let ((tmp-name (string-append (make_tmp_filename) "%d")))
    (set! template (format nil "%s%s" (dirname tmp-name)
                           (format nil template (basename tmp-name))))
    (let* ((i 0)
           (format-name (lambda (i) (format nil template i)))
           (name (format-name i))
           (max-attempts 1000))
      (while (and (< i max-attempts)
                  (probe_file name))
        (set! i (+ i 1))
        (set! name (format-name i)))
      (if (eqv? i max-attempts)
          (error "Temporary file not created" nil))
      name)))

(defmac (with-temp-file form)
  (let ((filename (nth 1 form))
        (body (nth_cdr 2 form)))
    `(let ((,filename (make-temp-filename "ffu%s")))
       (unwind-protect* (begin ,@body)
         (delete-file ,filename)))))

(define (string-replace string from to)
  (string-replace* string from to ""))
(define (string-replace* string from to result)
  (let ((before (string-before string from)))
    (if (or (equal? before string)
            (and (equal? before "")
                 (not (equal? (substring string 0 (length from)) from))))
        (string-append result string)
        (string-replace* (string-after string from) from to (string-append result before to)))))

;;; Festival specific utilities

(define (item.has_feat item feat)
  (assoc feat (item.features item)))

(define (langvar symbol)
  (let ((lsymbol (intern (string-append symbol "." (Param.get 'Language)))))
    (symbol-value (if (symbol-bound? lsymbol) lsymbol symbol))))

(define (current-voice-coding)
  (or (cadr (assoc 'coding (cadr (voice.description current-voice))))
      'ISO-8859-1))

(define (utt-relation-top-items utt relation)
  (let ((items '())
        (i (utt.relation.first utt relation)))
    (while i
      (push i items)
      (set! i (item.next i)))
    (reverse items)))

(defmac (do-relation-items form)
  (let ((var (first (nth 1 form)))
        (utt (second (nth 1 form)))
        (relation (third (nth 1 form)))
        (body (nth_cdr 2 form)))
    `(dolist (,var (utt.relation.items ,utt (quote ,relation)))
       ,@body)))

(defmac (do-relation-top-items form)
  (let ((var (first (nth 1 form)))
        (utt (second (nth 1 form)))
        (relation (third (nth 1 form)))
        (body (nth_cdr 2 form)))
    `(dolist (,var (utt-relation-top-items ,utt (quote ,relation)))
       ,@body)))

(define (get-annotations utt item)
  (let ((annotation-list (item.feat item 'ffu-annotation)))
    (if (pair? annotation-list) annotation-list '())))

(define (add-annotation utt item annotation)
  (item.set_feat item 'ffu-annotation
                 (append (get-annotations utt item) (list annotation))))

(define (set-annotations utt item annotations)
  (item.set_feat item 'ffu-annotation annotations))


(provide 'util)