diff --git a/src/blocks/placeholder.lisp b/src/blocks/placeholder.lisp
new file mode 100644
index 0000000..d0c92b1
--- /dev/null
+++ b/src/blocks/placeholder.lisp
@@ -0,0 +1,12 @@
+(uiop:define-package #:reblocks-text-editor/blocks/placeholder
+ (:use #:cl)
+ (:import-from #:common-doc
+ #:define-node))
+(in-package #:reblocks-text-editor/blocks/placeholder)
+
+
+(define-node placeholder (common-doc:document-node)
+ ()
+ (:tag-name "placeholder")
+ (:documentation "This node will be replaced by a real one with the same reference."))
+
diff --git a/src/document/ops.lisp b/src/document/ops.lisp
index c4f1959..6db4e20 100644
--- a/src/document/ops.lisp
+++ b/src/document/ops.lisp
@@ -21,6 +21,10 @@
#:length<
#:length>
#:slice)
+ (:import-from #:common-doc.ops
+ #:with-document-traversal)
+ (:import-from #:reblocks-text-editor/blocks/placeholder
+ #:placeholder)
(:local-nicknames (#:dom #:reblocks-text-editor/dom/ops)))
(in-package #:reblocks-text-editor/document/ops)
@@ -180,6 +184,8 @@
(error "Probably we should't get here.")))))
(common-doc:image
;; Just skip it
+ (setf last-visited-node-content-length
+ 0)
node))))
(recursive-find node)
@@ -364,7 +370,7 @@
(text-after-cursor (subseq plain-text (min cursor-position
(length plain-text))))
(new-paragraph (prepare-new-content document text-after-cursor)))
-
+
(cond
((and
;; When user presses Option + Enter, we want to stay within
@@ -642,6 +648,7 @@
"Parses text-nodes inside the tree as a scriba documents."
(flet ((parse (node depth)
(declare (ignore depth))
+ (log:error "TRAEA" node)
(typecase node
(common-doc:text-node
(let* ((text (common-doc:text node))
@@ -655,15 +662,21 @@
((length= 0 content)
node)
((length= 1 content)
-
- ;; If there we were able to split text into separate
- ;; nodes, then return them as a single content-node
- (let ((content-node (first content)))
- (if (and (typep content-node 'node-with-children)
- (serapeum:length< 1 (common-doc:children content-node)))
- content-node
- ;; otherwise just return original text node
- node)))
+
+ ;; Previously here was used this code, but
+ ;; I decided just return the first item
+ ;; because sometimes content might be a single @placeholder
+ ;; node when there is image or something like that is on the line.
+ ;;
+ ;; ;; If there we were able to split text into separate
+ ;; ;; nodes, then return them as a single content-node
+ ;; (let ((content-node (first content)))
+ ;; (if (and (typep content-node 'node-with-children)
+ ;; (serapeum:length< 1 (common-doc:children content-node)))
+ ;; content-node
+ ;; ;; otherwise just return original text node
+ ;; node))
+ (first content))
(t
(error "Why does content has more than one node? This is unexpected.")))))
(t node))))
@@ -682,6 +695,35 @@
;; (map-document root-node #'parse)))
+(defun replace-placeholders (editable-document root-node)
+ "Replaces PLACEHOLDER nodes inside the nodes tree starting from ROOT-NODE.
+
+ Usually ROOT-NODE will point to a new nodes, created from the current
+ paragraph, modified by a user.
+
+ Whereas EDITABLE-DOCUMENT is a full document. Replacements are
+ collected from the EDITABLE-DOCUMENT and matched to a placeholder by reference."
+
+ (let ((id-to-node (make-hash-table :test 'equal)))
+ (with-document-traversal (editable-document node)
+ (setf (gethash (common-doc:reference node) id-to-node)
+ node))
+
+ (map-document
+ root-node
+ (lambda (node depth)
+ (declare (ignore depth))
+ (cond
+ ((typep node 'placeholder)
+ (let* ((id (common-doc:reference node))
+ (replacement (gethash id id-to-node)))
+ (unless replacement
+ (error "Unable to find node to replace placeholder with id: ~S" id))
+ replacement))
+ (t
+ node))))))
+
+
(defun prepare-new-content (document text)
(let ((node
(cond
@@ -689,8 +731,10 @@
(common-doc:make-code-block nil
(common-doc:make-text +zero-width-space+)))
(t
- (parse-scriba-nodes
- (from-markdown text))))))
+ (replace-placeholders
+ document
+ (parse-scriba-nodes
+ (from-markdown text)))))))
(add-reference-ids document
:to-node node)))
@@ -830,7 +874,8 @@
caret-position)
(cond
(node
- (dom::move-cursor node new-caret-position :from-the-end from-the-end)
+ (dom::move-cursor node new-caret-position
+ :from-the-end from-the-end)
(setf (caret-position document)
(list node new-caret-position)))
(t
diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp
index bcbf37b..4f7b06c 100644
--- a/src/frontend/js.lisp
+++ b/src/frontend/js.lisp
@@ -108,6 +108,17 @@
(element
(chain document
(get-element-by-id element-id)))
+ (element-non-editable
+ (chain element
+ class-list
+ (contains "noneditable")))
+ (element-to-select (if element-non-editable
+ element
+ ;; Selecting the first text node
+ ;; inside the element:
+ (@ element
+ child-nodes
+ 0)))
(range (chain document (create-range)))
(sel (chain window (get-selection))))
@@ -115,9 +126,7 @@
(element
(chain range
(set-start
- (@ element
- child-nodes
- 0)
+ element-to-select
(if from-the-end
(- (chain element
inner-text
diff --git a/src/html.lisp b/src/html.lisp
index 795d2d3..bfc182a 100644
--- a/src/html.lisp
+++ b/src/html.lisp
@@ -51,18 +51,19 @@
(defmethod to-html ((node common-doc:content-node))
(let* ((node-type (class-of node))
- (tag (or (loop for key being the hash-key of common-doc::*registry*
- using (hash-value value)
- when (eql value node-type)
- do (return (or (alexandria:assoc-value *common-doc-key-to-html-tag* key
- :test #'string-equal)
- key)))
- "div")))
+ (tag (loop for key being the hash-key of common-doc::*registry*
+ using (hash-value value)
+ when (eql value node-type)
+ do (return (or (alexandria:assoc-value *common-doc-key-to-html-tag* key
+ :test #'string-equal)
+ key)))))
(reblocks/html:with-html
- ;; TODO: add a check that there is no nodes prohibited as a span's content
- (:tag :name tag
- :id (common-doc:reference node)
- (to-html (common-doc:children node))))))
+ (if tag
+ (:tag :name tag
+ :id (common-doc:reference node)
+ (to-html (common-doc:children node)))
+ ;; by default, content node has no HTML representation
+ (to-html (common-doc:children node))))))
(defmethod to-html ((node common-doc:unordered-list))
(reblocks/html:with-html
@@ -116,14 +117,6 @@
(common-doc:children node))))))))
-(defmethod to-html ((node common-doc:image))
- (reblocks/html:with-html
- (:img :id (common-doc:reference node)
- :class (html-class node)
- :src (common-doc:source node)
- :title (common-doc:description node))))
-
-
(defmethod to-html ((node commondoc-markdown/raw-html:raw-inline-html))
(reblocks/html:with-html
(:raw (commondoc-markdown/raw-html:html node))))
diff --git a/src/html/image.lisp b/src/html/image.lisp
new file mode 100644
index 0000000..c16d735
--- /dev/null
+++ b/src/html/image.lisp
@@ -0,0 +1,20 @@
+(uiop:define-package #:reblocks-text-editor/html/image
+ (:use #:cl)
+ (:import-from #:reblocks-text-editor/html
+ #:to-html
+ #:html-class))
+(in-package #:reblocks-text-editor/html/image)
+
+
+(defmethod to-html ((node common-doc:image))
+ (reblocks/html:with-html
+ (let ((classes (remove nil
+ (list "noneditable"
+ (html-class node)))))
+ (:img :id (common-doc:reference node)
+ :class (format nil "~{~A~^ ~}"
+ classes)
+ :src (when (slot-boundp node 'common-doc:source)
+ (common-doc:source node))
+ :title (when (slot-boundp node 'common-doc:description)
+ (common-doc:description node))))))
diff --git a/src/utils/markdown.lisp b/src/utils/markdown.lisp
index c2e6eb1..362ca22 100644
--- a/src/utils/markdown.lisp
+++ b/src/utils/markdown.lisp
@@ -31,18 +31,57 @@
result)))
+(defun replace-scriba-nodes-with-tmp-placeholders (text)
+ (let ((current-id 0)
+ (pieces (make-hash-table :test 'equal)))
+ (values
+ (cl-ppcre:regex-replace-all "@[^ ]+(\\[[^]]*\\])?\\([^)]*\\)" text
+ (lambda (text start end match-start match-end &rest rest)
+ (declare (ignore start end rest))
+ (let* ((matched (subseq text match-start match-end))
+ (id (incf current-id))
+ (replacement (format nil "SCRIBA-NODE-~A" id)))
+ (setf (gethash replacement pieces)
+ matched)
+ replacement)))
+ pieces)))
+
+
+(defun replace-placeholders-with-scriba-nodes (text pieces)
+ "Makes opposite to REPLACE-SCRIBA-NODES-WITH-TMP-PLACEHOLDERS."
+ (cl-ppcre:regex-replace-all "SCRIBA-NODE-[0-9]+" text
+ (lambda (text start end match-start match-end &rest rest)
+ (declare (ignore start end rest))
+ (let* ((matched (subseq text match-start match-end))
+ (scriba-node (gethash matched pieces)))
+ (unless scriba-node
+ (error "Unable to find Scriba node for placeholder ~S." matched))
+ scriba-node))))
+
+
(defun from-markdown (text)
- (let ((node (common-doc.format:parse-document (make-instance 'commondoc-markdown:markdown)
- text)))
- ;; This is a workaround for a bug inside commondoc-markdown or 3bmd
- ;; When it parses an empty text, it returns an empty CONTENT-NODE,
- ;; But we need a PARAGRAPH.
- (cond
- ((and (typep node 'common-doc:content-node)
- (null (common-doc:children node)))
- (common-doc:make-paragraph
- (list
- ;; Without this hack with
- ;; we'll be unable to put cursor into a new paragraph :(
- (common-doc:make-text reblocks-text-editor/utils/text::+zero-width-space+))))
- (t node))))
+ ;; We need this hack with Scriba nodes replacement because
+ ;; otherwise markdown parser will replace nodes like @some[ref=dsd]() with
+ ;; a web-link.
+ (multiple-value-bind (text-without-scriba-nodes scriba-nodes)
+ (replace-scriba-nodes-with-tmp-placeholders text)
+ (let ((node (common-doc.format:parse-document (make-instance 'commondoc-markdown:markdown)
+ text-without-scriba-nodes)))
+ (common-doc.ops:with-document-traversal (node current-node)
+ (when (typep current-node 'common-doc:text-node)
+ (let ((text (common-doc:text current-node)))
+ (setf (common-doc:text current-node)
+ (replace-placeholders-with-scriba-nodes text scriba-nodes)))))
+
+ ;; This is a workaround for a bug inside commondoc-markdown or 3bmd
+ ;; When it parses an empty text, it returns an empty CONTENT-NODE,
+ ;; But we need a PARAGRAPH.
+ (cond
+ ((and (typep node 'common-doc:content-node)
+ (null (common-doc:children node)))
+ (common-doc:make-paragraph
+ (list
+ ;; Without this hack with
+ ;; we'll be unable to put cursor into a new paragraph :(
+ (common-doc:make-text reblocks-text-editor/utils/text::+zero-width-space+))))
+ (t node)))))
diff --git a/src/utils/text.lisp b/src/utils/text.lisp
index 31b0945..69b9b00 100644
--- a/src/utils/text.lisp
+++ b/src/utils/text.lisp
@@ -25,7 +25,45 @@
""))))
+(defun %remove-tags (html-string)
+ (with-output-to-string (s)
+ (plump:traverse (plump:parse html-string)
+ (lambda (node)
+ (let* ((class-attr (when (plump:element-p node)
+ (plump:attribute node "class")))
+ (id (when (plump:element-p node)
+ (plump:attribute node "id")))
+ (classes (when class-attr
+ (str:split #\Space class-attr)) ))
+ (cond
+ ((plump:text-node-p node)
+ (write-string (plump:text node) s))
+ ((and (member "noneditable" classes
+ :test #'string=)
+ id)
+ (format s "@placeholder[ref=~A]()"
+ id))))))))
+
+
(defun remove-html-tags (html-string &key (remove-new-lines t))
+ (let* ((result (%remove-tags html-string)
+ ;; (cl-ppcre:regex-replace-all "<[^>]+>" html-string
+ ;; "")
+ )
+ (result (remove-zero-spaces-unless-string-is-empty result))
+ ;; TODO: check if we still need this:
+ (result (plump:decode-entities result))
+ (result (if remove-new-lines
+ ;; For some strange reason sometimes browser starts
+ ;; passing newlines even inside span elements. Why? Don't know.
+ ;; Thus by default we are removing new lines.
+ ;; However, when processing content of code blocks
+ ;; it is useful to keep newlines.
+ (str:replace-all '(#\Newline) "" result)
+ result)))
+ result))
+
+(defun remove-html-tags-old (html-string &key (remove-new-lines t))
(let* ((result (cl-ppcre:regex-replace-all "<[^>]+>" html-string
""))
(result (remove-zero-spaces-unless-string-is-empty result))
diff --git a/t/utils/text.lisp b/t/utils/text.lisp
index 81ecf3d..c9b2488 100644
--- a/t/utils/text.lisp
+++ b/t/utils/text.lisp
@@ -4,6 +4,7 @@
#:ok
#:deftest)
(:import-from #:reblocks-text-editor/utils/text
+ #:remove-html-tags
#:caret-position-from-beginning-of-the-line
#:move-caret-on-the-next-line))
(in-package #:reblocks-text-editor-tests/utils/text)
@@ -39,3 +40,17 @@ second line
middle line
last line" 17)))
(ok (= pos 3))))
+
+
+
+(deftest test-remove-html-tags-1
+ (let ((result (remove-html-tags "Text other"))
+ (expected "Text other"))
+ (ok (equal result expected))))
+
+
+(deftest test-remove-html-tags-2
+ "It should replace noneditable nodes with a Scriba placeholder."
+ (let ((result (remove-html-tags "![](\"foo\")
other"))
+ (expected "@placeholder[ref=some-ref]() other"))
+ (ok (equal result expected))))