ソースコードをHTML表示用に整形するLISPver0.3

ソースコードをHTML表示用に整形するLISPver0.2 - Shammerismの続きで、空白、というか半角スペースを にするようにした。あと、インデントも入れるつもりだったが、よくよく考えてみるとオリジナルのソースコードの方で既にインデントはされているはずなので、インデントは考えないことにした。

(defun tr (&rest contents)
  (let ((line "<tr>"))
    (cond ((typep contents 'string)
	   (setf line (concatenate 'string line contents)))
	  ((typep contents 'list)
	   (dolist (x contents)
	     (setf line (concatenate 'string line x)))))
    (concatenate 'string line "</tr>~%")))
       
(defun td (contents &optional is-first-line rows)
  (let ((line "<td"))
    (when is-first-line
      (setf line
	    (concatenate 'string
			 line
			 " rowspan=\""
			 rows
			 "\" style=\"width: 1pm; height: 12px; background-color:green;\"")))
    (setf line (concatenate 'string line ">" contents "</td>"))))

(defun escape-html-character (contents)
  (if (typep contents 'string)
	(let ((return-contents (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
	  (dolist (x (coerce contents 'list))
	    (cond ((string-equal x " ")
		   (vector-push-extend (coerce "&" 'character) return-contents)
		   (vector-push-extend (coerce "n" 'character) return-contents)
		   (vector-push-extend (coerce "b" 'character) return-contents)
		   (vector-push-extend (coerce "s" 'character) return-contents)
		   (vector-push-extend (coerce "p" 'character) return-contents)
		   (vector-push-extend (coerce ";" 'character) return-contents))
		  (t
		   (vector-push-extend (coerce x 'character) return-contents))))
	  (coerce return-contents 'string))
    contents))

(let ((line-list nil)
      (file-name (first *unprocessed-command-line-arguments*)))
  (format t "<table border='0'>~%")
  (with-open-file (input-stream file-name :direction :input)
		  ;;;; Reading file and structure list by all lines
		  (loop
		   (let ((line (read-line input-stream nil 'eof)))
		     (if (eql line 'eof) (return))
		     (setf line-list
			   (append line-list
				   (cons (escape-html-character line)
					 nil)))))
		  ;;;; output all lines as html
		  (do ((i 1 (+ i 1)))
		      ((null line-list))
		    (format t (tr (td (write-to-string i))
				  (when (equal i 1)
				    (td ""
					t
					(write-to-string (length line-list))))
				  (td (first line-list))))
		    (setf line-list (cdr line-list)))
		  (format t "</table>~%")))
(quit)

実際に生成されたサンプルは以下。

<table border='0'>
<tr><td>1</td><td rowspan="10" style="width: 1pm; height: 12px; background-color:green;"></td><td>#include&nbsp;<stdio.h></td></tr>
<tr><td>2</td><td>#include&nbsp;<string.h></td></tr>
<tr><td>3</td><td></td></tr>
<tr><td>4</td><td>int&nbsp;main(int&nbsp;argc,&nbsp;char&nbsp;*&nbsp;args[]){</td></tr>
<tr><td>5</td><td>&nbsp;&nbsp;&nbsp;&nbsp;char&nbsp;*&nbsp;value;</td></tr>
<tr><td>6</td><td>&nbsp;&nbsp;&nbsp;&nbsp;printf("Type&nbsp;message:");</td></tr>
<tr><td>7</td><td>&nbsp;&nbsp;&nbsp;&nbsp;fgets(value,&nbsp;sizeof(value),&nbsp;stdin);</td></tr>
<tr><td>8</td><td>&nbsp;&nbsp;&nbsp;&nbsp;printf("%s\n",&nbsp;value);</td></tr>
<tr><td>9</td><td>&nbsp;&nbsp;&nbsp;&nbsp;return&nbsp;0;</td></tr>
<tr><td>10</td><td>}</td></tr>
</table>

> や < の対応が必要だが、その前に vector-push-extend がずらずら続いているのを綺麗にしたい。label か flet を使用してサッパリさせられればと思う。あまり使ったことがないから、これらの機能についてもちょっと調べないとな。