Yellow Rabbit

DOM и первые узлы документа

Web-движок на Lisp: игрушечная реализация

Что происходит внутри браузеров? Как эта куча тэгов превращается в такие изумительные страницы на экране? Магия. Попробую изобразить что-то примитивное для отображения HTML.

Теория

Здесь всё просто: читаем серию статей об игрушечном вэб движке. А дальше я буду повторять только самый минимум.

Первый шаг: DOM

DOM (объектная модель документа) это дерево узлов. Узел имеет ноль или больше потомков. Потомки храним как простой список. Понятно, что список очень плохо масштабируется, но вероятно для игрушечного движка это не будет проблемой.

И самое главное — знакомимся с CLOS!


(defclass node ()
  ((children :accessor node-children
	     :initform '()
	     :initarg :children)))

Добавление потомка достаточно простое, хотя возможно, что обратный порядок потомков в списке и скажется в будущем. В таком случае просто изменим метод.


(defgeneric node-add-child (tree-node child)
	    (:method ((tree-node node) (child node))
		     (setf (node-children tree-node)
			   (push child (node-children tree-node)))))

Существует много типов узлов, но игрушечный движок будет использовать только несколько. Просто текст:


;; Text is a simplest node.
;; Just string of text.
(defclass text-node (node)
  ((text :accessor text-node-text
	 :initform ""
	 :initarg :text)))

Далее элемент или таг и его атрибуты. Атрибуты хранятся в хэш-таблице:


;; Element represents all remaining types of nodes (joke).
;; Tag name and any number of attributes.
(defclass element-node (node)
  ((tag :accessor element-node-tag
	:initform ""
	:initarg :tag)
   (attrs :reader element-node-attrs
	  :initform (make-hash-table :test #'equal))))  ; "key" --- "value", they are strings
							; so use "equal"

Ну и комментарий:


;; Comment
(defclass comment-node (node)
  ())

Отладочная картинка

Для визуализации дерева, которое будет строится по HTML документу напишем пару функций, создающих файл для Graphviz:

Допустим имеем простой HTML файл:


<html class=e>
 <head><title>Aliens?</title></head>
 <body>Why yes.</body>
</html>

Поскольку парсер HTML ещё даже не в проекте, то сделаем дерево руками:


(ql:quickload :toy-engine)
(in-package :toy-engine)
; <html class="e">
(defparameter *root* (make-instance 'element-node :tag "html"))
(setf (gethash "class" (element-node-attrs *root*)) "e")
; <head>
(defparameter *head* (make-instance 'element-node :tag "head"))
(node-add-child *root* *head*)
; <title>
(node-add-child *head* (make-instance 'element-node :tag "title"))
; Aliens?
(node-add-child (car (node-children *head*)) (make-instance 'text-node :text "Aliens?"))
; <body>
(defparameter *body* (make-instance 'element-node :tag "body"))
(node-add-child *root* *body*)
; Why yes.
(node-add-child *body* (make-instance 'text-node :text "Why yes."))

; 
(pp->dot #p"~/tmp/part1.dot" (lambda () (pp-dom *root*)))


После прогона через Graphviz получим такое изображение дерева:

Дерево, часть 1


;;; ========================
;;; Pretty-print a DOM tree.
;;; ========================
(defgeneric pp-node-title (tree-node)
	    (:documentation "What to print in the node box.")
	    (:method ((tree-node node))
		     "!empty!")
	    (:method ((tree-node text-node))
		     (text-node-text tree-node))
	    (:method ((tree-node element-node))
		     (let ((s (concatenate 'string (element-node-tag tree-node) "|")))
		       (concatenate 'string s
				    (with-output-to-string (out)
				      (maphash #'(lambda (k v)
						   (format out "~a:~a," k v))
					       (element-node-attrs tree-node)))
				    "|")))
	    (:method ((tree-node comment-node))
		     "!comment!"))

(defgeneric pp-node-class (tree-node)
	    (:documentation "Enumerate classes of nodes.")
	    (:method ((tree-node node))         "N")
	    (:method ((tree-node text-node))    "T")
	    (:method ((tree-node element-node)) "E")
	    (:method ((tree-node comment-node)) "C"))

(defun pp-dom (root-node)
  "Print DOM tree in the nice way."
  (let ((nodes (make-hash-table))                ; node object --- seq.id
	(types (make-hash-table :test #'equal))) ; node class --- new sq.id
	(labels
	  ((new-seq.id (node)
		       "New sequentual id for class object."
		       (if (gethash (pp-node-class node) types)
			 (incf (gethash (pp-node-class node) types))
			 (setf (gethash (pp-node-class node) types) 0)))
	   (seq.id (node)
		   "Id by object"
		   (let ((id (gethash node nodes)))
		     (if id
		       id
		       (setf (gethash node nodes) (new-seq.id node)))))
	   (pp-node-name (node)
			 "Make node name for graphwizard."
			 (format nil "~a~d" (pp-node-class node) (seq.id node)))
	   (pp-node (node)
		    "Print one node."
		    (let
		      ((name (pp-node-name node)))
		      (format t "~a[label=~s];~%" name
			    (concatenate 'string name ":" (pp-node-title node)))
		      (mapc #'(lambda (x)
				(progn
				  (format t "~a -> ~a~%" name (pp-node-name x))
				  (pp-node x)))
			    (node-children node)))))
	  (write-string "digraph dom {label=\"DOM tree\";node [color=lightblue2, style=filled];")
	  (pp-node root-node)
	  (write-string "}"))))

(defun pp->dot (fname thunk)
  "Run the thunk and write any it's output to file."
  (with-open-file (*standard-output*
		    fname
		    :direction :output
		    :if-exists :supersede)
    (funcall thunk)))