Новая версия сайта, доступна здесь.




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