commander-s/scheme/utils.scm

69 lines
1.9 KiB
Scheme

(define (display-to-string val)
(let ((exp-port (open-output-string)))
(display val exp-port)
(get-output-string exp-port)))
;;expression as string
(define (write-to-string val)
(let ((exp-port (open-output-string)))
(write val exp-port)
(get-output-string exp-port)))
(define (on/off-option-processor name)
(lambda (option arg-name arg ops)
(cons (cons name #t) ops)))
(define (paste-selection vals marks? for-scheme-mode? to-scheme to-command)
(if marks?
(if for-scheme-mode?
(format #f "'(~a)" (string-join (map to-scheme vals)))
(string-join (map to-command vals)))
(if (null? vals)
""
(if for-scheme-mode?
(to-scheme (car vals))
(to-command (car vals))))))
(define *redisplay-everything* #t)
(define (set-redisplay-everything)
(set! *redisplay-everything* #t))
(define (unset-redisplay-everything)
(set! *redisplay-everything* #f))
(define (redisplay-everything?)
*redisplay-everything*)
(define (identity-function x) x)
(define replace-in-string
(lambda (str ch1 ch2)
(string-map (lambda (ch)
(if (char=? ch ch1)
ch2
ch))
str)))
(define fill-string
(lambda (str ch len)
(let ((missing-len (- len (string-length str))))
(if (zero? missing-len)
str
(string-append str
(make-string missing-len ch))))))
(define split-to-string-list
(lambda (str len)
(let ((str-len (string-length str)))
(let loop ((lst '())
(start 0))
(if (<= (- str-len start) len)
(reverse (cons (substring str start str-len) lst))
(loop (cons (substring str start (+ start len)) lst)
(+ start len)))))))
(define split-string-at-newline
(lambda (str)
(string-tokenize str (char-set-complement (char-set #\newline)))))