blob: 69bff698e9645be54f46b466bbbe00122e368894 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
;; Tekuti
;; Copyright (C) 2008 Andy Wingo <wingo at pobox dot com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org
;;; Commentary:
;;
;; This is the main script that will launch tekuti.
;;
;;; Code:
;;hack!
(define-module (tekuti comment)
#:use-module (tekuti git)
#:use-module (tekuti util)
#:use-module (srfi srfi-1)
#:export (comment-from-tree build-comment-skeleton))
(use-modules (ice-9 regex))
(use-modules (ice-9 rdelim)
(ice-9 popen)
(srfi srfi-1)
(sxml simple)
(tekuti url)
(match-bind)
(sxml transform))
(debug-enable 'backtrace)
(define *comment-spec*
`((timestamp . ,string->number)))
(define (comment-from-tree encoded-name sha1)
(acons 'encoded-name encoded-name
(parse-metadata (string-append sha1 ":" "metadata") *comment-spec*)))
(define (comment-timestamp comment-alist)
(or (assq-ref comment-alist 'timestamp) #f))
(define (build-comment-skeleton comments)
(fold (lambda (sha1 parent)
(let* ((ts (comment-timestamp sha1))
(env (list "GIT_COMMMITTER=tekuti"
(format #f "GIT_COMMITTER_DATE=~a +0100" ts)
(format #f "GIT_AUTHOR_DATE=~a +0100" ts))))
(string-trim-both
(git* (cons* "commit-tree" sha1 (if parent (list "-p" parent) '()))
#:input "comment\n" #:env env))))
#f
comments))
|
