diff options
Diffstat (limited to 'org-fc.el')
| -rw-r--r-- | org-fc.el | 131 |
1 files changed, 0 insertions, 131 deletions
@@ -166,37 +166,6 @@ Does not apply to cloze single and cloze enumeration cards." :type 'hook :group 'org-fc) -;;;; Diff - -(defcustom org-fc-diff-filler ?- - "Character for filling diffs when the input was too short." - :type 'character - :group 'org-fc) - -;;;; Font Faces - -;; Based on `magit-diff-added' -(defface org-fc-diff-correct - `((((class color) (background light)) - :background "#ddffdd" - :foreground "#22aa22") - (((class color) (background dark)) - :background "#335533" - :foreground "#ddffdd")) - "Face for correct parts of a diff." - :group 'org-fc) - -;; Based on `magit-diff-removed' -(defface org-fc-diff-wrong - `((((class color) (background light)) - :background "#ffdddd" - :foreground "#aa2222") - (((class color) (background dark)) - :background "#553333" - :foreground "#ffdddd")) - "Face for wrong parts of a diff." - :group 'org-fc) - ;;; Variables ;; Not customizable because the indexers / filters expect ISO8601 @@ -336,106 +305,6 @@ If point is not inside a flashcard entry, an error is raised." (goto-char pos) ,@body))) -;;; Diff - -(defun org-fc-diff-subseq (a b start1 start2 end1 end2) - "Find (index-a index-b len) of the longest matching subsequence in A and B. -Only parts of A in the range START1 to END1 and parts of B in the -range START2 to END2 are considered. -If there is no matching subsequence, nil is returned." - (let ((best-length 0) (best-i 0) (best-j 0) - ;; Longest matching subsequence starting at index j of B, - ;; offset by one to handle the case j = 0 - (lengths (make-vector (1+ (length b)) 0))) - (cl-loop for i from start1 to end1 do - (let ((new-lengths (make-vector (1+ (length b)) 0))) - (cl-loop for j from start2 to end2 do - (if (eql (aref a i) (aref b j)) - (let ((length (+ 1 (aref lengths j)))) - (aset new-lengths (1+ j) length) - (when (> length best-length) - (setq best-length length) - (setq best-i (1+ (- i length))) - (setq best-j (1+ (- j length))))))) - (setq lengths new-lengths))) - (if (> best-length 0) - (list best-i best-j best-length)))) - -(defun org-fc-diff-matching-blocks (a b start1 start2 end1 end2) - "Find matching blocks of A and B. -Only parts of A in the range START1 to END1 and parts of B in the -range START2 to END2 are considered." - (if-let ((match (org-fc-diff-subseq a b start1 start2 end1 end2))) - (cl-destructuring-bind (i j len) match - (append - (org-fc-diff-matching-blocks a b start1 start2 (1- i) (1- j)) - (list match) - (org-fc-diff-matching-blocks a b (+ i len) (+ j len) end1 end2))))) - -(defun org-fc-diff--propertize-got (got blocks expected-length) - "Propertize the GOT answer given matching BLOCKS. -If it is shorter than EXPECTED-LENGTH, it is filled using -`org-fc-diff-filler'." - (let ((last 0) res) - ;; Prepend filler if text at start is missing - (unless (null blocks) - (cl-destructuring-bind (i j _len) (car blocks) - (if (> j i) - (setq res - (propertize - (make-string (- j i) org-fc-diff-filler) - 'face 'org-fc-diff-wrong))))) - (cl-loop for (i _ len) in blocks do - (setq res - (concat - res - (propertize - (cl-subseq got last i) - 'face 'org-fc-diff-wrong) - (propertize - (cl-subseq got i (+ i len)) - 'face 'org-fc-diff-correct))) - (setq last (+ i len))) - (setq res - (concat - res - (propertize (cl-subseq got last) 'face 'org-fc-diff-wrong))) - ;; Append filler if result is shorter than expected - (if (< (length res) expected-length) - (concat - res - (propertize - (make-string (- expected-length (length res)) org-fc-diff-filler) - 'face 'org-fc-diff-wrong)) - res))) - -(defun org-fc-diff--propertize-expected (expected blocks) - "Propertize the EXPECTED answer, given matching BLOCKS." - (let ((last 0) res) - (cl-loop for (_ j len) in blocks do - (setq res - (concat - res - (cl-subseq expected last j) - (propertize - (cl-subseq expected j (+ j len)) - 'face 'org-fc-diff-correct))) - (setq last (+ j len))) - (concat res (cl-subseq expected last)))) - -(defun org-fc-diff (got expected) - "Generate a colored diff of the strings GOT and EXPECTED." - (if (string= got expected) - (cons (propertize got 'face 'org-fc-diff-correct) nil) - (let ((blocks (org-fc-diff-matching-blocks - got expected - 0 0 - (1- (length got)) - (1- (length expected))))) - (cons - (org-fc-diff--propertize-got got blocks (length expected)) - (org-fc-diff--propertize-expected expected blocks))))) - ;;; Checking for / going to flashcard headings (defun org-fc-entry-p () |