config.scm

(use srfi-13)
(use file.util)

(define (ini-value->bool value)
  (cond
   [(or (string-ci=? value "false")
        (string-ci=? value "no")
        (string-ci=? value "off")
        (string-null? value))
    #f]
   [(or (string-ci=? value "true")
        (string-ci=? value "yes")
        (string-ci=? value "on"))
    #t]
   [else (error "unrecognized value" value)]))

(define (append-section sec key)
  (if sec
      (string-append sec "." key)
      key))

(define (unquote-string str)
  (if (string-scan str #\\)
      (with-output-to-string
        (cut with-input-from-string str
             (lambda ()
               (let loop ([ch (read-char)])
                 (cond
                  [(eof-object? ch) #t]
                  [(char=? ch #\\) (let ([next (read-char)])
                                     (if (eof-object? next)
                                         #t
                                         (begin
                                           (write-char next)
                                           (loop (read-char)))))]
                  [else (begin
                          (write-char ch)
                          (loop (read-char)))])))))
      str))

(define (quote-string str)
  (with-output-to-string
    (cut with-input-from-string str
         (lambda ()
           (let loop ([ch (read-char)])
             (cond
              [(eof-object? ch) #t]
              [(or (char=? ch #\\)
                   (char=? ch #\")) (begin
                                      (write-char #\\)
                                      (write-char ch)
                                      (loop (read-char)))]
              [else (begin
                      (write-char ch)
                      (loop (read-char)))]))))))

(define (ini-file->list :optional (iport (current-input-port)))
  (let loop ([list (port->string-list iport)]
             [section #f]
             [result '()])
    (if (pair? list)
        (let ([line (string-trim-both (car list))]
              [next (cdr list)])
          (cond
           [(or (string-null? line) (#/^[#\;]/ line))
            (loop next section result)]
           ;; [section]
           [(#/^\[\s*([a-zA-Z0-9_.]+)\s*\]$/ line)
            => (lambda (re)
                 (loop next (re 1) result))]
           ;; [section "subsection"]
           [(#/^\[([a-z]+)\s+"(.*)"\s*\]$/ line)
            => (lambda (re)
                 (loop next
                       (append-section (re 1)
                                       (unquote-string (re 2)))
                       result))]
           ;; key = "value with spaces in quotes"
           [(#/^([a-zA-Z_0-9]+)\s*=\s*"(.*)"$/ line)
            => (lambda (re)
                 (loop next
                       section
                       (cons (cons (append-section section (re 1))
                                   (unquote-string (re 2)))
                             result)))]
           ;; key = value
           [(#/^([a-zA-Z_0-9]+)\s*=\s*([^\s].*)$/ line)
            => (lambda (re)
                 (loop next
                       section
                       (cons (cons (append-section section (re 1))
                                   (re 2))
                             result)))]
           [else (error "unsupported line" line)]
           ))
        result)))

(define (write-section section oport)
  (let ([pos ( string-scan section #\.)])
    (if pos
        (display (format "[~a \"~a\"]\n"
                         (substring section 0 pos)
                         (quote-string (substring section
                                                  (+ pos 1)
                                                  (string-length section)))))
        (display (format "[~a]\n" section)))))

(define (write-key-value no-indent key value oport)
  (define (quote-needed? str)
    (> (length (string-split str #/[^A-Za-z0-9-_]/)) 1))

  (unless no-indent
    (display "\t"))
  (if (quote-needed? value)
      (display (format "~a = \"~a\"\n" key (quote-string value)) oport)
      (display (format "~a = ~a\n" key value) oport)))

(define (list->ini-file ini :optional (oport (current-output-port)))
  (define (split-section x)
    (let ([key (car x)]
          [value (cdr x)])
      (let ([first-dot (string-scan-right key #\.)])
        (if first-dot
            (list (substring key 0 first-dot)
                  (substring key
                             (+ first-dot 1)
                             (string-length key))
                  value)
            (list "" key value)))))

  (let loop ([ini (sort (map split-section ini) string<? car)]
             [section ""])
    (let ([line (car ini)]
          [next (cdr ini)])
      (if (string-ci=? section (car line))
          (begin
            (write-key-value (string-null? section) (cadr line) (caddr line) oport)
            (if (pair? next)
                (loop next section)))
          (let ([section (car line)])
            (write-section section oport)
            (write-key-value (string-null? section) (cadr line) (caddr line) oport)
            (if (pair? next)
                (loop next section)))))))

(with-input-from-file (expand-path "~/w/git/.git/common/config")
  (lambda ()
    (write (assoc "branch.grep-icase.description" (ini-file->list)))))