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
|
;
; general-purpose scheme utility functions
;
(define-module (app gwave utils)
:use-module (ice-9 regex)
)
(debug-enable 'backtrace)
;(debug-enable 'debug)
; join - a procedure like the perl function "join:"
; concatenate list of strings, putting a seperator string between each
; element of the list.
(define-public (join s l)
(cond ((null? l) "")
((= 1 (length l)) (car l))
(else (string-append (car l) s (join s (cdr l))))))
; filter out shell metacharacters from a string
(define metachars-regexp (make-regexp "[\t <>()|&;^\\$]+"))
(define-public (filter-metachars s)
(regexp-substitute/global #f metachars-regexp s 'pre 'post))
; use regular expression to find portion of string like
; <dot><upper case letters><dot>
(define-public (find-dotupper s)
(let* ((r (make-regexp "\\.([A-Z][A-Z]*)\\."))
(m (regexp-exec r s)))
(if m
(match:substring m 1)
#f)))
; replace long pathname prefix with .../
(define-public (shorten-filename s)
(let ((l (string-length s)))
(if (> l 30)
(let ((r (string-rindex s #\/)))
(if r
(string-append "..." (substring s r l))
s)
)
s
)
))
|
