[63] | 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 | |
---|