scheme/utils.scm

   1 ;
   2 ; general-purpose scheme utility functions
   3 ;
   4
   5 (define-module (app gwave utils)
   6   :use-module (ice-9 regex)
   7 )
   8
   9 (debug-enable 'backtrace)
  10 (debug-enable 'debug)
  11
  12 ; join - a procedure like the perl function "join:"
  13 ; concatenate list of strings, putting a seperator string between each
  14 ; element of the list.
  15 (define-public (join s l)
  16   (cond ((null? l)     "")
  17         ((= 1 (length l))     (car l))
  18         (else (string-append (car l) s (join s (cdr l))))))
  19
  20 ; filter out shell metacharacters from a string
  21 (define metachars-regexp (make-regexp "[\t <>()|&;^\\$]+"))
  22 (define-public (filter-metachars s)
  23   (regexp-substitute/global #f metachars-regexp s 'pre 'post))
  24
  25
  26 ; use regular expression to find portion of string like
  27 ;       <dot><upper case letters><dot>
  28 (define-public (find-dotupper s)
  29   (let* ((r (make-regexp "\\.([A-Z][A-Z]*)\\."))
  30         (m (regexp-exec r s)))
  31     (if m
  32           (match:substring m 1)
  33         #f)))
  34
  35 ; replace long pathname prefix with .../
  36 (define-public (shorten-filename s)
  37   (let ((l (string-length s)))
  38     (if (> l 30)
  39         (let ((r (string-rindex s #\/)))
  40           (if r
  41               (string-append "..." (substring s r l))
  42               s)
  43           )
  44         s
  45         )
  46 ))