Skip to content

Commit

Permalink
Merge 0640166 into a3d0991
Browse files Browse the repository at this point in the history
  • Loading branch information
@svetlyak40wt
svetlyak40wt committed Mar 26, 2022
2 parents a3d0991 + 0640166 commit 470c30d
Show file tree
Hide file tree
Showing 11 changed files with 947 additions and 186 deletions.
3 changes: 2 additions & 1 deletion reblocks-text-editor-tests.asd
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
(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")
:perform (test-op (o c)
(unless (symbol-call :rove '#:run c)
(error "Tests failed"))))
11 changes: 11 additions & 0 deletions src/blocks/code.lisp
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
(uiop:define-package #:reblocks-text-editor/blocks/code
(:use #:cl))
(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))
"")))
9 changes: 9 additions & 0 deletions src/document/copying.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,4 +55,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))


186 changes: 125 additions & 61 deletions src/document/ops.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,12 @@
#:children)
(:import-from #:scriba)
(:import-from #:reblocks-text-editor/utils/markdown
#:from-markdown
#:to-markdown)
(:import-from #:reblocks-text-editor/utils/text)
(:import-from #:reblocks-text-editor/utils/text
#:ensure-two-newlines-at-the-end
#:remove-zero-spaces-unless-string-is-empty
#:+zero-width-space+)
(:import-from #:reblocks-text-editor/html)
(:import-from #:alexandria
#:length=
Expand All @@ -14,6 +18,8 @@
#:caret-position
#:get-next-reference-id)
(:import-from #:serapeum
#:length<
#:length>
#:slice)
(:local-nicknames (#:dom #:reblocks-text-editor/dom/ops)))
(in-package #:reblocks-text-editor/document/ops)
Expand Down Expand Up @@ -92,21 +98,38 @@
(if (eql node node-to-replace)
new-node
node)))
(map-document document #'do-replace)))
(map-document document #'do-replace)

(dom::insert-node document
new-node
:relative-to node-to-replace)
(dom::delete-node document node-to-replace)))


(defun replace-node-content (document node-to-replace new-children)
(defun replace-node-content (document node new-content)
(log:debug "Replacing node content"
node-to-replace
new-children)
(flet ((do-replace (node depth)
(declare (ignore depth))
(when (eql node node-to-replace)
(unless (typep node 'node-with-children)
(error "Unable to replace content for node ~A" node))
(setf (children node)
new-children))
node))
(map-document document #'do-replace)))
node
new-content)
(typecase node
(common-doc:text-node
(unless (typep new-content 'string)
(error "I can new content for text-node should be a string. I've got ~A"
new-content))
(setf (common-doc:text node)
new-content))
(node-with-children
(unless (typep new-content 'list)
(error "I can new content for node with children should be a list. I've got ~A"
new-content))
(setf (children node)
new-content))
(t
(error "Unable to replace content for ~A"
node)))

;; Updating on the frontend
(dom::update-node document node)
(values))


(defun find-node-at-position (node cursor-position)
Expand Down Expand Up @@ -154,7 +177,10 @@
(values node
current-cursor-position)))
(t
(error "Probably we should't get here."))))))))
(error "Probably we should't get here.")))))
(common-doc:image
;; Just skip it
node))))

(recursive-find node)
(values last-visited-node
Expand Down Expand Up @@ -232,7 +258,7 @@
(unless node
(log:error "Unable to find CommonDoc node with" node-id))
(unless (typep node 'common-doc:paragraph)
(log:warn "Changed node should be a whole PARAGRAPH."))
(log:warn "Changed node should be a whole PARAGRAPH, not ~S" (type-of node)))

(values node)))

Expand Down Expand Up @@ -268,7 +294,7 @@
(eql current-list-item
(select-outer-list-item document
previous-paragraph))))
(log:error "Joining with the previous paragraph" previous-paragraph)
(log:debug "Joining with the previous paragraph" previous-paragraph)
(check-type previous-paragraph common-doc:paragraph)

(let* ((first-part (reblocks-text-editor/utils/markdown::to-markdown previous-paragraph))
Expand Down Expand Up @@ -310,7 +336,7 @@
0)))
;; Part where we might join two list-items
(t
(log:error "Joining with the previous list item")
(log:debug "Joining with the previous list item")
(let ((current-list-item (select-outer-list-item document
paragraph-to-delete)))
(when current-list-item
Expand Down Expand Up @@ -384,30 +410,29 @@
nil)))


