root/lang/gauche/oldtype/tags/0.3.0/command/blog @ 15393

Revision 15393, 2.3 kB (checked in by kiyoka, 5 years ago)

Released 0.3.0

  • Property svn:executable set to *
Line 
1#!/usr/local/bin/gosh
2
3(use srfi-1)
4(use oldtype.util)
5
6
7(define ot-new-entry-limit 10)
8
9
10(define ot-blog (format "~a/!~a.blog"
11                        (oldtype:editpath)
12                        (oldtype:user-local)))
13
14(define ot-blog-header (format "~a.blog_header.ot"
15                               (oldtype:user-local)))
16
17(define (ot-blog-entrylist)
18  (reverse
19   (sort
20    (oldtype:get-pagelist (string-append
21                           (oldtype:user-local)
22                           "[.]([0-9]+)")))))
23
24(define (output-blog save-filename entrylist appendix)
25  (with-output-to-file save-filename
26    (lambda ()
27      (for-each
28       (lambda (filename)
29         (with-input-from-file (string-append (oldtype:editpath) "/" filename)
30           (lambda ()
31             (when (#/[.][0-9]+/ filename)
32               (begin
33                 (display "----") (newline)
34                 (newline)
35                 (newline)
36                 (display
37                  (string-append "* [[" (oldtype:otpath->wikiname filename) "]]"))))
38             (for-each print (port->string-list (current-input-port))))))
39       entrylist)
40      (display appendix)
41      (newline))))
42
43
44(define (output-blog-list save-filename entrylist)
45  (with-output-to-file save-filename
46    (lambda ()
47      (for-each
48       (lambda (filename)
49         (with-input-from-file (string-append (oldtype:editpath) "/" filename)
50           (lambda ()
51             (when (#/[.][0-9]+/ filename)
52               (display
53                (string-append "- [[" (oldtype:otpath->wikiname filename) "]]"))
54               (print (car (port->string-list (current-input-port))))))))
55       entrylist))))
56
57
58(define (main argv)
59  (output-blog (string-append ot-blog ".ot")
60               (cons
61                ot-blog-header
62                (take (ot-blog-entrylist) ot-new-entry-limit))
63               "")
64  (output-blog-list (string-append ot-blog ".list.ot")
65                    (ot-blog-entrylist))
66  (for-each
67   (lambda (x)
68     (let ((year_month (car x))
69           (entries    (cdr x)))
70       (output-blog (string-append ot-blog "." year_month ".ot")
71                    (cons
72                     ot-blog-header
73                     (reverse entries))
74                    "##(nolist)")))
75   (oldtype:grouping-blog-entries
76    (ot-blog-entrylist)))
77
78  (exit 0))
Note: See TracBrowser for help on using the browser.