wuc.scm

wuc.scm

(use gauche.process)
(use rfc.uri)
(use simply)

(define *open-uri-command* "start")
(define *config-file-name* "wuc.conf")

; =read-config
; -------------------------------------------------------
(define (read-config)
  (define (make-rule-list rule)
    (list (string->regexp (car rule)) (cadr rule))
    )

  (simple-input
    *config-file-name*
    (port-fold
      (lambda (rule result)
        (cons (make-rule-list rule) result)
        )
      '() read)
    )
  )

; =get-variable-number
; 文字列中に含まれる "$N" のような番号を抜きだしてリスト化する
; -------------------------------------------------------
(define (get-variable-number str result)
  (let1 res (#/\$([0-9])/ str)
    (cond
      [res
        (get-variable-number
          (res 'after)
          (cons (string->number (res 1)) result))
        ]
      [else
        (r result)
        ]
      )
    )
  )

; =make-uri
; @base と @regmatch から実行するURLを作成
; -------------------------------------------------------
(define (make-uri base regmatch)
  (let ((match-num (rxmatch-num-matches regmatch))
        (var-num (get-variable-number base '()))
        (result-string base)
        )
    (apply
      regexp-replace-all*
      (fold
        (lambda (n res)
          (if (and (> n 0) (< n match-num))
            (append res (list #`"$,n" (uri-encode-string (regmatch n))))
            res
            )
          ) (list base) var-num)
      )
    )
  )

; =check-inputted-arg
; 入力された情報から一致するルールを検索する
; -------------------------------------------------------
(define (check-inputted-arg conf arg)
  (block
    break
    (for-each (lambda (rule)
                (let1 res ((car rule) arg)
                  (when res
                    (break (list res (cadr rule)))
                    )
                  )
                ) conf)
    (list '() '())
    )
  )

; =main
; -------------------------------------------------------
(define (main args)
  (let1 conf (read-config)
    (list-receive (res base) (check-inputted-arg conf (cadr args))
      (when (not (null? res))
        (call-with-input-process
          (string-append *open-uri-command* " " (make-uri base res))
          port->string)
        )
      )
    )
  )