branch: externals/org-real
commit 4e903f94fb138934b0f33cc56c89f1f8ebc9e26e
Author: Tyler Grinn <tylergr...@gmail.com>
Commit: Tyler Grinn <tylergr...@gmail.com>
Draw without canvas: no more whitespace around box diagram
---
org-real.el | 53 +++++---
tests/edge-cases.org | 342 +++++++++++++++++++++++----------------------------
2 files changed, 190 insertions(+), 205 deletions(-)
diff --git a/org-real.el b/org-real.el
index fdfba3d..b9c28c8 100644
--- a/org-real.el
+++ b/org-real.el
@@ -1,7 +1,7 @@
;;; org-real.el --- Keep track of real things as org-mode links -*-
lexical-binding: t -*-
;; Author: Tyler Grinn <tylergr...@gmail.com>
-;; Version: 0.3.0
+;; Version: 0.3.1
;; File: org-real.el
;; Package-Requires: ((emacs "26.1"))
;; Keywords: tools
@@ -245,9 +245,7 @@ MAX-LEVEL is the maximum level to show headlines for."
"Redraw `org-real--current-box' in the current buffer."
(org-real--make-dirty org-real--current-box)
(org-real--flex-adjust org-real--current-box)
- (let ((width (org-real--get-width org-real--current-box))
- (height (org-real--get-height org-real--current-box t))
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(erase-buffer)
(setq org-real--box-ring '())
(if org-real--current-containers
@@ -255,11 +253,19 @@ MAX-LEVEL is the maximum level to show headlines for."
(setq org-real--current-offset (- (line-number-at-pos)
org-real-margin-y
(* 2 org-real-padding-y)))
- (dotimes (_ height) (insert (concat (make-string width ?\s) "\n")))
- (org-real--draw org-real--current-box)
- (goto-char 0)
- (setq org-real--box-ring
- (seq-sort '< org-real--box-ring))))
+ (let ((box-coords (org-real--draw org-real--current-box)))
+ (setq org-real--box-ring
+ (seq-sort
+ '<
+ (mapcar
+ (lambda (coords)
+ (forward-line (- (car coords) (line-number-at-pos)))
+ (move-to-column (cdr coords))
+ (point))
+ box-coords))))
+ (goto-char (point-max))
+ (insert "\n")
+ (goto-char 0)))
(define-derived-mode org-real-mode special-mode
"Org Real"
@@ -269,8 +275,8 @@ The following commands are available:
\\{org-real-mode-map}"
:group 'org-mode
- (let ((inhibit-message t))
- (toggle-truncate-lines t)))
+ (setq indent-tabs-mode nil)
+ (let ((inhibit-message t)) (toggle-truncate-lines t)))
(mapc
(lambda (key) (define-key org-real-mode-map (kbd (car key)) (cdr key)))
@@ -680,7 +686,8 @@ OFFSET is the starting line to start insertion.
Adds to list `org-real--box-ring' the buffer position of each
button drawn."
- (let ((children (with-slots (children) box (org-real--get-all children))))
+ (let ((children (with-slots (children) box (org-real--get-all children)))
+ box-coords)
(with-slots
(name
behind
@@ -700,22 +707,32 @@ button drawn."
(align-bottom (or in-front on-top)))
(cl-flet* ((draw (coords str &optional primary)
(forward-line (- (car coords) (line-number-at-pos)))
+ (when (< (line-number-at-pos) (car coords))
+ (insert (make-string (- (car coords)
(line-number-at-pos)) ?\n)))
(move-to-column (cdr coords) t)
(if primary (put-text-property 0 (length str)
'face
'org-real-primary str))
(insert str)
- (delete-char (length str)))
+ (let ((remaining-chars (- (save-excursion
(end-of-line) (current-column))
+ (current-column))))
+ (delete-char (min (length str) remaining-chars))))
(draw-name (coords str &optional primary)
- (if (not locations) (draw coords str)
+ (if (not locations)
+ (draw coords str primary)
(forward-line (- (car coords)
(line-number-at-pos)))
+ (when (< (line-number-at-pos) (car coords))
+ (insert (make-string (- (car coords)
(line-number-at-pos)) ?\n)))
(move-to-column (cdr coords) t)
- (add-to-list 'org-real--box-ring (point))
+ (setq box-coords coords)
(if primary (put-text-property 0 (length str)
'face
'org-real-primary str))
(insert-button str
'help-echo "Jump to first
occurence"
'keymap
(org-real--create-button-keymap box))
- (delete-char (length str)))))
+ (let ((remaining-chars (- (save-excursion
(end-of-line)
+
(current-column))
+ (current-column))))
+ (delete-char (min (length str)
remaining-chars))))))
(draw (cons top left)
(concat (if double "╔" "┌")
(make-string (- width 2) (cond (dashed #x254c)
@@ -749,7 +766,9 @@ button drawn."
(double "║")
(t "│")))
(setq r (+ r 1))))))))
- (mapc 'org-real--draw children)))
+ (apply 'append
+ (if box-coords (list box-coords) nil)
+ (mapcar 'org-real--draw children))))
(cl-defmethod org-real--get-width ((box org-real-box))
"Get the width of BOX."
diff --git a/tests/edge-cases.org b/tests/edge-cases.org
index e77e850..3c8a2ba 100644
--- a/tests/edge-cases.org
+++ b/tests/edge-cases.org
@@ -6,222 +6,190 @@
#+begin_example
The 1-0 is above the 1-1 on top of the 1-2.
-
- ┌───────┐
- │ │
- │ 1-0 │
- │ │
- └───────┘
-
- ┌───────┐
- │ │
- │ 1-1 │
- │ │
- ┌──┴───────┴──┐
- │ │
- │ 1-2 │
- │ │
- └─────────────┘
-
-
-
-
+
+ ┌───────┐
+ │ │
+ │ 1-0 │
+ │ │
+ └───────┘
+
+ ┌───────┐
+ │ │
+ │ 1-1 │
+ │ │
+ ┌──┴───────┴──┐
+ │ │
+ │ 1-2 │
+ │ │
+ └─────────────┘
#+end_example
** PASS [[real://6-4/6-3?rel=on top of/6-2?rel=on top of/6-1?rel=above][Is
above an on top of an on top]]
#+begin_example
The 6-1 is above the 6-2 on top of the 6-3 on top of the 6-4.
-
- ┌───────┐
- │ │
- │ 6-1 │
- │ │
- └───────┘
-
- ┌───────┐
- │ │
- │ 6-2 │
- │ │
- ┌──┴───────┴──┐
- │ │
- │ 6-3 │
- │ │
- ┌──┴─────────────┴──┐
- │ │
- │ 6-4 │
- │ │
- └───────────────────┘
-
-
-
-
+
+ ┌───────┐
+ │ │
+ │ 6-1 │
+ │ │
+ └───────┘
+
+ ┌───────┐
+ │ │
+ │ 6-2 │
+ │ │
+ ┌──┴───────┴──┐
+ │ │
+ │ 6-3 │
+ │ │
+ ┌──┴─────────────┴──┐
+ │ │
+ │ 6-4 │
+ │ │
+ └───────────────────┘
#+end_example
** PASS [[real://7-3/7-2?rel=on top of/7-1?rel=below][Is below an on top]]
#+begin_example
The 7-1 is below the 7-2 on top of the 7-3.
-
- ┌───────┐
- │ │
- │ 7-2 │
- │ │
- ┌──┴───────┴──┐
- │ │
- │ 7-3 │
- │ │
- │ ┌───────┐ │
- │ │ │ │
- │ │ 7-1 │ │
- │ │ │ │
- │ └───────┘ │
- └─────────────┘
-
-
-
-
+
+ ┌───────┐
+ │ │
+ │ 7-2 │
+ │ │
+ ┌──┴───────┴──┐
+ │ │
+ │ 7-3 │
+ │ │
+ │ ┌───────┐ │
+ │ │ │ │
+ │ │ 7-1 │ │
+ │ │ │ │
+ │ └───────┘ │
+ └─────────────┘
#+end_example
** PASS [[real://2-4/2-3?rel=on top of/2-2?rel=on top of/2-1?rel=below][Is
below an on top of an on top]]
#+begin_example
The 2-1 is below the 2-2 on top of the 2-3 on top of the 2-4.
-
- ┌───────┐
- │ │
- │ 2-2 │
- │ │
- ┌──┴───────┴──┐
- │ │
- │ 2-3 │
- │ │
- │ ┌───────┐ │
- │ │ │ │
- │ │ 2-1 │ │
- │ │ │ │
- │ └───────┘ │
- ┌──┴─────────────┴──┐
- │ │
- │ 2-4 │
- │ │
- └───────────────────┘
-
-
-
-
+
+ ┌───────┐
+ │ │
+ │ 2-2 │
+ │ │
+ ┌──┴───────┴──┐
+ │ │
+ │ 2-3 │
+ │ │
+ │ ┌───────┐ │
+ │ │ │ │
+ │ │ 2-1 │ │
+ │ │ │ │
+ │ └───────┘ │
+ ┌──┴─────────────┴──┐
+ │ │
+ │ 2-4 │
+ │ │
+ └───────────────────┘
#+end_example
** PASS [[real://3-3?rel=in/3-2?rel=in front of/3-1?rel=above][Is above an in
front]]
#+begin_example
The 3-1 is above the 3-2 in front of the 3-3.
-
- ┌─────────────┐
- │ │
- │ 3-3 │
- │ │
- │ ┌───────┐ │
- │ │ │ │
- │ │ 3-1 │ │
- │ │ │ │
- │ └───────┘ │
- │ │
- │ ┌───────┐ │
- │ │ │ │
- │ │ 3-2 │ │
- │ │ │ │
- └──┴───────┴──┘
-
-
-
-
+
+ ┌─────────────┐
+ │ │
+ │ 3-3 │
+ │ │
+ │ ┌───────┐ │
+ │ │ │ │
+ │ │ 3-1 │ │
+ │ │ │ │
+ │ └───────┘ │
+ │ │
+ │ ┌───────┐ │
+ │ │ │ │
+ │ │ 3-2 │ │
+ │ │ │ │
+ └──┴───────┴──┘
#+end_example
** PASS [[real://5-4/5-3?rel=in front of/5-2?rel=in front of/5-1?rel=above][Is
above an in front of an in front]]
#+begin_example
The 5-1 is above the 5-2 in front of the 5-3 in front of the 5-4.
-
- ┌───────────────────┐
- │ │
- │ 5-4 │
- │ │
- │ ┌─────────────┐ │
- │ │ │ │
- │ │ 5-3 │ │
- │ │ │ │
- │ │ ┌───────┐ │ │
- │ │ │ │ │ │
- │ │ │ 5-1 │ │ │
- │ │ │ │ │ │
- │ │ └───────┘ │ │
- │ │ │ │
- │ │ ┌───────┐ │ │
- │ │ │ │ │ │
- │ │ │ 5-2 │ │ │
- │ │ │ │ │ │
- └──┴──┴───────┴──┴──┘
-
-
-
-
+
+ ┌───────────────────┐
+ │ │
+ │ 5-4 │
+ │ │
+ │ ┌─────────────┐ │
+ │ │ │ │
+ │ │ 5-3 │ │
+ │ │ │ │
+ │ │ ┌───────┐ │ │
+ │ │ │ │ │ │
+ │ │ │ 5-1 │ │ │
+ │ │ │ │ │ │
+ │ │ └───────┘ │ │
+ │ │ │ │
+ │ │ ┌───────┐ │ │
+ │ │ │ │ │ │
+ │ │ │ 5-2 │ │ │
+ │ │ │ │ │ │
+ └──┴──┴───────┴──┴──┘
#+end_example
** PASS [[real://4-3/4-2?rel=in front of/4-1?rel=below][Is below an in front]]
#+begin_example
The 4-1 is below the 4-2 in front of the 4-3.
-
- ┌─────────────┐
- │ │
- │ 4-3 │
- │ │
- │ ┌───────┐ │
- │ │ │ │
- │ │ 4-2 │ │
- │ │ │ │
- └──┴───────┴──┘
-
- ┌───────┐
- │ │
- │ 4-1 │
- │ │
- └───────┘
-
-
-
-
+
+ ┌─────────────┐
+ │ │
+ │ 4-3 │
+ │ │
+ │ ┌───────┐ │
+ │ │ │ │
+ │ │ 4-2 │ │
+ │ │ │ │
+ └──┴───────┴──┘
+
+ ┌───────┐
+ │ │
+ │ 4-1 │
+ │ │
+ └───────┘
#+end_example
** PASS [[real://8-4/8-3?rel=in front of/8-2?rel=in front of/8-1?rel=below][Is
below an in front of an in front]]
#+begin_example
The 8-1 is below the 8-2 in front of the 8-3 in front of the 8-4.
-
- ┌───────────────────┐
- │ │
- │ 8-4 │
- │ │
- │ ┌─────────────┐ │
- │ │ │ │
- │ │ 8-3 │ │
- │ │ │ │
- │ │ ┌───────┐ │ │
- │ │ │ │ │ │
- │ │ │ 8-2 │ │ │
- │ │ │ │ │ │
- └──┴──┴───────┴──┴──┘
-
- ┌───────┐
- │ │
- │ 8-1 │
- │ │
- └───────┘
-
-
-
-
+
+ ┌───────────────────┐
+ │ │
+ │ 8-4 │
+ │ │
+ │ ┌─────────────┐ │
+ │ │ │ │
+ │ │ 8-3 │ │
+ │ │ │ │
+ │ │ ┌───────┐ │ │
+ │ │ │ │ │ │
+ │ │ │ 8-2 │ │ │
+ │ │ │ │ │ │
+ └──┴──┴───────┴──┴──┘
+
+ ┌───────┐
+ │ │
+ │ 8-1 │
+ │ │
+ └───────┘
#+end_example
* Merging links
@@ -231,18 +199,16 @@
- [[real://thing3/thing2?rel=on top of]]
#+end_src
#+begin_example
-
- ┌──────────┐ ┌──────────┐
- │ │ │ │
- │ thing2 │ │ thing1 │
- │ │ │ │
- ┌──┴──────────┴──┴──────────┴──┐
- │ │
- │ thing3 │
- │ │
- └──────────────────────────────┘
-
-
-
-
+
+ ┌──────────┐ ┌──────────┐
+ │ │ │ │
+ │ thing2 │ │ thing1 │
+ │ │ │ │
+ ┌──┴──────────┴──┴──────────┴──┐
+ │ │
+ │ thing3 │
+ │ │
+ └──────────────────────────────┘
#+end_example
+
+
