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/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/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)) + diff --git a/src/document/ops.lisp b/src/document/ops.lisp index d29a9e1..c4f1959 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) @@ -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 @@ -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))) @@ -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)) @@ -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 @@ -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) @@ -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))) @@ -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)) @@ -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))) @@ -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.")) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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))) diff --git a/src/editor.lisp b/src/editor.lisp index 3a301f9..eda0885 100644 --- a/src/editor.lisp +++ b/src/editor.lisp @@ -32,6 +32,11 @@ #:slice) (:import-from #:metacopy #:copy-thing) + (: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) @@ -91,37 +96,85 @@ 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 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))) + (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) - (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))) - (check-type current-paragraph common-doc: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: (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) @@ -152,19 +205,70 @@ Second line (common-doc:make-text pasted-text)))) -(defun paste-text (document path cursor-position pasted-text) - (log:info "User wants to paste this text \"~A\"" 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) + (: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 + (code 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) @@ -218,9 +322,11 @@ 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) - (let ((document (document widget))) - (log:error "Processing" new-html path cursor-position change-type) + (check-type cursor-position integer) + + (log:debug "Processing" new-html path cursor-position change-type) + (let ((document (document widget))) (cond ;; This operation is similar to "split-paragraph" ;; but it splits a paragraph and created a new list @@ -283,6 +389,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))) @@ -292,7 +401,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) @@ -302,7 +411,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)) 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 53cf50c..c169b20 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)) @@ -248,6 +250,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 @@ -277,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 @@ -289,7 +308,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 @@ -431,69 +450,184 @@ (t (show-path) (update-active-paragraph))))) + + (defun make-defaut-keymap () + (list + (create :name "Alt-Enter" + :predicate + (lambda (event) + (and (= (@ event key) + "Enter") + (@ event alt-key))) + :func + (lambda (event) + (let* ((current-block (get-current-block-node)) + (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 :name "Alt-ArrowRight" + :predicate + (lambda (event) + (and (= (@ event key) + "ArrowRight") + (@ event alt-key))) + :func + (lambda (event) + (change-text event "indent"))) + (create :name "Alt-ArrowLeft" + :predicate + (lambda (event) + (and (= (@ event key) + "ArrowLeft") + (@ event alt-key))) + :func + (lambda (event) + (change-text event "dedent"))) + (create :name "ArrowUp" + :predicate + (lambda (event) + (= (@ event key) + "ArrowUp")) + :func + (lambda (event) + (change-text event "move-cursor-up"))) + (create :name "ArrowDown" + :predicate + (lambda (event) + (= (@ event key) + "ArrowDown")) + :func + (lambda (event) + (change-text event "move-cursor-down"))) + (create :name "/" + :predicate + (lambda (event) + (= (@ event key) + ,shortcut)) + :func + (lambda (event) + (when (process-shortcut event) + (chain event + (prevent-default)))) + :prevent-default nil) + (create :name "Cmd-Z" + :predicate + ;; Cmd-Z + (lambda (event) + (and (= (@ event key-code) + 90) + (@ event meta-key))) + :func + (lambda (event) + (process-undo event))))) + + + (defun make-code-block-keymap () + (list + (create :name "Enter" + :predicate + (lambda (event) + (= (@ event key) + "Enter")) + :func + (lambda (event) + (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))) + ;; (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 + position (1+ caret))) + (change-text event "modify")))))) + + (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)) - (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* ((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 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 (chain console + (log "Calling key handler for" name)) + (funcall func event) + (setf handler-called + t) + (when (or + ;; by default we are preventing + (= 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)) @@ -547,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))))))))) 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 09a3bd5..31b0945 100644 --- a/src/utils/text.lisp +++ b/src/utils/text.lisp @@ -13,14 +13,142 @@ (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) - (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 (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 + ;; 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 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)) + ) + + +(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 1) + ;; We are at the first line: + caret-position))) diff --git a/t/document/ops.lisp b/t/document/ops.lisp index c253d3e..77efa0b 100644 --- a/t/document/ops.lisp +++ b/t/document/ops.lisp @@ -6,29 +6,259 @@ (: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) (:import-from #:alexandria - #:length=)) + #: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)) (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-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) + + (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 + (ok (equal (to-markdown + 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))))) 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))))