More tests on update-node-content generic-function.

reblocks-text-editor-tests.asd

@@ -1,7 +1,9 @@
 (defsystem "reblocks-text-editor-tests"
   :class :package-inferred-system
   :pathname "t"
-  :depends-on ("reblocks-text-editor-tests/document/ops")
+  :depends-on ("reblocks-text-editor-tests/document/ops"
+               "reblocks-text-editor-tests/utils/text"
+               "reblocks-text-editor-tests/typed-pieces/scribdown")
   :perform (test-op (o c)
                     (unless (symbol-call :rove '#:run c)
                       (error "Tests failed"))))

src/blocks/code.lisp

@@ -0,0 +1,41 @@
+(uiop:define-package #:reblocks-text-editor/blocks/code
+  (:use #:cl)
+  (:import-from #:reblocks-text-editor/document/ops
+                #:map-document))
+(in-package #:reblocks-text-editor/blocks/code)
+
+
+(defun code (node)
+  (check-type node common-doc:code-block)
+  (let ((children (common-doc:children node)))
+    (if children
+        (common-doc:text (first children))
+        "")))
+
+
+(defun normalize (root-node)
+  "Normalizes code-block nodes by joining it's children into a single text-node.
+
+   This helper is required until this issue will be resolved:
+
+   https://github.com/CommonDoc/scriba/issues/15"
+  (labels ((normalize-code-blocks (current-node depth)
+             (declare (ignore depth))
+             (when (typep current-node 'common-doc:code-block)
+               (let ((children (common-doc:children current-node)))
+                 (when (not (and (= (length children) 1)
+                                 (typep (first children)
+                                        'common-doc:text-node)))
+                   (setf (common-doc:children current-node)
+                         (list (squash current-node))))))
+             current-node)
+           (squash (code-block)
+             (common-doc:make-text
+              (with-output-to-string (s)
+                (common-doc.ops:with-document-traversal (code-block node)
+                  (etypecase node
+                    (common-doc:text-node
+                     (write-string (common-doc:text node) s))
+                    (common-doc:content-node
+                     nil)))))))
+    (map-document root-node #'normalize-code-blocks)))

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/blocks/progress.lisp

@@ -0,0 +1,27 @@
+(uiop:define-package #:reblocks-text-editor/blocks/progress
+  (:use #:cl)
+  (:import-from #:common-doc
+                #:define-node))
+(in-package #:reblocks-text-editor/blocks/progress)
+
+
+(define-node progress (common-doc:document-node)
+             ((percent :initform 0
+                       :accessor percent))
+  (:tag-name "progress")
+  (:documentation "This node will be replaced by a real one with the same reference."))
+
+
+(defmethod reblocks-text-editor/html::to-html ((node progress))
+  (let ((percent (ceiling (percent node))))
+    (let  ((reblocks/html:*pretty-html* nil))
+      (reblocks/html:with-html
+        (:span :id (common-doc:reference node)
+               :class "noneditable progress"
+               :style "display:inline-block; background-color: #83c6ff; width: 100px; height: 0.8em; line-height: 0.8em"
+               (:span :style (format nil
+                                     "display: inline-block; background-color: #2dd12d; width: ~A%; height: 100%"
+                                     percent)))))))
+
+
+(defmethod scriba.emitter:emit ((node progress) stream))

src/document/copying.lisp

@@ -45,6 +45,9 @@
 (metacopy:defcopy-methods commondoc-markdown:markdown-link
   :copy-all t)
 
+(metacopy:defcopy-methods common-doc:image
+  :copy-all t)
+
 (metacopy:defcopy-methods common-doc:text-node
   :copy-all t)
 
@@ -55,4 +58,13 @@
 (defmethod metacopy:copy-one ((obj quri.uri.http:uri-http) copy-hash)
   (quri:copy-uri obj))
 
+(defmethod metacopy:copy-one ((obj quri.uri:uri) copy-hash)
+  (quri:copy-uri obj))
+
+(defmethod metacopy:copy-one ((obj quri.uri:urn) copy-hash)
+  (quri:copy-uri obj))
+
+(defmethod metacopy:copy-one ((obj quri.uri.file:uri-file) copy-hash)
+  (quri:copy-uri obj))
+
 

src/document/editable.lisp

@@ -3,7 +3,16 @@
   (:import-from #:bordeaux-threads
                 #:make-lock)
   (:import-from #:metacopy
-                #:copy-thing))
+                #:copy-thing)
+  (:import-from #:reblocks-text-editor/utils/markdown
+                #:to-markdown)
+  ;; (:import-from #:reblocks-text-editor/document/ops
+  ;;               #:select-outer-block
+  ;;               #:split-nodes)
+  (:import-from #:reblocks-text-editor/utils/scribdown
+                #:to-scribdown)
+  (:import-from #:reblocks-text-editor/utils/text
+                #:collect-all-text))
 (in-package #:reblocks-text-editor/document/editable)
 
 
@@ -25,7 +34,63 @@
                    :documentation "Stores a tuple of two elements.
                                     The first is a node where caret is located and
                                     the second is a number of the caret offset."
-                   :accessor caret-position)))
+                   :accessor caret-position)
+   (text-before-caret :initform ""
+                      :type string
+                      :documentation "Stores current paragraph's text before the caret."
+                      :accessor text-before-caret)
+   (text-after-caret :initform ""
+                     :type string
+                     :documentation "Stores current paragraph's text after the caret."
+                     :accessor text-after-caret)))
+
+
+(defmethod (setf caret-position) :after ((value t) (document editable-document))
+  (destructuring-bind (node position)
+      value
+    (let ((nodes (if (slot-exists-p node 'common-doc:children)
+                     (common-doc:children node)
+                     (list node))))
+      (destructuring-bind (left right)
+          (uiop:symbol-call :reblocks-text-editor/document/ops
+                            :split-nodes
+                            nodes
+                            position)
+        ;; TODO: надо придумать что-то с тем, что в разорванной посередине markup
+        ;; конструкции каждая часть обрамляется в markup.
+        ;; возможно тут to-scribdown не лучший вариант и надо просто делать to-text
+        (let ((text-before
+                (collect-all-text (common-doc:make-content left))
+                ;; (to-scribdown (common-doc:make-content left)
+                ;;               ;; It is important to not trim a space,
+                ;;               ;; otherwise a space before the cursor will be lost:
+                ;;               :trim-spaces nil)
+                )
+              (text-after
+                (collect-all-text (common-doc:make-content right))
+                ;; (to-scribdown (common-doc:make-content right)
+                ;;               ;; It is important to not trim a space,
+                ;;               ;; otherwise a space before the cursor will be lost:
+                ;;               :trim-spaces nil)
+                ))
+          (setf (text-before-caret document)
+                text-before)
+          (setf (text-after-caret document)
+                text-after))))
+    ;; (let ((block-node (select-outer-block document node)))
+    ;;   (destructuring-bind (left right)
+    ;;       (split-nodes (list block-node) position)
+    ;;     (setf (text-before-caret document)
+    ;;           (to-scribdown (common-doc:make-content left)
+    ;;                         ;; It is important to not trim a space,
+    ;;                         ;; otherwise a space before the cursor will be lost:
+    ;;                         :trim-spaces nil))
+    ;;     (setf (text-after-caret document)
+    ;;           (to-scribdown (common-doc:make-content right)
+    ;;                         ;; It is important to not trim a space,
+    ;;                         ;; otherwise a space before the cursor will be lost:
+    ;;                         :trim-spaces nil))))
+    ))
 
 
 (defun get-next-reference-id (document)