javascriptをいじってたらIEで動かなくなってしまった。
Win7 64nit + CCL + Chrome で動作確認。
いまいちセッションの取り扱いがわからない。
一人用だし、グローバル変数にぶち込んで使うのもありかな？
parenscriptを使ってみようと呼び出してるけど使っていない。
*default-directory* を設定して、ファイルを配置して load したら、(2ch-editor:start-2ch-server)で localhost:8080で使用可能。
名前がeditorってなってるのは、まとめブログの支援ツールにしようと思ったんだけど、セッションがわからなかったので断念したから。。。
2ch-view.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :hunchentoot)
(require :cl-who)
(require :drakma)
(require :jp)
(require :cl-ppcre)
(require :parenscript))
(defpackage :2ch-editor
(:use :cl :hunchentoot :cl-who :drakma :jp :cl-ppcre :parenscript)
(:shadow :COOKIE-VALUE
:*HEADER-STREAM*
:PARAMETER-ERROR
:COOKIE-NAME
:COOKIE-DOMAIN
:COOKIE-PATH
:COOKIE-EXPIRES)
(:export #:main #:start-2ch-server #:stop-2ch-server))
;; 参考
;; Common Lisp で Web アプリを作るためのブランクプロジェクト
;; http://read-eval-print.blogspot.com/2011/02/common-lisp-web.html
(in-package :2ch-editor)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 環境設定
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *default-directory*
(pathname "c:/export/home/clisp/2ch-web/")
"このファイルがあるディレクトリを指定")
(defparameter *js-path* (merge-pathnames "js/" *default-directory*)
"JavaScript 用ディレクトリ")
(defparameter *css-path* (merge-pathnames "css/" *default-directory*)
"スタイルシート用ディレクトリ")
;; 文字コードを設定
(setf
;; for utf-8
hunchentoot:*hunchentoot-default-external-format* (flexi-streams:make-external-format :utf-8)
hunchentoot:*default-content-type* "text/html; charset=utf-8"
;; for debug
hunchentoot:*catch-errors-p* nil)
;; スタイルシートと、javascriptディレクトリをアクセス可能にする。
(setf hunchentoot:*dispatch-table*
(list
'hunchentoot:dispatch-easy-handlers
(hunchentoot:create-folder-dispatcher-and-handler "/css/" *css-path*)
(hunchentoot:create-folder-dispatcher-and-handler "/js/" *js-path*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 汎用関数
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *port8080-acceptor* (make-instance 'hunchentoot:acceptor :port 8080)
"hunchentootの起動ポートを指定する")
(defun start-2ch-server ()
"Web サーバ起動"
(start *port8080-acceptor*))
(defun stop-2ch-server ()
"Web サーバ停止"
(stop *port8080-acceptor*))
(defmacro with-default-template ((&key (title "題名")
(charset "UTF-8")) &body body)
"ページのテンプレート"
`(with-html-output-to-string (out nil :indent t :prologue t)
(htm (:html :lang "ja"
(:head
(:meta :charset ,charset :http-equiv "Content-Type" :content="text/html")
(:title ,title)
(:link :rel "stylesheet" :href "css/main.css" :media "all")
(:script :type "text/javascript" :scr "js/prototype.js")
(:script :type "text/javascript" :src "js/main.js"))
(:body ,@body)))))
;; 各スレッドの情報を格納する
(defclass res ()
((num :initarg :num)
(name :initarg :name)
(mail :initarg :mail)
(date :initarg :date)
(text :initarg :text)
(flag :initarg :flag)))
(defun http-request-jp (url)
"ページをバイナリで取得しデコードして表示する。たまに変な文字コードが混ざるので消しておく"
(delete #\Return (jp:decode (http-request url :force-binary t) :guess)))
(defun delete-html-tag (text)
"タグを除去する"
(cl-ppcre:regex-replace-all "<[/a-zA-Z]+>" text ""))
(defvar *thread-db* nil
"編集済みのスレッド情報を格納する変数")
(defvar *thread-db-path* "thread.db"
"スレッドDBのパス")
(defun load-thread-db ()
"スレッドDBをロードする。"
)
(defun save-thread-db ()
"スレッドDBをセーブする。"
)
(defun main ()
"メイン処理を開始する"
(load-thread-db)
(start-2ch-server))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; トップページ /
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-bbslist-from-bbmenu ()
"bbsmenuから余分なHTMLを削除したリストのリストを得る。この時点ではアンカータグは残っている"
(mapcar #'(lambda (x) (cl-ppcre:split #\Linefeed x))
(remove-if #'(lambda (x) (cl-ppcre:scan "(<HTML>|</HTML>|まちＢＢＳ|ツール類|チャット|-->)" x))
(cl-ppcre:split "<BR><BR>" (http-request-jp "http://menu.2ch.net/bbsmenu.html")))))
(defun edit-bbssublist (bbslist)
"カテゴリ別のリストを受け取り、タグを削除する"
(loop for i in bbslist
collect (mapcar #'(lambda (x) (delete-tag-from-a-bbsmenu x)) i)))
(defun delete-tag-from-a-bbsmenu (text)
"BBSMENUのタグを削除する"
(cond
((cl-ppcre:scan "(<B>|</B>)" text)
(cl-ppcre:register-groups-bind (first) ("<B>(.+)</B>" text)
first))
((cl-ppcre:scan "<A HREF=http://.+\\.2ch\\.net/.+/>" text)
(cl-ppcre:register-groups-bind (url bkey name) ("<A HREF=(http://.+\\.2ch\\.net/)(.+)/>(.+)</A>" text)
(list name url bkey)))
((cl-ppcre:scan "<A HREF=http://.+\\.bbspink\\.com/.+>" text)
(cl-ppcre:register-groups-bind (url bkey name) ("<A HREF=(http://.+\\.bbspink\\.com/)(.+)/>(.+)</A>" text)
(list name url bkey)))
(t nil)))
(defun root-html ()
"トップページを生成"
(with-default-template (:title "板一覧")
(loop for category in (edit-bbssublist (get-bbslist-from-bbmenu))
for counter from 1 to 1000
do (progn
(htm
(:table :border 0 ;; :style "float:left;"
(loop for i in category
for j from 1 to 1000
do (if i
(if (not (listp i))
(htm (:tr (:td (:div :onclick (concatenate 'string
"javascript:menushow(" (princ-to-string counter) ");")
(:b (:font :color "gray" (str "■") (str i)))))))
(htm (:tr :style "display:none;"
:name (concatenate 'string "counter" (princ-to-string counter))
:id (concatenate 'string "counter_" (princ-to-string counter) "_" (princ-to-string j))
(:td (:a :href (concatenate 'string
"index?url="
(url-encode (second i))
"&bkey="
(url-encode (third i))
"&title="
(url-encode (first i)))
(str (first i)))))))))))
))))
;; トップページを作成
(define-easy-handler (top :uri "/") ()
(setf (hunchentoot:content-type*) "text/html; charset=utf-8")
(root-html))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; スレッド一覧 /index
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-thread-subject (url bkey)
"スレッド一覧を取得する"
(let ((burl (concatenate 'string url bkey "/subject.txt")))
(http-request-jp burl)))
(defun make-thread-list (text)
"取得したスレッドをリストに分解する"
(let ((var (mapcar #'(lambda (x) (cl-ppcre:split "<>" x))
(cl-ppcre:split #\LineFeed text))))
(loop for i in var
collect (cl-ppcre:register-groups-bind (title num)
("\(\^.+\)\\(\([0-9]+\)\\)$" (second i))
(list (first i) title num)))))
(defun make-thread-html (list url bkey title)
"スレッド一覧を表示するHTMLを構築"
(with-default-template (:title "スレッド一覧")
(htm (:font :color "red" (str title)) :br)
(htm (:table :border 0
(loop for (dat title num) in list
do (htm (:tr
:onmouseover "this.style.background=\"#FFFACD\""
:onmouseout "this.style.background=\"#ffffff\""
(htm (:td :align "right" (str num)))
;; (htm (:td (:a :href (concatenate 'string "edit?"
;; "dat=" (url-encode dat)
;; "&url=" (url-encode url)
;; "&bkey=" (url-encode bkey))
;; :target "_blank" (:font :size "-1" (str "編集")))))
(htm (:td))
(htm (:td (:a :href (concatenate 'string "view?"
"dat=" (url-encode dat)
"&url=" (url-encode url)
"&bkey=" (url-encode bkey))
:target "_blank" (str title)))))))
))))
(defun index-html (url bkey title)
"スレッド一覧を表示する。"
(make-thread-html (make-thread-list (get-thread-subject url bkey)) url bkey title))
(define-easy-handler (index :uri "/index") (url bkey title)
(setf (hunchentoot:content-type*) "text/html; charset=utf-8")
(index-html url bkey title))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; スレッドビュー /view
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get-thread-dat (url bkey dat)
"スレッドDATを取得する。"
(let ((burl (concatenate 'string
(url-decode url)
(url-decode bkey) "/dat/"
(url-decode dat))))
(http-request-jp burl)))
(defun make-thread-res-list (text)
"DATを分解して配列に格納する。"
(let ((i 1)
(result nil))
(loop for res in (cl-ppcre:split #\LineFeed text)
do (let ((temp (cl-ppcre:split "<>" res)))
(when (= i 1)
(push (make-instance 'res :num 0 :text (car (last temp))) result)
(push (make-instance 'res
:num i
:name (delete-html-tag (first temp))
:mail (second temp)
:date (third temp)
:text (fourth temp)
:flag nil) result))
(when (not (= i 1))
(push (make-instance 'res
:num i
:name (delete-html-tag (first temp))
:mail (second temp)
:date (third temp)
:text (fourth temp)
:flag nil) result))
(incf i)))
(reverse result)))
(defun thread-html (url bkey dat)
"スレッドを展開してHTML化"
(let ((res (make-thread-res-list (get-thread-dat url bkey dat))))
(setf (session-value 'thread-data) res)
(with-default-template (:title "スレエディット")
(htm
(loop for i in res
do (cond
((= 0 (slot-value i 'num))
(htm (:a :href
(concatenate 'string url "test/read.cgi/" bkey "/" (cl-ppcre:regex-replace "\\.dat$" dat ""))
:target "_blank"
(:font :color "red" (:b (str (slot-value i 'text)))) :br :br)))
(t (progn
(htm (:hr)
(:div :id (concatenate 'string "thread" (princ-to-string (slot-value i 'num)))
:onmouseover "this.style.background=\"#FFFACD\""
:onmouseout "this.style.background=\"#ffffff\""
(:dl (:dt
(htm (str (slot-value i 'num))
(:b :style "color:forestgreen;" (str (slot-value i 'name)))
(str (concatenate 'string "[" (slot-value i 'mail) "] "))
(str (slot-value i 'date)) :br))
(htm (:dd (str (slot-value i 'text)) :br :br)))))))))))))
(define-easy-handler (view :uri "/view") (url bkey dat)
(setf (hunchentoot:content-type*) "text/html; charset=utf-8")
(thread-html url bkey dat))
main.js
function resDispSwitch(num)
{
var foo = document.getElementById('thread' + num);
foo.style.display =
(foo.style.display == 'none')
? 'block' : 'none';
}
function selectRes(num)
{
var foo = document.getElementById('selectRes' + num);
foo.checked =
(foo.checked == true)
? false : true;
}
function menushow(num)
{
var elements = document.getElementsByName('counter' + num);
for (var i = 0; i < elements.length; i ++) {
elements[i].style.display =
(elements[i].style.display == 'none' )
? 'block' : 'none';
}
}
0 件のコメント:
コメントを投稿