(defun insert-into-paragraph (document path cursor-position node)
(defun insert-into-paragraph (document node cursor-position new-content)
"Inserts node into paragraph into the cursor position."
(let ((changed-paragraph (find-changed-node document path)))
(when changed-paragraph
(add-reference-ids document :to-node node)

(let* ((plain-text (to-markdown changed-paragraph
;; Do not eat the last space:
:trim-spaces nil))
(text-before-cursor (slice plain-text 0 cursor-position))
(text-after-cursor (slice plain-text cursor-position))
(nodes-before (common-doc:children (prepare-new-content document text-before-cursor)))
(nodes-after (common-doc:children (prepare-new-content document text-after-cursor)))
(new-nodes (append nodes-before
(list node)
nodes-after))
;; Before update, we need to remove "empty" text nodes having only
;; zero white-space. Otherwise, after the following text editing operation
;; cursor will be moved to incorrect position, jumping one additional
;; character to the right.
(new-nodes (remove-if #'empty-text-node new-nodes)))

(update-node-content document changed-paragraph new-nodes cursor-position)
(place-cursor-after-the document node)))))
(when node
(add-reference-ids document :to-node new-content)

(let* ((plain-text (to-markdown node
;; Do not eat the last space:
:trim-spaces nil))
(text-before-cursor (slice plain-text 0 cursor-position))
(text-after-cursor (slice plain-text cursor-position))
(nodes-before (common-doc:children (prepare-new-content document text-before-cursor)))
(nodes-after (common-doc:children (prepare-new-content document text-after-cursor)))
(new-nodes (append nodes-before
(list new-content)
nodes-after))
;; Before update, we need to remove "empty" text nodes having only
;; zero white-space. Otherwise, after the following text editing operation
;; cursor will be moved to incorrect position, jumping one additional
;; character to the right.
(new-nodes (remove-if #'empty-text-node new-nodes)))

(update-node-content document node new-nodes cursor-position)
(place-cursor-after-the document new-content))))


(defun append-children (widget to-node nodes-to-append)
Expand All @@ -420,7 +445,7 @@


(defun join-list-items (document previous-list-item current-list-item)
(log:error "Joining list items"
(log:debug "Joining list items"
previous-list-item
current-list-item)
(let ((items-to-move (children current-list-item)))
Expand Down Expand Up @@ -468,21 +493,20 @@


(defun find-next-paragraph (document node)
"This function does opposite to FIND-PREV-PARAGRAPH."
"This function does opposite to FIND-PREVIOUS-PARAGRAPH."
(let ((node-found nil))
(flet ((search-node (current-node depth)
(declare (ignore depth))
;; Remember we found the given NODE:

(when (eql current-node node)
(setf node-found t))

;; This block will work only after we found
;; given NODE:
(when (and node-found
(typep current-node 'common-doc:paragraph))
(return-from find-next-paragraph
current-node))

;; Remember we found the given NODE:
(when (eql current-node node)
(setf node-found t))

(values current-node)))
(map-document document #'search-node))
Expand Down Expand Up @@ -659,11 +683,16 @@


(defun prepare-new-content (document text)
(let* ((paragraph (reblocks-text-editor/utils/markdown::from-markdown text))
;; (paragraph (replace-markdown-links paragraph))
(paragraph (parse-scriba-nodes paragraph)))
(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))))))
(add-reference-ids document
:to-node paragraph)))
:to-node node)))



Expand All @@ -674,6 +703,8 @@
(:documentation "Deletes a node from container"))


;; TODO: decide what to do with replace-node-content function
;; because now it is easy to misuse these two functions
(defgeneric update-node-content (document node new-content cursor-position)
(:documentation "Updates content of the given node. Sometimes the node can be replaced with other nodes."))

Expand All @@ -696,6 +727,11 @@
(update-node-content document node
(prepare-new-content document new-content)
cursor-position))
(common-doc:code-block
(replace-node document
node
new-content)
(values new-content 0))
;; A new list item was created by manual enter of the "* "
;; at the beginning of the node:
(common-doc:unordered-list
Expand Down Expand Up @@ -730,11 +766,6 @@
(replace-node document
node
list-node)

(dom::insert-node document
list-node
:relative-to node)
(dom::delete-node document node)
(values list-node
(decf cursor-position 2))))))
;; Otherwise, we just insert
Expand All @@ -748,11 +779,44 @@
(replace-node-content document
node
new-content)

(dom::update-node document node)
(values node cursor-position)))))


(defmethod update-node-content ((document reblocks-text-editor/document/editable::editable-document)
(node common-doc:code-block)
(new-content string)
cursor-position)
;; Here we are updating our document tree
(log:debug "Updating code block's content"
node
new-content
cursor-position)
(let* ((children (common-doc:children node))
(new-content (remove-zero-spaces-unless-string-is-empty new-content))
;; (new-content (ensure-two-newlines-at-the-end new-content))
)
(log:debug "New block content is" new-content)
(cond
((length< 1 children)
(error "This code block should have no more than 1 child: ~A"
node))
((null children)
(replace-node-content document
node
(list (common-doc:make-text new-content))))
(t

(unless (typep (first children)
'common-doc:text-node)
(error "Code block should have a TEXT-NODE as it's child, but it is: ~A"
(first children)))

(replace-node-content document
(first children)
new-content)))
(values node cursor-position)))



(defun ensure-cursor-position-is-correct (document changed-node caret-position &key from-the-end)
;; We need to move cursor because in HTML cursor
Expand Down Expand Up @@ -804,7 +868,7 @@
If node is a list-item, it will be transformed into a nested list."
(let ((current-node (find-changed-node document path)))
(log:error "Indenting" current-node)
(log:debug "Indenting" current-node)

(let* ((current-list-item (select-outer-list-item document current-node))
(previous-list-item (when current-list-item
Expand Down Expand Up @@ -849,7 +913,7 @@
In case if the current list also in the list item,
then the current list item will be added after it."
(let ((current-node (find-changed-node document path)))
(log:error "Indenting" current-node)
(log:debug "Indenting" current-node)

(let* ((current-list-item (select-outer-list-item document current-node))
(next-sibling (find-next-sibling document current-list-item)))
Expand Down
Loading

0 comments on commit 470c30d

Please sign in to comment.