Новая версия сайта, доступна здесь.
LISP в HTML
Все коды на этом сайте, оформлены в едином стиле, похожем на стиль LISP редактора, встроенного в AutoCAD. Надеюсь, это поможет чтению и пониманию кода. Ниже, я предлагаю ознакомиться с кодом, добавляющим необходимые теги стиля, в страницу.
Идея программы, взята у моего друга Chen Qing Jun из Китая. Он преподает в South China University of Technology в отделе гражданского строительства. Он хороший программист, и интересный человек!
Результаты работы программы, вы можете увидеть ниже.
;; web-04.lsp (defun ea_lsp-html (f / a fl i l rf s str w wf) ;| ***************************************************************************************** * * by ElpanovEvgeniy * * Idea of program Chen Qing Jun * last version 2007-06-10 * yuanqiu@gmail.com * * My version 20.11.2008 * * Examples: * (ea_lsp-html (getfiled "Select a Lisp File" "D:\\Work\\" "lsp" 8)) * (ea_lsp-html f) * ***************************************************************************************** |; (setq rf (open f "r") wf (open (strcat (vl-filename-directory f) "/" (vl-filename-base f) ".html") "w" ) ;_ open ) ;_ setq (write-line (STRCAT ;;; <s0> - ( ;;; <s1> - subr ;;; <s2> - "\"" ;;; <s3> - 'int ;;; <s4> - 'real ;;; <s5> - 'usubr ;;; <s6> - ; ;||; ;; ;;; <s7> - ; "'" ;;; Добвляем заголовок и стили, для локального просмотра "<html><head><style> pre { font-family: Courier, Verdana, Arial, sans-serif; color: black; font-size: 12pt; font-weight: 600; overflow: auto; border-left: 3px solid #d0d0f0; margin-left: 5px; padding-left: 10px; /*height: 800px; Высота блока */ } .s0 {color: red;} .s1 { font-family: Courier, Verdana, Arial, sans-serif; color: blue; font-size: 12pt; font-weight: 600; } .s2 {color: #FF00FF;} .s3 {color: #00CC00;} .s4 {color: #009900;} .s5 {color: #0000ff;} .s6 {color: purple; background:#C0C0C0;} .s7 {color: #800000;} </style><title>" (VL-FILENAME-BASE f) (VL-FILENAME-EXTENSION f) "</title></head>\n<body><h3>" (VL-FILENAME-BASE f) (VL-FILENAME-EXTENSION f) "</h3><pre>" ) ;_ strcat wf ) ;_ write-line (setq l (list (strcase (strcat ";;\t" (VL-FILENAME-BASE f) (VL-FILENAME-EXTENSION f)) t) ) ;_ list ) ;_ setq (while (car (setq l (cons (read-line rf) l)))) (setq l (reverse (cdr l)) s (car l) i 0 l (cdr l) str "" ) ;_ setq (while s (progn (cond ((= (setq a (ascii s)) 0) ;; пустая строка (write-line (strcat str "\n") wf) (setq s (car l) l (cdr l) str "" ) ;_ setq ) ((or (= a 32) (= a 9)) ;; пробелы и табуляция (setq str (strcat str (substr s 1 1)) s (substr s 2) i 0 ) ;_ setq ) ((or (= a 39) (= a 46)) ;; апостроф (setq str (strcat str "<span class=s7>" (substr s 1 1)) s (substr s 2) ) ;_ setq (while (= (ascii s) 39) (setq str (strcat str (substr s 1 1)) s (substr s 2) ) ;_ setq ) ;_ while (setq str (strcat str "</span>")) ) ((< 39 a 42) ;; скобки (setq str (strcat str "<span class=s0>" (substr s 1 1)) s (substr s 2) ) ;_ setq (while (< 39 (ascii s) 42) (setq str (strcat str (substr s 1 1)) s (substr s 2) ) ;_ setq ) ;_ while (setq str (strcat str "</span>")) ) ((= a 59) ;; многострочные коментарии (if (= (substr s 2 1) "|") ;;(ищем конец коментариев.. (progn (setq str (strcat str "<span class=s6>")) (while (and s (not (setq i (vl-string-search "|;" s)))) (write-line (strcat str s) wf) (setq s (car l) l (cdr l) str "" ) ;_ setq ) ;_ while (setq str (strcat (substr s 1 (+ 2 i)) "</span>")) (setq s (substr s (+ 3 i))) ) ;_ progn (progn (write-line (strcat str "<span class=s6>" s "</span>") wf) (setq s (car l) l (cdr l) str "" ) ;_ setq ) ;_ progn ) ;_ if ) ((= a 34) ;; текстовые строки (progn (setq str (strcat str "<span class=s2>") i 0 fl t ) ;_ setq (while (and s fl) (while (and s (setq i (vl-string-search "\"" s (setq i (1+ i)))) (not (or (zerop i) (not (= (substr s i 1) "\\")) (= (substr s (1- i) 2) "\\\\") ) ;_ or ) ;_ not ) ;_ and ) ;_ while (if (null i) (setq str (strcat str s "\n") s (car l) l (cdr l) i -1 ) ;_ setq (setq str (strcat str (substr s 1 (1+ i)) "</span>") s (substr s (+ 2 i)) fl nil i 0 ) ;_ if ) ;_ if ) ;_ while ) ;_ progn ) ((progn (setq i (apply (function min) (vl-remove-if (function null) (list (vl-string-search "(" s) (vl-string-search ")" s) (vl-string-search " " s) (vl-string-search "\t" s) (vl-string-search "'" s) (vl-string-search ";" s) (vl-string-search "\"" s) (strlen s) ) ;_ list ) ;_ vl-remove-if ) ;_ apply w (substr s 1 i) s (substr s (1+ i)) ) ;_ setq (or (= (setq a (type (eval (read w)))) 'subr) (= (strcase w) "NIL") (= (strcase w) "T") ) ;_ or ) ;_ progn (setq str (strcat str "<span class=s1>" w "</span>")) ) ((= a 'usubr) (setq str (strcat str w))) ((= a 'int) (setq str (strcat str "<span class=s3>" w "</span>")) ) ((= a 'real) (setq str (strcat str "<span class=s4>" w "</span>")) ) (t (setq str (strcat str w))) ) ;_ cond s ) ;_ progn (if (and s (= (ascii s) 0)) (progn (write-line str wf) (setq s (car l) l (cdr l) str "" i 0 ) ;_ setq ) ;_ progn ) ;_ if ) ;_ while (write-line "</pre></body></html>" wf) (close rf) (close wf) ) ;_ defun