在组织磁盘文件的时候，想到HTML web的超级链接对知识有帮助，利用书籍《 Practical Common Lisp》中的可移植的文件系统库 。
实现了遍历e盘的图像文件夹，生成多个网页文件，并收集所有的html后缀文件生成超链接。
知识点：HTML编辑，文件系统遍历，Common Lisp 宏
代码如下：
(defparameter *metas-alist* '(("keywords" . "前端开发,后端开发" )
("description" . "Web技术" )
("author" . "mklp.麦克雷帕" )
("copyright" . "版权所有，侵权必究。" )))
(defparameter *lines-alist* '(("h3" . "诗一首")
("p" . "月光光，照亮归家的道路。")
("p" . "路漫漫，永远的逆水行舟。")))
(defparameter *links-alist* '(("home.html" . "Home Pages")
("https://home.cnblogs.com/u/mklp/" . "My blogs")))
(defparameter *file-pointer* nil)
;;; 参考 Practical Common Lisp可移植的文件系统库
(defun picture-p (file)
(or (file-type-p file "jpg")
(file-type-p file "jpeg")
(file-type-p file "png")))
(defmacro one-line-html (key<> str<>)
`(format *file-pointer* "<~(~A~)>~A</~(~A~)>~%" ',key<> ,str<> ',key<>))
(defmacro with-lines-html (key<> &rest body<>)
`(progn (format *file-pointer* "~&<~(~A~)>~%" ',key<>)
,@body<>
(format *file-pointer* "~&</~(~A~)>~%" ',key<>)))
(defmacro lines-html-alist (alist<>)
`(loop for (key<> . str<>) in ,alist<>
do (format *file-pointer* "<~A>~A</~A>~%" key<> str<> key<>)))
(defmacro metas-html-alist (alist<>)
`(loop for (name<> . content<>) in ,alist<>
do (format *file-pointer* "<meta name=~S content=~S/>~%" name<> content<>)))
(defmacro links-html-alist (alist<>)
`(loop for (link<> . title<>) in ,alist<>
do (format *file-pointer* "<a href=~S>~%<b>~A~%</b>~%</a>" link<> title<>)))
(defmacro html-page-output (file<> title<> &rest body<>)
`(with-open-file (out (format nil "~(~A~).html" ,file<>)
:direction :output
:if-does-not-exist :create
:if-exists :supersede)
(setf *file-pointer* out)
(format *file-pointer* "<!DOCTYPE html>~%")
(with-lines-html "html"
(with-lines-html "head"
(one-line-html "title" ,title<>)
(format *file-pointer* "~&<meta charset=~S>~%" "utf-8")
(metas-html-alist *metas-alist*))
(with-lines-html "body"
(one-line-html "h1" "Contents")
,@body<>
(one-line-html "h1" "Others Useful Links")
(links-html-alist *links-alist*)
(lines-html-alist *lines-alist*)))
)
)
(defun html-file-ouput (file<> )
(html-page-output file<> file<> (walk-directory (format nil "e:/look/picture/~(~A~)/" file<>)
(lambda (xx) (format *file-pointer* "~% <img src=~S alt=~S title=~S width=~S />~% " (namestring xx) (namestring xx) (namestring xx) "900"))
:test #'picture-p))
)
(walk-directory "e:/look/picture/"
(lambda (xx) (html-file-ouput (pathname-name (pathname-as-file xx))))
:directories T
:test #'directory-pathname-p)