root/websites/shibuya.lisp-users.org/members/gen-members.lisp @ 133

Revision 63, 3.5 kB (checked in by g000001, 16 years ago)

新規追加

Line 
1;;; これは何?
2;;; WordPressでメンバー一覧を作成するのが面倒なので、CLで書きました
3;;; みたいな #:g000001
4;;;
5;;; 使い方:
6;;;
7;;; (gen-members-page "/path/alist.lisp" ;入力(alist形式のデータ)
8;;;                   "/p/a/t/h/foo.html") ;出力(html)
9;;;
10;;; データ形式見本:
11;;; ハンドル, URL, 自己紹介, 本名 etc
12;;; ("foo" "http://example.com" "言語?。lisp。みたいな" "foo")
13;;; ...
14;;; 平仮名の名前等を解析するのが面倒なので、平仮名等の名前には"|"で区切って
15;;; ローマ字読みを併記することにしました。
16;;; "yamadahanako|山田☆花子"等々
17;;;
18
19(defpackage :shibuya
20  (:use :cl :kmrcl :lml2))
21
22(in-package :shibuya)
23
24(defun midashi (mesg)
25  (html
26   ((:td :colspan 4 :align "left" :valign "top") (:princ mesg))))
27
28(defun |http://-remover| (url)
29  (string-right-trim "/" (subseq url (mismatch "http://" url))))
30
31(defun cell (name url)
32  (html
33   ;; 何故かしらないが、WordPressさんが、コメントにPタグを付けてくれるので、
34   ;; 無効にしている。
35   #|(:comment (:princ (format nil " ~A " name))) :newline |#
36   (:tr
37    :newline (:princ "  ")
38    ((:td :width 8))                    ;スペーサ
39    :newline
40    (:princ "  ")
41    ((:td :align "left" :valign "top")((:a :href url) (:princ name)))
42    :newline (:princ "  ")
43    ((:td :width 8))                    ;スペーサ
44    :newline (:princ "  ")
45    ((:td :align "left" :valign "top")((:a :href url) (:princ (|http://-remover| url))))
46    :newline)
47   :newline))
48
49(defun gen-members-page (data outfile)
50  (with-open-file (out outfile :direction :output :if-exists :supersede)
51    (with-open-file (in data)
52      (let* ((malist (read in nil nil))
53             (m (copy-tree malist))
54             (m (sort m #'string-lessp :key #'car)))
55        (html-stream out
56                     :princ
57                     " 現在のところShibuya.lispメンバになるには、<a href=\"http://groups.google.co.jp/group/Shibuyalisp\">Shibuya.lispメーリングリスト</a>に参加して頂くだけです。
58この一覧に掲載希望の場合は、ML内の掲載希望スレッドにご返信下さい。"
59                     (:div
60                      ((:table :border 0)
61                       (:tbody
62                        ;; 発起人
63                        :newline
64                        (midashi "発起人") :newline
65                        (cell "Higepon" "http://d.hatena.ne.jp/higepon/")
66                        (cell "naoya_t" "http://blog.livedoor.jp/naoya_t/")
67                        (cell "g000001" "http://cadr.g.hatena.ne.jp/g000001")
68                        (cell "佐野 匡俊" "http://xyzzy.s53.xrea.com/wiki/")
69                        ((:tr) (:td))
70                        ;; members
71                        (midashi "メンバー") :newline
72                        (:comment "member")
73                        :newline
74                        (dolist (item m)
75                          (destructuring-bind (name url &rest ignore) item
76                            (declare (ignore ignore))
77                            (cell (aif (position #\| name)
78                                       (subseq name (1+ it))
79                                       name)
80                                  url)))
81                        ;; tail
82                        ((:td :width 8)) ;スペーサ
83                        ((:td :colspan 3 :align "left" :valign "top") "(アルファベット順。敬称略)")
84                        ))))))))
85
Note: See TracBrowser for help on using the browser.