branch: externals/org-real
commit 9608f532f38bd8be78fd35fd824f3a33c326a439
Author: Tyler Grinn <tylergr...@gmail.com>
Commit: Tyler Grinn <tylergr...@gmail.com>
Satisfying elc compiler
---
org-real--box.el | 551 +++++++++++++++++++++++++++++++++----------------------
org-real.el | 35 ++--
2 files changed, 343 insertions(+), 243 deletions(-)
diff --git a/org-real--box.el b/org-real--box.el
index eba0c0d..a988dc8 100644
--- a/org-real--box.el
+++ b/org-real--box.el
@@ -4,7 +4,8 @@
;; Box class definition and related methods
-;;;; Patch! 0.0.1 -> 0.1.0
+;;;; Patch! 0.0.1 -> 0.1.0+
+;;;; Will be removed in version 1.0.0+
(and (fboundp 'org-real--map-immediate) (fmakunbound 'org-real--map-immediate))
(and (fboundp 'org-real--next) (fmakunbound 'org-real--next))
@@ -23,7 +24,19 @@
(require 'eieio)
(require 'cl-lib)
-;;;; Class definition
+;;;; Class definitions
+
+;; Define empty class for use in collection, redefine afterwards
+;; (defclass org-real--box ()
+ ;; nil
+ ;; "A representation of a box in 3D space.")
+
+(defclass org-real--box-collection ()
+ ((box :initarg :box
+ :type org-real--box)
+ (next :initarg :next
+ :type org-real--box-collection))
+ "A collection of `org-real--box'es.")
(defclass org-real--box ()
((name :initarg :name
@@ -47,22 +60,37 @@
(parent :initarg :parent
:type org-real--box)
(children :initarg :children
- :initform '()
- :type list)
+ :initform (org-real--box-collection)
+ :type org-real--box-collection)
(primary :initarg :primary
:initform nil
- :type boolean)))
+ :type boolean))
+ "A representation of a box in 3D space.")
+
+
+;;;; Constants
+
+(defvar org-real--padding '(2 . 1)
+ "Padding used when displaying a real link.")
+
+(defvar org-real--margin '(2 . 1)
+ "Margin used when displaying a real link.")
;;;; Exports
-(defun org-real--create-box (containers)
- "Create an `org-real--box' from CONTAINERS.
+(cl-defmethod org-real--make-instance ((_ (subclass org-real--box)) containers)
+ "Create an instance of `org-real--box' from CONTAINERS.
CONTAINERS is a list of plists containing at least a :name
-property and optionally a :rel property. PARENT and PREV
-parameters are used internally and should not be supplied."
- (let ((world (org-real--box)))
- (org-real--create-box-helper containers world)
+property and optionally a :rel property."
+ (when-let* ((world (org-real--box))
+ (base-container (pop containers))
+ (base (org-real--box :name (plist-get base-container :name))))
+ (oset base :parent world)
+ (with-slots (children) world
+ (setq children (org-real--add-to-list children base)))
+ (if containers
+ (org-real--make-instance-helper containers world base))
world))
(defun org-real--merge (boxes)
@@ -82,42 +110,39 @@ parameters are used internally and should not be supplied."
"Insert an ascii drawing of BOX into the current buffer.
OFFSET is the starting line to start insertion."
- (let ((children (oref box :children)))
+ (let ((children (with-slots (children) box (org-real--get-all children))))
(if (slot-boundp box :name)
- (let* ((top (+ offset (org-real--get-top box)))
- (left (org-real--get-left box))
- (width (org-real--get-width box))
- (height (org-real--get-height box))
- (name (oref box :name))
- (dashed (oref box :behind))
- (align-bottom (oref box :in-front))
- (primary (oref box :primary)))
- (cl-flet ((draw (coords str &optional primary)
- (forward-line (- (car coords) (line-number-at-pos)))
- (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))))
- (draw (cons top left)
- (concat "┌" (make-string (- width 2) (if dashed #x254c
#x2500)) "┐"))
- (if align-bottom
- (draw (cons (+ top height -1 (cdr org-real--margin)) left)
- (concat "┴" (make-string (- width 2) (if dashed #x254c
#x2500)) "┴"))
- (draw (cons (+ top height -1) left)
- (concat "└" (make-string (- width 2) (if dashed #x254c
#x2500)) "┘")))
- (draw (cons (+ top 1 (cdr org-real--padding))
- (+ left 1 (car org-real--padding)))
- name
- primary)
- (let ((r (+ top 1))
- (c1 left)
- (c2 (+ left width -1)))
- (dotimes (_ (- height (if align-bottom 1 2)))
- (draw (cons r c1) (if dashed "╎" "│"))
- (draw (cons r c2) (if dashed "╎" "│"))
- (setq r (+ r 1)))))))
+ (with-slots (name behind (align-bottom in-front) (dashed behind)
primary) box
+ (let* ((top (+ offset (org-real--get-top box)))
+ (left (org-real--get-left box))
+ (width (org-real--get-width box))
+ (height (org-real--get-height box)))
+ (cl-flet ((draw (coords str &optional primary)
+ (forward-line (- (car coords)
(line-number-at-pos)))
+ (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))))
+ (draw (cons top left)
+ (concat "┌" (make-string (- width 2) (if dashed #x254c
#x2500)) "┐"))
+ (if align-bottom
+ (draw (cons (+ top height -1 (cdr org-real--margin)) left)
+ (concat "┴" (make-string (- width 2) (if dashed #x254c
#x2500)) "┴"))
+ (draw (cons (+ top height -1) left)
+ (concat "└" (make-string (- width 2) (if dashed #x254c
#x2500)) "┘")))
+ (draw (cons (+ top 1 (cdr org-real--padding))
+ (+ left 1 (car org-real--padding)))
+ name
+ primary)
+ (let ((r (+ top 1))
+ (c1 left)
+ (c2 (+ left width -1)))
+ (dotimes (_ (- height (if align-bottom 1 2)))
+ (draw (cons r c1) (if dashed "╎" "│"))
+ (draw (cons r c2) (if dashed "╎" "│"))
+ (setq r (+ r 1))))))))
(mapc
(lambda (child) (org-real--draw child offset))
children)))
@@ -126,19 +151,21 @@ OFFSET is the starting line to start insertion."
"Get the width of BOX."
(let* ((base-width (+ 2 ; box walls
(* 2 (car org-real--padding))))
- (width (+ base-width (if (slot-boundp box :name)
- (length (oref box :name))
- 0)))
- (children (oref box :children)))
+ (width (+ base-width
+ (if (slot-boundp box :name)
+ (with-slots (name) box (length name))
+ 0)))
+ (children (with-slots (children) box (org-real--get-all children))))
(if (not children)
width
- (let* ((column-indices (delete-duplicates
- (mapcar (lambda (child) (oref child :x-order))
children)))
+ (let* ((column-indices (cl-delete-duplicates
+ (mapcar (lambda (child) (with-slots (x-order)
child x-order)) children)))
(columns (mapcar
(lambda (c)
(seq-filter
(lambda (child)
- (= c (oref child :x-order)))
+ (with-slots (x-order) child
+ (= c x-order)))
children))
column-indices))
(column-widths (mapcar
@@ -156,23 +183,24 @@ OFFSET is the starting line to start insertion."
(cl-defmethod org-real--get-height ((box org-real--box))
"Get the height of BOX."
- (let* ((in-front (oref box :in-front))
+ (let* ((in-front (with-slots (in-front) box in-front))
(height (+ (if in-front
(* -1 (cdr org-real--margin))
0)
2 ; box walls
(* 2 (cdr org-real--padding))
(cdr org-real--margin)))
- (children (oref box :children)))
+ (children (with-slots (children) box (org-real--get-all children))))
(if (not children)
height
- (let* ((row-indices (delete-duplicates
- (mapcar (lambda (child) (oref child :y-order))
children)))
+ (let* ((row-indices (cl-delete-duplicates
+ (mapcar (lambda (child) (with-slots (y-order) child
y-order)) children)))
(rows (mapcar
(lambda (r)
(seq-filter
(lambda (child)
- (= r (oref child :y-order)))
+ (with-slots (y-order) child
+ (= r y-order)))
children))
row-indices))
(row-heights (mapcar
@@ -185,20 +213,22 @@ OFFSET is the starting line to start insertion."
"Get the top row index of BOX."
(if (not (slot-boundp box :parent))
0
- (let* ((offset (+ 1 (* 2 (cdr org-real--padding)) (cdr org-real--margin)))
- (parent (oref box :parent))
- (top (+ offset (org-real--get-top parent))))
- (let* ((x-order (oref box :x-order))
- (y-order (oref box :y-order))
+ (with-slots (parent x-order y-order) box
+ (let* ((offset (+ 1 (* 2 (cdr org-real--padding)) (cdr
org-real--margin)))
+ (top (+ offset (org-real--get-top parent)))
(above (seq-filter
- (lambda (child) (and (= x-order (oref child :x-order))
- (< (oref child :y-order) y-order)))
- (oref parent :children)))
+ (lambda (child)
+ (with-slots ((child-x x-order) (child-y y-order)) child
+ (and (= x-order child-x)
+ (< child-y y-order))))
+ (org-real--get-all (with-slots (children) parent
children))))
(directly-above (and above (seq-reduce
(lambda (max child)
- (if (> (oref child :y-order) (oref
max :y-order))
- child
- max))
+ (with-slots ((max-y y-order)) max
+ (with-slots ((child-y y-order))
child
+ (if (> child-y max-y)
+ child
+ max))))
above
(org-real--box :y-order -9999))))
(above-height (and directly-above (apply 'max
@@ -206,102 +236,139 @@ OFFSET is the starting line to start insertion."
'org-real--get-height
(seq-filter
(lambda (child)
- (= (oref
directly-above :y-order)
- (oref child
:y-order)))
- (oref parent
:children)))))))
+ (= (with-slots
(y-order) directly-above y-order)
+ (with-slots
(y-order) child y-order)))
+ (org-real--get-all
+ (with-slots
(children) parent children))))))))
(if directly-above
(+ (org-real--get-top directly-above)
above-height)
- (if (and (slot-boundp box :rel)
- (or (string= "to the left of" (oref box :rel))
- (string= "to the right of" (oref box :rel))))
- (org-real--get-top (oref box :rel-box))
- top))))))
+ (with-slots (rel rel-box) box
+ (if (and (slot-boundp box :rel)
+ (or (string= "to the left of" rel)
+ (string= "to the right of" rel)))
+ (org-real--get-top rel-box)
+ top)))))))
(cl-defmethod org-real--get-left ((box org-real--box))
"Get the left column index of BOX."
(if (not (slot-boundp box :parent))
0
- (let* ((parent (oref box :parent))
- (left (+ 1
- (car org-real--padding)
- (org-real--get-left parent)))
- (to-the-left (seq-filter
- (lambda (child) (and (= (oref box :y-order) (oref
child :y-order))
- (< (oref child :x-order) (oref
box :x-order))))
- (oref parent :children)))
- (directly-left (and to-the-left
- (seq-reduce
- (lambda (max child)
- (if (> (oref child :x-order) (oref max
:x-order))
- child
- max))
- to-the-left
- (org-real--box :x-order -9999)))))
- (if directly-left
- (+ (org-real--get-left directly-left)
- (org-real--get-width directly-left)
- (car org-real--margin))
- (if (and (slot-boundp box :rel)
- (or (string= "above" (oref box :rel))
- (string= "below" (oref box :rel))))
- (org-real--get-left (oref box :rel-box))
- left)))))
+ (with-slots (parent x-order y-order) box
+ (let* ((left (+ 1
+ (car org-real--padding)
+ (org-real--get-left parent)))
+ (to-the-left (seq-filter
+ (lambda (child)
+ (with-slots ((child-y y-order) (child-x x-order))
child
+ (and (= y-order child-y)
+ (< child-x x-order))))
+ (org-real--get-all (with-slots (children) parent
children))))
+ (directly-left (and to-the-left
+ (seq-reduce
+ (lambda (max child)
+ (with-slots ((max-x x-order)) max
+ (with-slots ((child-x x-order)) child
+ (if (> child-x max-x)
+ child
+ max))))
+ to-the-left
+ (org-real--box :x-order -9999)))))
+ (if directly-left
+ (+ (org-real--get-left directly-left)
+ (org-real--get-width directly-left)
+ (car org-real--margin))
+ (with-slots (rel rel-box) box
+ (if (and (slot-boundp box :rel)
+ (or (string= "above" rel)
+ (string= "below" rel)))
+ (org-real--get-left rel-box)
+ left)))))))
;;;; Utility expressions
-
-(defun org-real--create-box-helper (containers parent &optional prev)
+
+(cl-defmethod org-real--get-all ((collection org-real--box-collection))
+ "Get all boxes in COLLECTION as a sequence."
+ (with-slots (box next) collection
+ (append (if (slot-boundp collection :box) (list box))
+ (if (slot-boundp collection :next) (org-real--get-all next)))))
+
+(cl-defmethod org-real--add-to-list ((collection org-real--box-collection)
+ (box org-real--box))
+ "Add BOX to COLLECTION and return new COLLECTION"
+ (if (slot-boundp collection :box)
+ (org-real--box-collection
+ :box box
+ :next collection)
+ (oset collection :box box)
+ collection))
+
+(cl-defmethod org-real--make-instance-helper (containers parent (prev
org-real--box))
+ "Help create a 3D representation of CONTAINERS.
+
+PREV must already existing in PARENT."
(let* ((container (pop containers))
(rel (plist-get container :rel))
(box (org-real--box :name (plist-get container :name))))
(when prev
(oset box :rel (plist-get container :rel))
(oset box :rel-box prev)
- (cond ((or (string= rel "in") (string= rel "on"))
- (oset box :x-order (oref prev :x-order))
- (oset box :y-order (oref prev :y-order))
- (oset box :behind (oref prev :behind)))
- ((string= rel "behind")
- (oset box :x-order (oref prev :x-order))
- (oset box :y-order (oref prev :y-order))
- (oset box :behind t))
- ((string= rel "in front of")
- (oset box :x-order (oref prev :x-order))
- (oset box :y-order 9999)
- (oset box :behind (oref prev :behind))
- (oset box :in-front t))
- ((string= rel "above")
- (oset box :x-order (oref prev :x-order))
- (oset box :y-order (- (oref prev :y-order) 1))
- (oset box :behind (oref prev :behind)))
- ((string= rel "below")
- (oset box :x-order (oref prev :x-order))
- (oset box :y-order (+ 1 (oref prev :y-order)))
- (oset box :behind (oref prev :behind))
- (oset box :in-front (oref prev :in-front)))
- ((string= rel "to the left of")
- (oset box :x-order (- (oref prev :x-order) 1))
- (oset box :y-order (oref prev :y-order))
- (oset box :behind (oref prev :behind))
- (oset box :in-front (oref prev :in-front)))
- ((string= rel "to the right of")
- (oset box :x-order (+ 1 (oref prev :x-order)))
- (oset box :y-order (oref prev :y-order))
- (oset box :behind (oref prev :behind))
- (oset box :in-front (oref prev :in-front)))))
+ (with-slots
+ ((cur-x x-order)
+ (cur-y y-order)
+ (cur-behind behind)
+ (cur-in-front in-front))
+ box
+ (with-slots
+ ((prev-x x-order)
+ (prev-y y-order)
+ (prev-behind behind)
+ (prev-in-front in-front))
+ prev
+ (cond ((or (string= rel "in") (string= rel "on"))
+ (setq cur-x prev-x)
+ (setq cur-y prev-y)
+ (setq cur-behind prev-behind))
+ ((string= rel "behind")
+ (setq cur-x prev-x)
+ (setq cur-y prev-y)
+ (setq cur-behind t))
+ ((string= rel "in front of")
+ (setq cur-x prev-x)
+ (setq cur-y 9999)
+ (setq cur-behind prev-behind)
+ (setq cur-in-front t))
+ ((string= rel "above")
+ (setq cur-x prev-x)
+ (setq cur-y (- prev-y 1))
+ (setq cur-behind prev-behind))
+ ((string= rel "below")
+ (setq cur-x prev-x)
+ (setq cur-y (+ 1 prev-y))
+ (setq cur-behind prev-behind)
+ (setq cur-in-front prev-in-front))
+ ((string= rel "to the left of")
+ (setq cur-x (- prev-x 1))
+ (setq cur-y prev-y)
+ (setq cur-behind prev-behind)
+ (setq cur-in-front prev-in-front))
+ ((string= rel "to the right of")
+ (setq cur-x (+ 1 prev-x))
+ (setq cur-y prev-y)
+ (setq cur-behind prev-behind)
+ (setq cur-in-front prev-in-front))))))
- (if (and prev (member (oref box :rel)
- '("in" "on" "behind" "in front of")))
+ (if (and prev (member rel '("in" "on" "behind" "in front of")))
(progn
(oset box :parent prev)
- (object-add-to-list prev :children box)
+ (oset prev :children (org-real--add-to-list (with-slots (children)
prev children) box))
(if containers
- (org-real--create-box-helper containers prev box)
+ (org-real--make-instance-helper containers prev box)
(oset box :primary t)))
(oset box :parent parent)
- (object-add-to-list parent :children box)
+ (oset parent :children (org-real--add-to-list (with-slots (children)
parent children) box))
(if containers
- (org-real--create-box-helper containers parent box)
+ (org-real--make-instance-helper containers parent box)
(oset box :primary t)))))
(cl-defmethod org-real--map-immediate (fn (box org-real--box))
@@ -319,18 +386,29 @@ FN."
"Retrieve any boxes for which the :rel-box slot is BOX.
If EXCLUDE-CHILDREN, only retrieve sibling boxes."
- (let ((relatives (append (if exclude-children '() (oref box :children))
- (if (slot-boundp box :parent) (oref (oref box
:parent) :children) '()))))
+ (let ((relatives (append (if exclude-children '() (org-real--get-all
+ (with-slots (children)
box children)))
+ (if (slot-boundp box :parent)
+ (org-real--get-all
+ (with-slots
+ (children)
+ (with-slots (parent) box parent)
+ children))
+ '()))))
(seq-filter
(lambda (relative)
(and (slot-boundp relative :rel-box)
- (string= (oref (oref relative :rel-box) :name)
- (oref box :name))))
+ (string= (with-slots
+ (name)
+ (with-slots (rel-box) relative rel-box)
+ name)
+ (with-slots (name) box name))))
relatives)))
(cl-defmethod org-real--expand ((box org-real--box))
"Get a list of all boxes, including BOX, that are children of BOX."
- (apply 'append (list box) (mapcar 'org-real--expand (oref box :children))))
+ (with-slots (children) box
+ (apply 'append (list box) (mapcar 'org-real--expand (org-real--get-all
children)))))
(cl-defmethod org-real--merge-into ((from org-real--box) (to org-real--box))
"Merge FROM box into TO box."
@@ -342,7 +420,8 @@ If EXCLUDE-CHILDREN, only retrieve sibling boxes."
(lambda (to-box)
(when (and (slot-boundp from-box :name)
(slot-boundp to-box :name)
- (string= (oref from-box :name) (oref to-box
:name)))
+ (string= (with-slots (name) from-box name)
+ (with-slots (name) to-box name)))
(org-real--add-matching from-box to-box to)
t))
to-boxes))
@@ -356,58 +435,76 @@ If EXCLUDE-CHILDREN, only retrieve sibling boxes."
MATCH is used to set the :rel-box and :parent slots on children
of BOX."
- (let ((next-boxes (org-real--next box))
- (parent (oref match :parent)))
- (mapc
- (lambda (next)
- (let ((rel (oref next :rel)))
- (cond
- ((string= rel "above")
- (let ((y-order (oref match :y-order)))
- (oset next :y-order y-order)
+ (with-slots
+ (parent
+ (match-y y-order)
+ (match-x x-order)
+ (match-behind behind)
+ (match-in-front in-front))
+ match
+ (let ((next-boxes (org-real--next box)))
+ (mapc
+ (lambda (next)
+ (with-slots
+ (rel
+ (next-y y-order)
+ (next-x x-order)
+ (next-behind behind)
+ (next-in-front in-front))
+ next
+ (cond
+ ((string= rel "above")
+ (setq next-y match-y)
(org-real--map-immediate
- (lambda (box) (when (>= (oref box :y-order) y-order)
- (oset box :y-order (+ 1 (oref box :y-order)))))
- match))
- (oset next :x-order (oref match :x-order))
- (oset next :behind (oref match :behind)))
- ((string= rel "below")
- (let ((y-order (oref match :y-order)))
- (oset next :y-order (+ 1 y-order))
+ (lambda (child)
+ (with-slots ((child-y y-order)) child
+ (when (>= child-y match-y)
+ (setq child-y (+ 1 child-y)))))
+ match)
+ (setq next-x match-x)
+ (setq next-behind match-behind))
+ ((string= rel "below")
+ (setq next-y (+ 1 match-y))
(org-real--map-immediate
- (lambda (box) (when (> (oref box :y-order) y-order)
- (oset box :y-order (+ 1 (oref box :y-order)))))
- match))
- (oset next :x-order (oref match :x-order))
- (oset next :behind (oref match :behind)))
- ((string= rel "to the right of")
- (let ((x-order (oref match :x-order)))
- (oset next :x-order (+ 1 x-order))
+ (lambda (child)
+ (with-slots ((child-y y-order)) child
+ (when (> child-y match-y)
+ (setq child-y (+ 1 child-y)))))
+ match)
+ (setq next-x match-x)
+ (setq next-behind match-behind))
+ ((string= rel "to the right of")
+ (setq next-x (+ 1 match-x))
(org-real--map-immediate
- (lambda (box) (when (> (oref box :x-order) x-order)
- (oset box :x-order (+ 1 (oref box :x-order)))))
- match))
- (oset next :y-order (oref match :y-order))
- (oset next :behind (oref match :behind))
- (oset next :in-front (oref match :in-front)))
- ((string= rel "to the left of")
- (let ((x-order (oref match :x-order)))
- (oset next :x-order x-order)
+ (lambda (child)
+ (with-slots ((child-x x-order)) child
+ (when (> child-x match-x)
+ (setq child-x (+ 1 child-x)))))
+ match)
+ (setq next-y match-y)
+ (setq next-behind match-behind)
+ (setq next-in-front match-in-front))
+ ((string= rel "to the left of")
+ (setq next-x match-x)
(org-real--map-immediate
- (lambda (box) (when (>= (oref box :x-order) x-order)
- (oset box :x-order (+ 1 (oref box :x-order)))))
- match))
- (oset next :y-order (oref match :y-order))
- (oset next :behind (oref match :behind))
- (oset next :in-front (oref match :in-front))))
-
- (oset next :rel-box match)
- (if (member rel '("in" "on" "behind" "in front of"))
- (org-real--flex-add next match world)
- (oset next :parent parent)
- (object-add-to-list parent :children next))
- (org-real--add-matching next next world)))
- next-boxes)))
+ (lambda (child)
+ (with-slots ((child-x x-order)) child
+ (when (>= child-x match-x)
+ (setq child-x (+ 1 child-x)))))
+ match)
+ (setq next-y match-y)
+ (setq next-behind match-behind)
+ (setq next-in-front match-in-front)))
+
+ (oset next :rel-box match)
+ (if (member rel '("in" "on" "behind" "in front of"))
+ (org-real--flex-add next match world)
+ (oset next :parent parent)
+ (oset parent :children (org-real--add-to-list
+ (with-slots (children) parent children)
+ next)))
+ (org-real--add-matching next next world)))
+ next-boxes))))
(cl-defmethod org-real--flex-add ((box org-real--box)
(parent org-real--box)
@@ -416,32 +513,42 @@ of BOX."
This function ignores the :rel slot and adds BOX in such a way
that the width of WORLD is kept below 80 characters if possible."
- (let* ((cur-width (org-real--get-width world))
- (siblings (oref parent :children))
- (last-sibling (and siblings (seq-reduce
- (lambda (max sibling)
- (let ((max-x (oref max :x-order))
- (max-y (oref max :y-order))
- (sibling-x (oref sibling :x-order))
- (sibling-y (oref sibling
:y-order)))
- (if (> sibling-y max-y)
- sibling
- (if (and (= max-y sibling-y) (>
sibling-x max-x))
- sibling
- max))))
- (seq-filter
- (lambda (sibling) (not (oref sibling
:in-front)))
- siblings)
- (org-real--box :y-order -9999)))))
- (oset box :parent parent)
- (object-add-to-list parent :children box)
- (when (and last-sibling (not (oref box :in-front)))
- (oset box :y-order (oref last-sibling :y-order))
- (oset box :x-order (+ 1 (oref last-sibling :x-order)))
- (let ((new-width (org-real--get-width world)))
- (when (and (> new-width cur-width) (> new-width 80))
- (oset box :y-order (+ 1 (oref last-sibling :y-order)))
- (oset box :x-order 0))))))
+ (with-slots ((siblings children)) parent
+ (let* ((cur-width (org-real--get-width world))
+ (siblings (org-real--get-all siblings))
+ (last-sibling (and siblings (seq-reduce
+ (lambda (max sibling)
+ (with-slots
+ ((max-x x-order)
+ (max-y y-order))
+ max
+ (with-slots
+ ((sibling-x x-order)
+ (sibling-y y-order))
+ sibling
+ (if (> sibling-y max-y)
+ sibling
+ (if (and (= max-y sibling-y)
(> sibling-x max-x))
+ sibling
+ max)))))
+ (seq-filter
+ (lambda (sibling)
+ (not (with-slots (in-front) sibling
in-front)))
+ siblings)
+ (org-real--box :y-order -9999)))))
+ (oset box :parent parent)
+ (oset parent :children (org-real--add-to-list (with-slots (children)
parent children) box))
+ (when (and last-sibling (not (with-slots (in-front) box in-front)))
+ (with-slots
+ ((last-sibling-y y-order)
+ (last-sibling-x x-order))
+ last-sibling
+ (oset box :y-order last-sibling-y)
+ (oset box :x-order (+ 1 last-sibling-x))
+ (let ((new-width (org-real--get-width world)))
+ (when (and (> new-width cur-width) (> new-width 80))
+ (oset box :y-order (+ 1 last-sibling-y))
+ (oset box :x-order 0))))))))
diff --git a/org-real.el b/org-real.el
index 5596c99..c721247 100644
--- a/org-real.el
+++ b/org-real.el
@@ -19,9 +19,8 @@
;;;; Requirements
-(require 'eieio)
-(require 'org)
-(require 'cl-lib)
+(require 'org-element)
+(require 'cl-extra)
(require 'org-real--box)
@@ -39,12 +38,6 @@
'("in" "on" "behind" "in front of" "above" "below" "to the left of" "to the
right of")
"List of available prepositions for things.")
-(defvar org-real--padding '(2 . 1)
- "Padding used when displaying a real link.")
-
-(defvar org-real--margin '(2 . 1)
- "Margin used when displaying a real link.")
-
;;;; Utility expressions
(defun org-real--find-last-index (pred sequence)
@@ -112,8 +105,10 @@ Returns a list of plists with a :name property and
optionally a
(interactive)
(org-real--pp
(org-real--merge
- (mapcar 'org-real--create-box
- (org-real--parse-buffer)))))
+ (mapcar
+ (lambda (containers)
+ (org-real--make-instance 'org-real--box containers))
+ (org-real--parse-buffer)))))
;;;; `org-insert-link' configuration
@@ -121,12 +116,10 @@ Returns a list of plists with a :name property and
optionally a
:follow #'org-real-follow
:complete #'org-real-complete)
-(defun org-real-follow (url &rest args)
- "Open a real link URL in a popup buffer.
-
-ARGS are ignored."
+(defun org-real-follow (url &rest _)
+ "Open a real link URL in a popup buffer."
(let* ((containers (org-real--parse-url url))
- (box (org-real--create-box (copy-tree containers))))
+ (box (org-real--make-instance 'org-real--box (copy-tree containers))))
(org-real--pp box (copy-tree containers))))
(defun org-real-complete (&optional existing)
@@ -137,7 +130,7 @@ ARGS are ignored."
(org-real--complete-thing "Thing: " container-matrix))))
(catch 'confirm
(while t
- (org-real--pp (org-real--create-box containers) containers)
+ (org-real--pp (org-real--make-instance 'org-real--box containers)
containers)
(let ((response (read-event "RETURN - Confirm\nBACKSPACE - Remove
context\n+ - Add context")))
(cond
((eq response 'return)
@@ -204,16 +197,16 @@ passed to it."
ORIG is `org-insert-link', ARGS are the arguments passed to it."
(advice-add 'read-string :around #'org-real--read-string-advice)
(unwind-protect
- (if (called-interactively-p)
+ (if (called-interactively-p 'any)
(call-interactively orig)
(apply orig args))
(advice-remove 'read-string #'org-real--read-string-advice)))
(advice-add 'org-insert-link :around #'org-real--maybe-edit-link)
-(defun org-real--apply (&rest args)
- "Apply any changes to the current buffer from the last inserted real link."
- (let (new-link new-desc replace-all)
+(defun org-real--apply (&rest _)
+ "Apply any changes to the current buffer if last inserted link is real."
+ (let (new-link replace-all)
(cond
((org-in-regexp org-link-bracket-re 1)
(setq new-link (match-string-no-properties 1)))
