From 5e1aa12aeebb05c707ae0a593fc79c23dc7a7665 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 13 Mar 2022 23:33:57 +0300 Subject: [PATCH 01/20] More tests on update-node-content generic-function. --- src/document/ops.lisp | 2 + t/document/ops.lisp | 111 +++++++++++++++++++++++++++++++++++++----- 2 files changed, 102 insertions(+), 11 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index d29a9e1..7d671cb 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -674,6 +674,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.")) diff --git a/t/document/ops.lisp b/t/document/ops.lisp index c253d3e..ba079c6 100644 --- a/t/document/ops.lisp +++ b/t/document/ops.lisp @@ -6,29 +6,118 @@ (:import-from #:reblocks-text-editor/editor #:make-document-from-markdown-string) (:import-from #:common-doc + #:make-paragraph + #:make-text #:children) (:import-from #:alexandria - #:length=)) + #:length=) + (:import-from #:reblocks-text-editor/document/ops + #:update-node-content) + (:import-from #:reblocks-text-editor/utils/markdown + #:to-markdown)) (in-package #:reblocks-text-editor-tests/document/ops) -(defun paragraph-text (node) - (check-type node common-doc:paragraph) - (with-output-to-string (s) - (loop for child in (children node) - do (check-type child common-doc:text-node) - (write-string (common-doc:text child) s)))) - - (deftest test-document-creation (let* ((doc (make-document-from-markdown-string " First paragraph. Second paragraph."))) (ok (length= 2 (children doc))) - (ok (equal (paragraph-text + (ok (equal (to-markdown (first (children doc))) "First paragraph.")) - (ok (equal (paragraph-text + (ok (equal (to-markdown + (second (children doc))) + "Second paragraph.")))) + + +(deftest test-replacing-paragraph-content-with-plain-text + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +Second paragraph.")) + (first-paragraph (first (children doc)))) + + (update-node-content doc first-paragraph + "New content." + 0) + + (ok (length= 2 (children doc))) + (ok (equal (to-markdown + (first (children doc))) + "New content.")) + (ok (equal (to-markdown + (second (children doc))) + "Second paragraph.")))) + + +(deftest test-replacing-paragraph-content-with-a-list-of-inlines + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +Second paragraph.")) + (first-paragraph (first (children doc))) + (new-content (list (make-text "Foo ") + (common-doc:make-bold (make-text "Bar")) + (make-text " Baz")))) + + (update-node-content doc first-paragraph + new-content + 0) + + (ok (length= 2 (children doc))) + (ok (equal (to-markdown + (first (children doc))) + "Foo **Bar** Baz")) + (ok (equal (to-markdown + (second (children doc))) + "Second paragraph.")))) + + +(deftest test-replacing-paragraph-content-with-another-paragraph + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +Second paragraph.")) + (first-paragraph (first (children doc))) + (new-content (make-paragraph + (list (make-text "Foo ") + (common-doc:make-bold (make-text "Bar")) + (make-text " Baz"))))) + + (update-node-content doc first-paragraph + new-content + 0) + + (ok (length= 2 (children doc))) + (ok (equal (to-markdown + (first (children doc))) + "Foo **Bar** Baz")) + (ok (equal (to-markdown + (second (children doc))) + "Second paragraph.")))) + + +(deftest test-replacing-paragraph-content-with-another-paragraph + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +Second paragraph.")) + (first-paragraph (first (children doc))) + (new-content (make-paragraph + (list (make-text "Foo ") + (common-doc:make-bold (make-text "Bar")) + (make-text " Baz"))))) + + (update-node-content doc first-paragraph + new-content + 0) + + (ok (length= 2 (children doc))) + (ok (equal (to-markdown + (first (children doc))) + "Foo **Bar** Baz")) + (ok (equal (to-markdown (second (children doc))) "Second paragraph.")))) From b3f7139c20f14c83214715d79fd25a2fd2dfce8c Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 13 Mar 2022 23:36:50 +0300 Subject: [PATCH 02/20] Removed duplicate test. --- t/document/ops.lisp | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/t/document/ops.lisp b/t/document/ops.lisp index ba079c6..4d8a4a2 100644 --- a/t/document/ops.lisp +++ b/t/document/ops.lisp @@ -98,26 +98,3 @@ Second paragraph.")) (second (children doc))) "Second paragraph.")))) - -(deftest test-replacing-paragraph-content-with-another-paragraph - (let* ((doc (make-document-from-markdown-string " -First paragraph. - -Second paragraph.")) - (first-paragraph (first (children doc))) - (new-content (make-paragraph - (list (make-text "Foo ") - (common-doc:make-bold (make-text "Bar")) - (make-text " Baz"))))) - - (update-node-content doc first-paragraph - new-content - 0) - - (ok (length= 2 (children doc))) - (ok (equal (to-markdown - (first (children doc))) - "Foo **Bar** Baz")) - (ok (equal (to-markdown - (second (children doc))) - "Second paragraph.")))) From 7849c2e44350fab9a94d2f007c33d8a3216d179e Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Mon, 14 Mar 2022 00:22:30 +0300 Subject: [PATCH 03/20] Covered all existing cases for update-node-content. --- t/document/ops.lisp | 96 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) diff --git a/t/document/ops.lisp b/t/document/ops.lisp index 4d8a4a2..0705162 100644 --- a/t/document/ops.lisp +++ b/t/document/ops.lisp @@ -6,6 +6,8 @@ (:import-from #:reblocks-text-editor/editor #:make-document-from-markdown-string) (:import-from #:common-doc + #:make-list-item + #:make-unordered-list #:make-paragraph #:make-text #:children) @@ -98,3 +100,97 @@ Second paragraph.")) (second (children doc))) "Second paragraph.")))) + +(deftest test-replacing-paragraph-content-a-list-and-attaching-it-to-a-list-before + (let* ((doc (make-document-from-markdown-string " +* First paragraph. + +Second paragraph.")) + (second-paragraph (second (children doc))) + (new-content (make-unordered-list + (make-list-item (list (make-paragraph + (list (make-text "Foo"))) + (make-paragraph + (list (make-text "Bar"))))))) + ;; TODO: Here Bar is rendered not as the part of the + ;; second list item. But this is the bug of commondoc-markdown + ;; and should be fixed there: + ;; https://github.com/40ants/commondoc-markdown/issues/4 + (expected "* First paragraph. + +* Foo + +Bar")) + + (update-node-content doc second-paragraph + new-content + 0) + + ;; After this action, we should have only one + ;; child in the document + (ok (length= 1 (children doc))) + ;; and it should be a list of two items + ;; where second item has two paragraphs + (ok (equal (to-markdown + doc) + expected)))) + + +(deftest test-replacing-paragraph-content-a-list-and-attaching-it-to-a-list-after + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +* Second paragraph.")) + (first-paragraph (first (children doc))) + (new-content (make-unordered-list + (make-list-item (list (make-paragraph + (list (make-text "Foo"))))))) + (expected "* Foo + +* Second paragraph.")) + + (update-node-content doc first-paragraph + new-content + 0) + + ;; After this action, we should have only one + ;; child in the document + (ok (length= 1 (children doc))) + ;; and it should be a list of two items + ;; where second item has two paragraphs + (ok (equal (to-markdown + doc) + expected)))) + + +(deftest test-replacing-paragraph-content-a-list-when-it-is-surrounded-by-other-paragraphs + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +Second paragraph. + +Third paragraph.")) + (second-paragraph (second (children doc))) + (new-content (make-unordered-list + (make-list-item (list (make-paragraph + (list (make-text "Foo"))))))) + (expected "First paragraph. + +* Foo + +Third paragraph.")) + + (update-node-content doc + second-paragraph + new-content + 0) + + ;; After this action, we should have only one + ;; child in the document + (ok (length= 3 (children doc))) + ;; and it should be a list of two items + ;; where second item has two paragraphs + (ok (equal (to-markdown + doc) + expected)))) + From 895c40f94fc00d573a36cb856cf8388243188da0 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Mon, 14 Mar 2022 00:59:02 +0300 Subject: [PATCH 04/20] Added code to edit code blocks. --- src/document/ops.lisp | 23 +++++++++++++++++++++++ src/editor.lisp | 6 ++++-- src/frontend/js.lisp | 12 +++++++++++- t/document/ops.lisp | 37 +++++++++++++++++++++++++++++++++++-- 4 files changed, 73 insertions(+), 5 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index 7d671cb..bf69d79 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -755,6 +755,29 @@ (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))) + (unless (length= 1 children) + (error "This code block has more than 1 child: ~A" + node)) + (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))) + + (setf (common-doc:text (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 diff --git a/src/editor.lisp b/src/editor.lisp index 3a301f9..73a5c56 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -96,12 +96,12 @@ Second line (cond (paragraph (log:error "Updating paragraph at" path) - (multiple-value-bind (current-node cursor-position) + (multiple-value-bind (current-node new-cursor-position) (reblocks-text-editor/document/ops::update-node-content document paragraph plain-text cursor-position) (reblocks-text-editor/document/ops::ensure-cursor-position-is-correct - document current-node cursor-position))) + document current-node new-cursor-position))) (t (log:warn "Cant find paragraph at" path))))) @@ -218,6 +218,8 @@ Second line (defgeneric process-update (widget &key change-type new-html path cursor-position pasted-text &allow-other-keys) (:method (widget &key change-type new-html path cursor-position pasted-text &allow-other-keys) + (check-type cursor-position integer) + (let ((document (document widget))) (log:error "Processing" new-html path cursor-position change-type) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index 53cf50c..bc46c05 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -248,6 +248,16 @@ when (= (@ node tag-name) tag-name) do (return node))) + + (defun go-up-to-block-node (starting-node) + (loop for node = starting-node + then (@ node parent-node) + while (not (null node)) + when (let ((classes (@ node class-list))) + (and classes + (chain classes + (contains "block")))) + do (return node))) (defun get-editor-node (starting-node) (loop for node = starting-node @@ -289,7 +299,7 @@ base-node)) (paragraph (if inside-current-node node - (go-up-to "P" node)))) + (go-up-to-block-node node)))) ;; If there is no any range, then we can't ;; determine a cursor position: (when (and paragraph diff --git a/t/document/ops.lisp b/t/document/ops.lisp index 0705162..a40e9ce 100644 --- a/t/document/ops.lisp +++ b/t/document/ops.lisp @@ -185,8 +185,41 @@ Third paragraph.")) new-content 0) - ;; After this action, we should have only one - ;; child in the document + (ok (length= 3 (children doc))) + ;; and it should be a list of two items + ;; where second item has two paragraphs + (ok (equal (to-markdown + doc) + expected)))) + + +(deftest test-replacing-code-block-content + (let* ((doc (make-document-from-markdown-string " +First paragraph. + +``` +Some code +``` + +Third paragraph.")) + (code-node (second (children doc))) + (new-content "New code") + ;; TODO: Seems here another error + ;; in markdown serializer and + ;; there should be an empty line + ;; before the "Third paragraph"? + (expected "First paragraph. + +``` +New code +``` +Third paragraph.")) + + (update-node-content doc + code-node + new-content + 0) + (ok (length= 3 (children doc))) ;; and it should be a list of two items ;; where second item has two paragraphs From c568938d66fbca86a6d2cac05d7c4fdd7067b5ae Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 19 Mar 2022 23:56:28 +0300 Subject: [PATCH 05/20] Moved key processing code into a data-structure like a keymap. --- src/frontend/js.lisp | 159 ++++++++++++++++++++++++++----------------- 1 file changed, 98 insertions(+), 61 deletions(-) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index bc46c05..fd45a37 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -5,7 +5,9 @@ #:regex #:chain #:@ - #:create)) + #:create + #:false + #:undefined)) (in-package #:reblocks-text-editor/frontend/js) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -120,7 +122,7 @@ (- (chain element inner-text length) - position) + position) position))) (chain range (collapse t)) @@ -441,69 +443,104 @@ (t (show-path) (update-active-paragraph))))) + + (defun make-defaut-keymap () + (list + (create :predicate + (lambda (event) + (and (= (@ event key) + "Enter") + (@ event alt-key))) + :func + (lambda (event) + (let* ((current-block + (go-up-to-block-node (@ event target))) + (block-tag (@ current-block tag-name))) + (unless (= block-tag + "pre") + ;; When inside a list item, + ;; this split will add a new item. + ;; Otherwise, it works as a usual Enter, + ;; adding a new paragraph: + (change-text event "split"))))) + (create :predicate + (lambda (event) + (and (= (@ event key) + "ArrowRight") + (@ event alt-key))) + :func + (lambda (event) + (change-text event "indent"))) + (create :predicate + (lambda (event) + (and (= (@ event key) + "ArrowLeft") + (@ event alt-key))) + :func + (lambda (event) + (change-text event "dedent"))) + (create :predicate + (lambda (event) + (= (@ event key) + "ArrowUp")) + :func + (lambda (event) + (change-text event "move-cursor-up"))) + (create :predicate + (lambda (event) + (= (@ event key) + "ArrowDown")) + :func + (lambda (event) + (change-text event "move-cursor-down"))) + (create :predicate + (lambda (event) + (= (@ event key) + ,shortcut)) + :func + (lambda (event) + (when (process-shortcut event) + (chain event + (prevent-default)))) + :prevent-default nil) + (create :predicate + ;; Cmd-Z + (lambda (event) + (and (= (@ event key-code) + 90) + (@ event meta-key))) + :func + (lambda (event) + (process-undo event))))) + + (setf (@ window default-keymap) + (make-defaut-keymap)) (defun on-keydown (event) (chain console (log "on-keydown event" event)) - (cond - ((and (= (@ event key) - "Enter") - (@ event alt-key)) - ;; When inside a list item, - ;; this split will add a new item. - ;; Otherwise, it works as a usual Enter, - ;; adding a new paragraph: - (change-text event "split") - (chain event - (prevent-default))) - - ;; Arrow movements - ((and (= (@ event key) - "ArrowRight") - (@ event alt-key)) - - (change-text event "indent") - (chain event - (prevent-default))) - - ((and (= (@ event key) - "ArrowLeft") - (@ event alt-key)) - - (change-text event "dedent") - (chain event - (prevent-default))) - - ;; Up&Down without modifiers - ((= (@ event key) - "ArrowUp") - (change-text event "move-cursor-up") - (chain event - (prevent-default))) - - ((= (@ event key) - "ArrowDown") - (change-text event "move-cursor-down") - (chain event - (prevent-default))) - - ((= (@ event key) - ,shortcut) - (when (process-shortcut event) - (chain event - (prevent-default)))) - - ;; Cmd-Z - ((and (= (@ event key-code) - 90) - (@ event meta-key)) - (process-undo event) - (chain event - (prevent-default))) - (t - (update-active-paragraph)))) + (let ((handler-called false)) + (loop with handler-called = false + for item in (@ window default-keymap) + for predicate = (@ item predicate) + for func = (@ item func) + for prevent-default = (@ item prevent-default) + while (not handler-called) + when (funcall predicate event) + do (funcall func event) + (setf handler-called + t) + (when (or + ;; by default we are preventing + (is prevent-default undefined) + ;; but user might override it + ;; specifying False to this attribute: + prevent-default) + (chain event + (prevent-default)))) + (unless handler-called + (update-active-paragraph)))) - (defun on-paste (event) (chain console (log "on-paste event" event)) @@ -572,6 +609,6 @@ (when (and (= type "deleteContentBackward") (at-the-paragraph-beginning)) (change-text event "join-with-prev-paragraph") - + (chain event (prevent-default)))))))) From 2165f791b763b83463ed40771b1a0d1846d4048b Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 00:15:45 +0300 Subject: [PATCH 06/20] Fixed calling prevent default on keydown. --- src/frontend/js.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index fd45a37..74d376a 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -532,7 +532,7 @@ t) (when (or ;; by default we are preventing - (is prevent-default undefined) + (= prevent-default undefined) ;; but user might override it ;; specifying False to this attribute: prevent-default) From e306a986c76303b15869858d48be00ae7b58fc2f Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 00:16:05 +0300 Subject: [PATCH 07/20] Fixed uri copying on saving document version. --- src/document/copying.lisp | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/document/copying.lisp b/src/document/copying.lisp index ce5e99a..a40a5a5 100644 --- a/src/document/copying.lisp +++ b/src/document/copying.lisp @@ -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)) + From 97685f27434f798f9c7074d17733921882e56198 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 01:13:08 +0300 Subject: [PATCH 08/20] Fixed find-next-paragraph function. --- src/document/ops.lisp | 11 +++++------ t/document/ops.lisp | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 6 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index bf69d79..bc11723 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -468,21 +468,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)) diff --git a/t/document/ops.lisp b/t/document/ops.lisp index a40e9ce..77efa0b 100644 --- a/t/document/ops.lisp +++ b/t/document/ops.lisp @@ -14,6 +14,8 @@ (:import-from #:alexandria #:length=) (:import-from #:reblocks-text-editor/document/ops + #:find-previous-paragraph + #:find-next-paragraph #:update-node-content) (:import-from #:reblocks-text-editor/utils/markdown #:to-markdown)) @@ -227,3 +229,36 @@ Third paragraph.")) doc) expected)))) + +(deftest test-find-prev-paragraph-1 + (let* ((doc (make-document-from-markdown-string " +First. + +Second. + +Third.")) + (first (first (children doc))) + (second (second (children doc))) + (third (third (children doc)))) + (ok (equal (to-markdown (find-previous-paragraph doc third)) + (to-markdown second))) + (ok (equal (to-markdown (find-previous-paragraph doc second)) + (to-markdown first))) + (ok (null (find-previous-paragraph doc first))))) + + +(deftest test-find-next-paragraph-1 + (let* ((doc (make-document-from-markdown-string " +First. + +Second. + +Third.")) + (first (first (children doc))) + (second (second (children doc))) + (third (third (children doc)))) + (ok (equal (to-markdown (find-next-paragraph doc first)) + (to-markdown second))) + (ok (equal (to-markdown (find-next-paragraph doc second)) + (to-markdown third))) + (ok (null (find-next-paragraph doc third))))) From 1af4ae4675d4aa7d28eeed2d4d43f017f767969e Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 01:14:20 +0300 Subject: [PATCH 09/20] Now keymap entries have names. --- src/frontend/js.lisp | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index 74d376a..d973f71 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -446,7 +446,8 @@ (defun make-defaut-keymap () (list - (create :predicate + (create :name "Alt-Enter" + :predicate (lambda (event) (and (= (@ event key) "Enter") @@ -463,7 +464,8 @@ ;; Otherwise, it works as a usual Enter, ;; adding a new paragraph: (change-text event "split"))))) - (create :predicate + (create :name "Alt-ArrowRight" + :predicate (lambda (event) (and (= (@ event key) "ArrowRight") @@ -471,7 +473,8 @@ :func (lambda (event) (change-text event "indent"))) - (create :predicate + (create :name "Alt-ArrowLeft" + :predicate (lambda (event) (and (= (@ event key) "ArrowLeft") @@ -479,21 +482,24 @@ :func (lambda (event) (change-text event "dedent"))) - (create :predicate + (create :name "ArrowUp" + :predicate (lambda (event) (= (@ event key) "ArrowUp")) :func (lambda (event) (change-text event "move-cursor-up"))) - (create :predicate + (create :name "ArrowDown" + :predicate (lambda (event) (= (@ event key) "ArrowDown")) :func (lambda (event) (change-text event "move-cursor-down"))) - (create :predicate + (create :name "/" + :predicate (lambda (event) (= (@ event key) ,shortcut)) @@ -503,7 +509,8 @@ (chain event (prevent-default)))) :prevent-default nil) - (create :predicate + (create :name "Cmd-Z" + :predicate ;; Cmd-Z (lambda (event) (and (= (@ event key-code) @@ -522,12 +529,15 @@ (let ((handler-called false)) (loop with handler-called = false for item in (@ window default-keymap) + for name = (@ item name) for predicate = (@ item predicate) for func = (@ item func) for prevent-default = (@ item prevent-default) while (not handler-called) when (funcall predicate event) - do (funcall func event) + do (chain console + (log "Calling key handler for" name)) + (funcall func event) (setf handler-called t) (when (or From d8c29ed83a991f691395a9e0cd92f8d5f89d34e4 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 01:42:51 +0300 Subject: [PATCH 10/20] Skipping images when searching for the current node. --- src/document/ops.lisp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index bc11723..d97c2bd 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -154,7 +154,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 From 6895cdf3320fcd53c9955c57eb33bb506ef24742 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 02:08:22 +0300 Subject: [PATCH 11/20] Fixed strange newlines sent by a browser. --- src/editor.lisp | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/editor.lisp b/src/editor.lisp index 73a5c56..644f376 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -219,10 +219,13 @@ Second line (defgeneric process-update (widget &key change-type new-html path cursor-position pasted-text &allow-other-keys) (:method (widget &key change-type new-html path cursor-position pasted-text &allow-other-keys) (check-type cursor-position integer) + + (log:debug "Processing" new-html path cursor-position change-type) - (let ((document (document widget))) - (log:error "Processing" new-html path cursor-position change-type) - + (let ((document (document widget)) + ;; For some strange reason sometimes browser starts + ;; passing newlines even inside span elements. Why? Don't know. + (new-html (str:replace-all '(#\Newline) "" new-html))) (cond ;; This operation is similar to "split-paragraph" ;; but it splits a paragraph and created a new list From aacbf9bc2ad1b751c1fe396c64cbbeac42a01450 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 02:29:42 +0300 Subject: [PATCH 12/20] Fixed adding new list items on Option-Enter. --- src/frontend/js.lisp | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index d973f71..f3ac9d6 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -289,6 +289,13 @@ (paragraph (go-up-to "P" node))) paragraph)) + (defun get-current-block-node () + (let* ((selection (chain window + (get-selection))) + (node (@ selection + base-node))) + (go-up-to-block-node node))) + (defun caret-position (options) ;; Idea was taken from ;; https://github.com/accursoft/caret/blob/922257adae80c529c237deaddc49f65d7c794534/jquery.caret.js#L17-L29 @@ -454,8 +461,7 @@ (@ event alt-key))) :func (lambda (event) - (let* ((current-block - (go-up-to-block-node (@ event target))) + (let* ((current-block (get-current-block-node)) (block-tag (@ current-block tag-name))) (unless (= block-tag "pre") From 34c446b17c233eac3ea2e129dd7d7de612056913 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 03:05:36 +0300 Subject: [PATCH 13/20] Most log entries are now logged as DEBUG. --- src/document/ops.lisp | 10 +++++----- src/editor.lisp | 6 +++--- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index d97c2bd..0a54b2f 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -271,7 +271,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)) @@ -313,7 +313,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 @@ -423,7 +423,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))) @@ -831,7 +831,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 @@ -876,7 +876,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))) diff --git a/src/editor.lisp b/src/editor.lisp index 644f376..8719fe4 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -153,7 +153,7 @@ Second line (defun paste-text (document path cursor-position pasted-text) - (log:info "User wants to paste this text \"~A\"" pasted-text) + (log:debug "User wants to paste this text \"~A\"" pasted-text) (let* ((current-paragraph (reblocks-text-editor/document/ops::find-changed-node document path)) @@ -297,7 +297,7 @@ Second line (defgeneric process-shortcut (widget &key key-code path cursor-position &allow-other-keys) (:method (widget &key key-code path cursor-position &allow-other-keys) (let ((document (document widget))) - (log:info "Key" key-code "pressed") + (log:debug "Key" key-code "pressed") (let ((paragraph (reblocks-text-editor/document/ops::find-changed-node document path))) (multiple-value-bind (node new-cursor-position) @@ -307,7 +307,7 @@ Second line (defgeneric process-link (widget &key href &allow-other-keys) (:method (widget &key href &allow-other-keys) - (log:info "Link" href "was clicked"))) + (log:debug "Link" href "was clicked"))) (defmethod reblocks/widget:render ((widget editor)) From fc078e723605f5bfe6bb6549fc7b2fee9d72b029 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 20 Mar 2022 03:12:27 +0300 Subject: [PATCH 14/20] MVP of alternative keymap for code blocks. --- src/frontend/js.lisp | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index f3ac9d6..43c953f 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -526,15 +526,38 @@ (lambda (event) (process-undo event))))) + + (defun make-code-block-keymap () + (list + (create :name "Enter" + :predicate + (lambda (event) + (= (@ event key) + "Enter")) + :func + (lambda (event) + (alert "FOO"))))) + (setf (@ window default-keymap) (make-defaut-keymap)) + (setf (@ window code-block-keymap) + (make-code-block-keymap)) + (defun on-keydown (event) (chain console (log "on-keydown event" event)) - (let ((handler-called false)) + (let* ((default-keymap (@ window default-keymap)) + (code-block-keymap (@ window code-block-keymap)) + (current-node (get-current-block-node)) + (keymap (if (= (@ current-node tag-name) + "PRE") + (append code-block-keymap + default-keymap) + default-keymap)) + (handler-called false)) (loop with handler-called = false - for item in (@ window default-keymap) + for item in keymap for name = (@ item name) for predicate = (@ item predicate) for func = (@ item func) From 6f75159706f88b264320c27ec25d3f0f308c53e8 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Mon, 21 Mar 2022 01:22:07 +0300 Subject: [PATCH 15/20] Fixed code block editing. Now Enter adds a new line inside code block. --- src/editor.lisp | 33 ++++++++++++++++++--------------- src/frontend/js.lisp | 21 ++++++++++++++++++++- src/utils/text.lisp | 27 ++++++++++++++++++--------- 3 files changed, 56 insertions(+), 25 deletions(-) diff --git a/src/editor.lisp b/src/editor.lisp index 8719fe4..e4ea1f6 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -32,6 +32,8 @@ #:slice) (:import-from #:metacopy #:copy-thing) + (:import-from #:reblocks-text-editor/utils/text + #:remove-html-tags) (:local-nicknames (#:ops #:reblocks-text-editor/document/ops)) (:export #:on-document-update)) (in-package #:reblocks-text-editor/editor) @@ -91,19 +93,21 @@ Second line (defun process-usual-update (document path new-html cursor-position) - (let* ((paragraph (reblocks-text-editor/document/ops::find-changed-node document path)) - (plain-text (reblocks-text-editor/utils/text::remove-html-tags new-html))) + (let* ((node (reblocks-text-editor/document/ops::find-changed-node document path))) (cond - (paragraph - (log:error "Updating paragraph at" path) - (multiple-value-bind (current-node new-cursor-position) - (reblocks-text-editor/document/ops::update-node-content - document paragraph plain-text cursor-position) - - (reblocks-text-editor/document/ops::ensure-cursor-position-is-correct - document current-node new-cursor-position))) + (node + (let ((plain-text (remove-html-tags + new-html + :remove-new-lines (not (typep node 'common-doc:code-block))))) + (log:debug "Updating node content at" path) + (multiple-value-bind (current-node new-cursor-position) + (reblocks-text-editor/document/ops::update-node-content + document node plain-text cursor-position) + + (reblocks-text-editor/document/ops::ensure-cursor-position-is-correct + document current-node new-cursor-position)))) (t - (log:warn "Cant find paragraph at" path))))) + (log:warn "Cant find node at" path))))) (defun move-cursor-up (document path cursor-position) @@ -117,6 +121,8 @@ Second line (defun move-cursor-down (document path cursor-position) (let* ((current-paragraph (ops::find-changed-node document path)) (next-paragraph (ops::find-next-paragraph document current-paragraph))) + ;; TODO: solve problem of moving cursor inside code blocks and other + ;; blocks rendered in multiple lines: (check-type current-paragraph common-doc:paragraph) (when next-paragraph (ops::ensure-cursor-position-is-correct document next-paragraph cursor-position)))) @@ -222,10 +228,7 @@ Second line (log:debug "Processing" new-html path cursor-position change-type) - (let ((document (document widget)) - ;; For some strange reason sometimes browser starts - ;; passing newlines even inside span elements. Why? Don't know. - (new-html (str:replace-all '(#\Newline) "" new-html))) + (let ((document (document widget))) (cond ;; This operation is similar to "split-paragraph" ;; but it splits a paragraph and created a new list diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index 43c953f..1589499 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -536,7 +536,26 @@ "Enter")) :func (lambda (event) - (alert "FOO"))))) + (let* ((selection (chain window + (get-selection))) + ;; This should be a pre/code/span/@text node: + (node (@ selection + base-node)) + (parent-node (@ node + parent-node)) + (parent-node-id + (@ parent-node id)) + (caret (caret-position)) + (text (@ node text-content))) + (setf (@ node text-content) + (+ (chain text + (substring 0 caret)) + #\Newline + (chain text + (substring caret)))) + (set-cursor (create node-id parent-node-id + position (1+ caret))) + (change-text event "modify")))))) (setf (@ window default-keymap) (make-defaut-keymap)) diff --git a/src/utils/text.lisp b/src/utils/text.lisp index 09a3bd5..5b3d507 100644 --- a/src/utils/text.lisp +++ b/src/utils/text.lisp @@ -14,13 +14,22 @@ string)) -(defun remove-html-tags (html-string) - (let ((result (cl-ppcre:regex-replace-all "<[^>]+>" html-string - ""))) - (plump:decode-entities - (if (string= result +zero-width-space+) - result - (cl-ppcre:regex-replace-all +zero-width-space+ - result - ""))))) +(defun remove-html-tags (html-string &key (remove-new-lines t)) + (let* ((result (cl-ppcre:regex-replace-all "<[^>]+>" html-string + "")) + (result (if (string= result +zero-width-space+) + result + (cl-ppcre:regex-replace-all +zero-width-space+ + result + ""))) + (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)) From 9727f3e7e23f9d95535adf6bbe6b94f31cf5e363 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 26 Mar 2022 00:14:58 +0300 Subject: [PATCH 16/20] Enter adds a new line instead of going to the next paragraph. --- src/document/ops.lisp | 110 ++++++++++++++++++++++++++++-------------- src/frontend/css.lisp | 7 ++- src/frontend/js.lisp | 29 +++++++++++ src/html.lisp | 7 +++ src/utils/text.lisp | 51 ++++++++++++++++++-- 5 files changed, 162 insertions(+), 42 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index 0a54b2f..4e5fece 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -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= @@ -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) @@ -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) @@ -661,11 +684,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))) @@ -700,6 +728,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 @@ -734,11 +767,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 @@ -752,8 +780,6 @@ (replace-node-content document node new-content) - - (dom::update-node document node) (values node cursor-position))))) @@ -766,17 +792,29 @@ node new-content cursor-position) - (let ((children (common-doc:children node))) - (unless (length= 1 children) - (error "This code block has more than 1 child: ~A" - node)) - (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))) - - (setf (common-doc:text (first children)) - new-content) + (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))) diff --git a/src/frontend/css.lisp b/src/frontend/css.lisp index eba9c32..7af9b03 100644 --- a/src/frontend/css.lisp +++ b/src/frontend/css.lisp @@ -25,6 +25,11 @@ :margin-left -0.5rem :padding-left 0.5rem :margin-right -0.5rem - :padding-right 0.5rem) + :padding-right 0.5rem + :min-width 10rem + :min-height 2rem + ;; ((:and code :after) + ;; :content " ") + ) ((:and p .active) (.markup :display inline-block)))))) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index 1589499..6a82833 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -547,10 +547,39 @@ (@ parent-node id)) (caret (caret-position)) (text (@ node text-content))) + ;; (let ((num-newlines-to-add + ;; (if (or (= (elt text (1+ caret)) + ;; #\Newline) + ;; (= (elt text (1- caret)) + ;; #\Newline)) + ;; 1 + ;; 2))) + ;; (setf (@ node text-content) + ;; (if (= num-newlines-to-add 1) + ;; (+ (chain text + ;; (substring 0 caret)) + ;; #\Newline + ;; (chain text + ;; (substring caret))) + ;; (+ (chain text + ;; (substring 0 caret)) + ;; #\Newline + ;; #\Newline + ;; (chain text + ;; (substring caret))))) + ;; (set-cursor (create node-id parent-node-id + ;; position (+ caret num-newlines-to-add)))) + + (setf (@ node text-content) (+ (chain text (substring 0 caret)) #\Newline + ;; (if (= (elt text + ;; caret) + ;; "​") + ;; "" + ;; "​") (chain text (substring caret)))) (set-cursor (create node-id parent-node-id diff --git a/src/html.lisp b/src/html.lisp index 042bef6..795d2d3 100644 --- a/src/html.lisp +++ b/src/html.lisp @@ -105,6 +105,13 @@ (reblocks/html:with-html (:pre :id (common-doc:reference node) :class class + ;; (:code :id (format nil "~A-code" + ;; (common-doc:reference node)) + ;; ;; (if (common-doc:children node) + ;; ;; (common-doc:text + ;; ;; (first (common-doc:children node))) + ;; ;; "") + ;; ) (:code (mapc #'to-html (uiop:ensure-list (common-doc:children node)))))))) diff --git a/src/utils/text.lisp b/src/utils/text.lisp index 5b3d507..32d0ece 100644 --- a/src/utils/text.lisp +++ b/src/utils/text.lisp @@ -13,15 +13,22 @@ (string-trim '(#\Newline #\Space #\Tab #\Zero_Width_Space) string)) +(defun remove-zero-spaces-unless-string-is-empty (string) + (cond + ((string= string "") + +zero-width-space+) + ((string= string +zero-width-space+) + string) + (t + (cl-ppcre:regex-replace-all +zero-width-space+ + string + "")))) + (defun remove-html-tags (html-string &key (remove-new-lines t)) (let* ((result (cl-ppcre:regex-replace-all "<[^>]+>" html-string "")) - (result (if (string= result +zero-width-space+) - result - (cl-ppcre:regex-replace-all +zero-width-space+ - result - ""))) + (result (remove-zero-spaces-unless-string-is-empty result)) (result (plump:decode-entities result)) (result (if remove-new-lines ;; For some strange reason sometimes browser starts @@ -33,3 +40,37 @@ result))) result)) + +(defun ensure-two-newlines-at-the-end (string) + (if (and (>= (length string) + 2) + (eql (elt string (1- (length string))) + #\Newline) + (not (eql (elt string (1- (1- (length string)))) + #\Newline))) + (with-output-to-string (s) + (write-string string s) + (write-char #\Newline s)) + string) + + ;; (let ((num-newlines-to-add + ;; (+ (if (and (>= (length string) + ;; 1) + ;; (not (eql (elt string (1- (length string))) + ;; #\Newline))) + ;; 1 + ;; 0) + + ;; (if (and (>= (length string) + ;; 2) + ;; (not (eql (elt string (1- (1- (length string)))) + ;; #\Newline)) + ;; (not (eql (elt string (1- (1- (length string)))) + ;; #\Newline))))) + ;; )) (if + ;; (with-output-to-string (s) + ;; (write-string string s) + ;; (write-char #\Newline s) + ;; (write-char #\Newline s)) + ;; string)) + ) From 431d60d4de026b04a0da2b3b6204073ac853154a Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 26 Mar 2022 01:44:40 +0300 Subject: [PATCH 17/20] Added code block deletion. --- src/document/ops.lisp | 2 +- src/editor.lisp | 34 +++++++++++++++++++++++++++++++++ src/frontend/js.lisp | 44 ++++++++++++++++++++++++++++++++----------- 3 files changed, 68 insertions(+), 12 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index 4e5fece..36f47d6 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -258,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))) diff --git a/src/editor.lisp b/src/editor.lisp index e4ea1f6..6d5d152 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -33,6 +33,7 @@ (:import-from #:metacopy #:copy-thing) (:import-from #:reblocks-text-editor/utils/text + #:trim-spaces #:remove-html-tags) (:local-nicknames (#:ops #:reblocks-text-editor/document/ops)) (:export #:on-document-update)) @@ -173,6 +174,36 @@ Second line new-node))) +(defgeneric maybe-delete-block (document path-or-node) + (:documentation "Called when cursor position is at the beginning of the document block and user hit backspace.") + (:method ((document t) (path-or-node t)) + ;; Just ignore any node which has no a special processing. + )) + + +(defmethod maybe-delete-block (document (path list)) + (log:debug "User wants to delete block at" path) + + (let* ((node + (reblocks-text-editor/document/ops::find-changed-node document path))) + (maybe-delete-block document node))) + + +(defmethod maybe-delete-block (document (node common-doc:code-block)) + (let ((text (trim-spaces + (common-doc:text (first (common-doc:children node)))))) + (when (string= text "") + (let ((prev-node + (ops::find-previous-sibling document + node))) + (ops::delete-node document node) + (when prev-node + (ops::ensure-cursor-position-is-correct document + prev-node + 0 + :from-the-end t)))))) + + (defgeneric on-document-update (widget) (:documentation "Called after the each document update.") (:method ((widget editor)) @@ -291,6 +322,9 @@ Second line "paste") (paste-text document path cursor-position pasted-text)) + ((string= change-type + "maybe-delete-block") + (maybe-delete-block document path)) (t (process-usual-update document path new-html cursor-position))) diff --git a/src/frontend/js.lisp b/src/frontend/js.lisp index 6a82833..c169b20 100644 --- a/src/frontend/js.lisp +++ b/src/frontend/js.lisp @@ -681,21 +681,43 @@ do (setf has-only-zero-spaces nil)) (values has-only-zero-spaces))))) + (defun at-the-block-beginning () + (let* ((node (get-current-block-node)) + (position (caret-position))) + (when (and node + (>= position 0)) + (let* ((content (@ node + inner-text)) + (has-only-zero-spaces t)) + (loop for idx from (1- position) downto 0 + for symbol = (elt content idx) + unless (= symbol "​") + do (setf has-only-zero-spaces nil)) + (values has-only-zero-spaces))))) + (defun before-input (event) (let ((type (@ event input-type))) (chain console (log "Before input" event)) - - (when (= type "insertParagraph") - (change-text event "split-paragraph") - - (chain event - (prevent-default))) - (when (and (= type "deleteContentBackward") - (at-the-paragraph-beginning)) - (change-text event "join-with-prev-paragraph") + (cond + ((= type "insertParagraph") + (change-text event "split-paragraph") + + (chain event + (prevent-default))) + + ((and (= type "deleteContentBackward") + (at-the-paragraph-beginning)) + (change-text event "join-with-prev-paragraph") + + (chain event + (prevent-default))) - (chain event - (prevent-default)))))))) + ((and (= type "deleteContentBackward") + (at-the-block-beginning)) + (change-text event "maybe-delete-block") + + (chain event + (prevent-default))))))))) From 955751cd4c489e1ae2813650caf0eb4035c6ed89 Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 26 Mar 2022 03:30:36 +0300 Subject: [PATCH 18/20] Almost working moving of the cursor inside the code block. --- src/blocks/code.lisp | 11 +++++++ src/editor.lisp | 64 +++++++++++++++++++++++++++++++----- src/utils/text.lisp | 78 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 144 insertions(+), 9 deletions(-) create mode 100644 src/blocks/code.lisp diff --git a/src/blocks/code.lisp b/src/blocks/code.lisp new file mode 100644 index 0000000..6ccaacf --- /dev/null +++ b/src/blocks/code.lisp @@ -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)) + ""))) diff --git a/src/editor.lisp b/src/editor.lisp index 6d5d152..6922d9d 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -35,6 +35,8 @@ (:import-from #:reblocks-text-editor/utils/text #:trim-spaces #:remove-html-tags) + (:import-from #:reblocks-text-editor/blocks/code + #:code) (:local-nicknames (#:ops #:reblocks-text-editor/document/ops)) (:export #:on-document-update)) (in-package #:reblocks-text-editor/editor) @@ -111,24 +113,68 @@ Second line (log:warn "Cant find node at" path))))) -(defun move-cursor-up (document path cursor-position) - (let* ((current-paragraph (ops::find-changed-node document path)) - (prev-paragraph (ops::find-previous-paragraph document current-paragraph))) - (check-type current-paragraph common-doc:paragraph) +(defgeneric move-cursor-up (document path-or-node cursor-position) + (:method ((document t) (path-or-node t) (cursor-position t)))) + + +(defmethod move-cursor-up (document (path list) cursor-position) + (let ((node (ops::find-changed-node document path))) + (move-cursor-up document node cursor-position))) + + +(defmethod move-cursor-up (document (node common-doc:paragraph) cursor-position) + (let* ((prev-paragraph (ops::find-previous-paragraph document node))) (when prev-paragraph (ops::ensure-cursor-position-is-correct document prev-paragraph cursor-position)))) -(defun move-cursor-down (document path cursor-position) - (let* ((current-paragraph (ops::find-changed-node document path)) - (next-paragraph (ops::find-next-paragraph document current-paragraph))) +(defmethod move-cursor-up (document (node common-doc:code-block) caret-position) + (let* ((text (code node)) + (new-caret-position (reblocks-text-editor/utils/text::move-caret-on-the-prev-line text caret-position))) + (cond + (new-caret-position + (ops::ensure-cursor-position-is-correct document node new-caret-position)) + (t + (let ((prev-paragraph (ops::find-previous-paragraph document node)) + (new-caret-position (reblocks-text-editor/utils/text::caret-position-from-beginning-of-the-line text caret-position))) + ;; TODO: solve problem of moving cursor inside code blocks and other + ;; blocks rendered in multiple lines: + (when prev-paragraph + (ops::ensure-cursor-position-is-correct document prev-paragraph new-caret-position))))))) + + +(defgeneric move-cursor-down (document path-or-node cursor-position) + (:method ((document t) (path-or-node t) (cursor-position t)))) + + +(defmethod move-cursor-down (document (path list) cursor-position) + (let ((node (ops::find-changed-node document path))) + (move-cursor-down document node cursor-position))) + + +(defmethod move-cursor-down (document (node common-doc:paragraph) cursor-position) + (let ((next-paragraph (ops::find-next-paragraph document node))) ;; TODO: solve problem of moving cursor inside code blocks and other ;; blocks rendered in multiple lines: - (check-type current-paragraph common-doc:paragraph) (when next-paragraph (ops::ensure-cursor-position-is-correct document next-paragraph cursor-position)))) +(defmethod move-cursor-down (document (node common-doc:code-block) caret-position) + (let* ((text (code node)) + (new-caret-position (reblocks-text-editor/utils/text::move-caret-on-the-next-line text caret-position))) + (cond + (new-caret-position + (ops::ensure-cursor-position-is-correct document node new-caret-position)) + (t + (let ((next-paragraph (ops::find-next-paragraph document node)) + (new-caret-position (reblocks-text-editor/utils/text::caret-position-from-beginning-of-the-line text caret-position))) + ;; TODO: solve problem of moving cursor inside code blocks and other + ;; blocks rendered in multiple lines: + (when next-paragraph + (ops::ensure-cursor-position-is-correct document next-paragraph new-caret-position))))))) + + (defun insert-node (document new-node relative-to &key (position :after)) (ops::add-reference-ids document :to-node new-node) @@ -191,7 +237,7 @@ Second line (defmethod maybe-delete-block (document (node common-doc:code-block)) (let ((text (trim-spaces - (common-doc:text (first (common-doc:children node)))))) + (code node)))) (when (string= text "") (let ((prev-node (ops::find-previous-sibling document diff --git a/src/utils/text.lisp b/src/utils/text.lisp index 32d0ece..343eb7e 100644 --- a/src/utils/text.lisp +++ b/src/utils/text.lisp @@ -74,3 +74,81 @@ ;; (write-char #\Newline s)) ;; string)) ) + + +(defun text-line-length (text pos) + (let* ((current-char (elt text pos)) + (begin-pos (if (eql current-char #\Newline) + (1+ pos) + (let ((prev-newline + (position #\Newline text + :from-end t + :end pos))) + (if prev-newline + (1+ prev-newline) + 0)))) + (end-pos (let ((next-newline + (position #\Newline text + :start (if (eql current-char #\Newline) + (1+ pos) + pos)))) + (or next-newline + (length text))))) + (- end-pos + begin-pos))) + + +(defun move-caret-on-the-next-line (text caret-position) + "Returns a new caret position (relative to the beginning of the text) + if there is a next line. + + If next line is shorter than the current, then new position + will be right at the end. + + If there is no next line, then function returns nil." + (let* ((position-in-line (caret-position-from-beginning-of-the-line text caret-position)) + (next-newline-pos (position #\Newline text + :start caret-position))) + (when next-newline-pos + (let* ((begin-of-next-line (1+ next-newline-pos)) + (next-line-length (text-line-length text (1+ next-newline-pos))) + (position-in-next-line (min position-in-line + next-line-length))) + (+ begin-of-next-line + position-in-next-line))))) + + +(defun move-caret-on-the-prev-line (text caret-position) + "Returns a new caret position (relative to the beginning of the text) + if there is a next line. + + If next line is shorter than the current, then new position + will be right at the end. + + If there is no next line, then function returns nil." + (let* ((position-in-line (caret-position-from-beginning-of-the-line text caret-position)) + (prev-newline-pos (position #\Newline text + :from-end t + :end caret-position))) + (when prev-newline-pos + (let* ((one-more-newline-back-pos (position #\Newline text + :from-end t + :end prev-newline-pos)) + (begin-of-prev-line (if one-more-newline-back-pos + (1+ one-more-newline-back-pos) + 0)) + (prev-line-length (text-line-length text begin-of-prev-line)) + (position-in-prev-line (min position-in-line + prev-line-length))) + (+ begin-of-prev-line + position-in-prev-line))))) + + +(defun caret-position-from-beginning-of-the-line (text caret-position) + (let ((newline-pos (position #\Newline text + :from-end t + :end caret-position))) + (if newline-pos + (- caret-position newline-pos) + ;; We are at the first line: + caret-position))) From 4f860450063a969178daf43cf83552b1ebb5becc Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sat, 26 Mar 2022 03:49:13 +0300 Subject: [PATCH 19/20] Fixed moving from one code-block's line to another. --- reblocks-text-editor-tests.asd | 3 ++- src/utils/text.lisp | 2 +- t/utils/text.lisp | 41 ++++++++++++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 2 deletions(-) create mode 100644 t/utils/text.lisp diff --git a/reblocks-text-editor-tests.asd b/reblocks-text-editor-tests.asd index 3f3fa55..ae06e8f 100644 --- a/reblocks-text-editor-tests.asd +++ b/reblocks-text-editor-tests.asd @@ -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")))) diff --git a/src/utils/text.lisp b/src/utils/text.lisp index 343eb7e..31b0945 100644 --- a/src/utils/text.lisp +++ b/src/utils/text.lisp @@ -149,6 +149,6 @@ :from-end t :end caret-position))) (if newline-pos - (- caret-position newline-pos) + (- caret-position newline-pos 1) ;; We are at the first line: caret-position))) diff --git a/t/utils/text.lisp b/t/utils/text.lisp new file mode 100644 index 0000000..81ecf3d --- /dev/null +++ b/t/utils/text.lisp @@ -0,0 +1,41 @@ +(uiop:define-package #:reblocks-text-editor-tests/utils/text + (:use #:cl) + (:import-from #:rove + #:ok + #:deftest) + (:import-from #:reblocks-text-editor/utils/text + #:caret-position-from-beginning-of-the-line + #:move-caret-on-the-next-line)) +(in-package #:reblocks-text-editor-tests/utils/text) + + +(deftest test-move-caret-on-the-next-line + (let ((pos (move-caret-on-the-next-line + "Block of code +second line +middle line +last line" 3))) + (ok (= pos 17))) + + (let ((pos (move-caret-on-the-next-line + "Block of code +second line +middle line +last line" 17))) + (ok (= pos 29)))) + + +(deftest test-caret-position-from-beginning-of-the-line + (let ((pos (caret-position-from-beginning-of-the-line + "Block of code + second line + middle line + last line" 3))) + (ok (= pos 3))) + + (let ((pos (caret-position-from-beginning-of-the-line + "Block of code +second line +middle line +last line" 17))) + (ok (= pos 3)))) From 0640166a76ef4211691a40314cb515f4b53c04ec Mon Sep 17 00:00:00 2001 From: Alexander Artemenko Date: Sun, 27 Mar 2022 02:02:34 +0300 Subject: [PATCH 20/20] Pasting to code block keeps new lines as is. --- src/document/ops.lisp | 45 +++++++++++++++++++++---------------------- src/editor.lisp | 35 ++++++++++++++++++++++++++------- 2 files changed, 50 insertions(+), 30 deletions(-) diff --git a/src/document/ops.lisp b/src/document/ops.lisp index 36f47d6..c4f1959 100644 --- a/src/document/ops.lisp +++ b/src/document/ops.lisp @@ -410,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) diff --git a/src/editor.lisp b/src/editor.lisp index 6922d9d..eda0885 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -205,19 +205,40 @@ Second line (common-doc:make-text pasted-text)))) -(defun paste-text (document path cursor-position pasted-text) +(defgeneric paste-text (document path-or-node caret-position pasted-text) + (:method (document path-or-node caret-position pasted-text))) + + +(defmethod paste-text (document (path list) caret-position pasted-text) (log:debug "User wants to paste this text \"~A\"" pasted-text) - (let* ((current-paragraph - (reblocks-text-editor/document/ops::find-changed-node document path)) - (text (to-markdown current-paragraph + (let* ((node + (reblocks-text-editor/document/ops::find-changed-node document path))) + (paste-text document node caret-position pasted-text))) + + +(defmethod paste-text (document (node common-doc:paragraph) cursor-position pasted-text) + (let* ((text (to-markdown node ;; It is important to not trim a space, ;; otherwise a space before the cursor will be lost: :trim-spaces nil)) (text-before (slice text 0 cursor-position)) - (new-node (make-node-from-pasted-text text-before pasted-text))) - (ops::insert-into-paragraph document path cursor-position - new-node))) + (new-content (make-node-from-pasted-text text-before pasted-text))) + (ops::insert-into-paragraph document node cursor-position + new-content))) + + +(defmethod paste-text (document (node common-doc:code-block) caret-position pasted-text) + (let* ((text (reblocks-text-editor/blocks/code::code node)) + (text-before (slice text 0 caret-position)) + (text-after (slice text caret-position)) + (new-content (concatenate 'string text-before pasted-text text-after)) + (new-caret-position (+ caret-position + (length pasted-text)))) + (ops::update-node-content document node + new-content + caret-position) + (ops::ensure-cursor-position-is-correct document node new-caret-position))) (defgeneric maybe-delete-block (document path-or-node)