Corrected behaviour when editing a paragraph containing an image.

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."))
+

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,15 +695,46 @@
 ;;     (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
             ((string= text "```")
              (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

src/frontend/js.lisp

@@ -108,16 +108,25 @@
                (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))))
 
           (cond
             (element
              (chain range
                     (set-start
-                     (@ element
-                        child-nodes
-                        0)
+                     element-to-select
                      (if from-the-end
                          (- (chain element
                                    inner-text

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))))

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))))))

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)))))

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))

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 "<i><strong>Text</strong> other</i>"))
+        (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 "<i><img src=\"foo\" class=\"noneditable\" id=\"some-ref\"/> other</i>"))
+        (expected "@placeholder[ref=some-ref]() other"))
+    (ok (equal result expected))))