116 lines
4.1 KiB
Racket
116 lines
4.1 KiB
Racket
;;;
|
|
;;; <mime-util.rkt> ---- Extra utilities
|
|
;;; Time-stamp: <01/05/07 17:41:12 solsona>
|
|
;;;
|
|
;;; Copyright (C) 2001 by Francisco Solsona.
|
|
;;;
|
|
;;; This file is part of mime-plt.
|
|
|
|
;;; mime-plt is free software; you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Lesser General Public
|
|
;;; License as published by the Free Software Foundation; either
|
|
;;; version 2.1 of the License, or (at your option) any later version.
|
|
|
|
;;; mime-plt 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
|
|
;;; Lesser General Public License for more details.
|
|
|
|
;;; You should have received a copy of the GNU Lesser General Public
|
|
;;; License along with mime-plt; if not, write to the Free Software
|
|
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|
;;; 02110-1301 USA.
|
|
|
|
;;; Author: Francisco Solsona <solsona@acm.org>
|
|
;;
|
|
;;
|
|
;; Commentary:
|
|
|
|
#lang racket/base
|
|
|
|
(provide string-tokenizer
|
|
trim-all-spaces
|
|
trim-spaces
|
|
trim-comments
|
|
lowercase
|
|
warning
|
|
cat)
|
|
|
|
;; string-index returns the leftmost index in string s
|
|
;; that has character c
|
|
(define (string-index s c)
|
|
(let ([n (string-length s)])
|
|
(let loop ([i 0])
|
|
(cond [(>= i n) #f]
|
|
[(char=? (string-ref s i) c) i]
|
|
[else (loop (+ i 1))]))))
|
|
|
|
;; string-tokenizer breaks string s into substrings separated by character c
|
|
(define (string-tokenizer c s)
|
|
(let loop ([s s])
|
|
(if (string=? s "") '()
|
|
(let ([i (string-index s c)])
|
|
(if i (cons (substring s 0 i)
|
|
(loop (substring s (+ i 1) (string-length s))))
|
|
(list s))))))
|
|
|
|
;; Trim all spaces, except those in quoted strings.
|
|
(define (trim-all-spaces str)
|
|
;; Break out alternate quoted and unquoted parts.
|
|
;; Initial and final string are unquoted.
|
|
(let-values ([(unquoted quoted)
|
|
(let loop ([str str] [unquoted null] [quoted null])
|
|
(let ([m (regexp-match-positions #rx"\"" str)])
|
|
(if m
|
|
(let ([prefix (substring str 0 (caar m))]
|
|
[rest (substring str (add1 (caar m)) (string-length str))])
|
|
;; Find closing quote
|
|
(let ([m (regexp-match-positions #rx"\"" rest)])
|
|
(if m
|
|
(let ([inside (substring rest 0 (caar m))]
|
|
[rest (substring rest (add1 (caar m)) (string-length rest))])
|
|
(loop rest (cons prefix unquoted) (cons (format "\"~a\"" inside) quoted)))
|
|
;; No closing quote!
|
|
(loop "" (cons prefix unquoted) (cons (format "\"~a" rest) quoted)))))
|
|
(values (reverse (cons str unquoted)) (reverse quoted)))))])
|
|
;; Put the pieces back together, stripping spaces for unquoted parts:
|
|
(apply
|
|
string-append
|
|
(let loop ([unquoted unquoted] [quoted quoted])
|
|
(let ([clean (regexp-replace* #rx"[ \t\n\r\v]" (car unquoted) "")])
|
|
(if (null? quoted)
|
|
(list clean)
|
|
(list* clean
|
|
(car quoted)
|
|
(loop (cdr unquoted) (cdr quoted)))))))))
|
|
|
|
;; Only trims left and right spaces:
|
|
(define (trim-spaces str)
|
|
(regexp-replace #rx"[ \t\r\n\v]+$"
|
|
(regexp-replace #rx"^[ \t\r\n\v]+" str "")
|
|
""))
|
|
|
|
(define (trim-comments str)
|
|
(define positions
|
|
(regexp-match-positions #rx"^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))" str))
|
|
(if positions
|
|
(string-append (substring str 0 (caaddr positions))
|
|
(substring str (cdaddr positions) (string-length str)))
|
|
str))
|
|
|
|
(define lowercase string-downcase)
|
|
|
|
(define warning
|
|
(lambda (msg . args)
|
|
(log-warning (apply format (cons msg args)))))
|
|
|
|
;; Copies its input `in' to its ouput port if given, it uses
|
|
;; current-output-port if out is not provided.
|
|
(define (cat in [out (current-output-port)])
|
|
(let loop ([ln (read-line in)])
|
|
(unless (eof-object? ln)
|
|
(fprintf out "~a\n" ln)
|
|
(loop (read-line in)))))
|
|
|
|
;;; mime-util.rkt ends here
|