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

;;; これは何?
;;; WordPressでメンバー一覧を作成するのが面倒なので、CLで書きました
;;; みたいな #:g000001
;;;
;;; 使い方:
;;;
;;; (gen-members-page "/path/alist.lisp" ;入力(alist形式のデータ)
;;;                   "/p/a/t/h/foo.html") ;出力(html)
;;;
;;; データ形式見本:
;;; ハンドル, URL, 自己紹介, 本名 etc
;;; ("foo" "http://example.com" "言語?。lisp。みたいな" "foo")
;;; ...
;;; 平仮名の名前等を解析するのが面倒なので、平仮名等の名前には"|"で区切って
;;; ローマ字読みを併記することにしました。
;;; "yamadahanako|山田☆花子"等々
;;; 

(defpackage :shibuya
  (:use :cl :kmrcl :lml2))

(in-package :shibuya)

(defun midashi (mesg)
  (html 
   ((:td :colspan 4 :align "left" :valign "top") (:princ mesg))))

(defun |http://-remover| (url)
  (string-right-trim "/" (subseq url (mismatch "http://" url))))

(defun cell (name url)
  (html
   ;; 何故かしらないが、WordPressさんが、コメントにPタグを付けてくれるので、
   ;; 無効にしている。
   #|(:comment (:princ (format nil " ~A " name))) :newline |# 
   (:tr
    :newline (:princ "  ")
    ((:td :width 8))                    ;スペーサ
    :newline
    (:princ "  ")
    ((:td :align "left" :valign "top")((:a :href url) (:princ name)))
    :newline (:princ "  ")
    ((:td :width 8))                    ;スペーサ
    :newline (:princ "  ")
    ((:td :align "left" :valign "top")((:a :href url) (:princ (|http://-remover| url))))
    :newline)
   :newline))

(defun gen-members-page (data outfile)
  (with-open-file (out outfile :direction :output :if-exists :supersede)
    (with-open-file (in data)
      (let* ((malist (read in nil nil))
             (m (copy-tree malist))
             (m (sort m #'string-lessp :key #'car)))
        (html-stream out
                     :princ 
                     " 現在のところShibuya.lispメンバになるには、<a href=\"http://groups.google.co.jp/group/Shibuyalisp\">Shibuya.lispメーリングリスト</a>に参加して頂くだけです。
この一覧に掲載希望の場合は、ML内の掲載希望スレッドにご返信下さい。"
                     (:div
                      ((:table :border 0)
                       (:tbody
                        ;; 発起人
                        :newline
                        (midashi "発起人") :newline
                        (cell "Higepon" "http://d.hatena.ne.jp/higepon/")
                        (cell "naoya_t" "http://blog.livedoor.jp/naoya_t/")
                        (cell "g000001" "http://cadr.g.hatena.ne.jp/g000001")
                        (cell "佐野 匡俊" "http://xyzzy.s53.xrea.com/wiki/")
                        ((:tr) (:td))
                        ;; members
                        (midashi "メンバー") :newline
                        (:comment "member") 
                        :newline
                        (dolist (item m)
                          (destructuring-bind (name url &rest ignore) item
                            (declare (ignore ignore))
                            (cell (aif (position #\| name)
                                       (subseq name (1+ it))
                                       name) 
                                  url)))
                        ;; tail
                        ((:td :width 8)) ;スペーサ
                        ((:td :colspan 3 :align "left" :valign "top") "（アルファベット順。敬称略）")
                        ))))))))