emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/org-real 463da8b 029/160: Refactoring


From: ELPA Syncer
Subject: [elpa] externals/org-real 463da8b 029/160: Refactoring
Date: Wed, 6 Oct 2021 16:58:08 -0400 (EDT)

branch: externals/org-real
commit 463da8b854d30387326e99038a6a10dae73e3b09
Author: Tyler Grinn <tylergrinn@gmail.com>
Commit: Tyler Grinn <tylergrinn@gmail.com>

    Refactoring
---
 org-real--box.el | 448 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 org-real.el      | 419 +--------------------------------------------------
 2 files changed, 452 insertions(+), 415 deletions(-)

diff --git a/org-real--box.el b/org-real--box.el
new file mode 100644
index 0000000..eba0c0d
--- /dev/null
+++ b/org-real--box.el
@@ -0,0 +1,448 @@
+;;; org-real.el --- Create org-mode links to real things -*- lexical-binding: 
t -*-
+
+;;; Commentary:
+
+;; Box class definition and related methods
+
+;;;; Patch! 0.0.1 -> 0.1.0
+
+(and (fboundp 'org-real--map-immediate) (fmakunbound 'org-real--map-immediate))
+(and (fboundp 'org-real--next) (fmakunbound 'org-real--next))
+(and (fboundp 'org-real--merge-into) (fmakunbound 'org-real--merge-into))
+(and (fboundp 'org-real--add-matching) (fmakunbound 'org-real--add-matching))
+(and (fboundp 'org-real--flex-add) (fmakunbound 'org-real--flex-add))
+(and (fboundp 'org-real--expand) (fmakunbound 'org-real--expand))
+(and (fboundp 'org-real--draw) (fmakunbound 'org-real--draw))
+(and (fboundp 'org-real--get-width) (fmakunbound 'org-real--get-width))
+(and (fboundp 'org-real--get-height) (fmakunbound 'org-real--get-height))
+(and (fboundp 'org-real--get-top) (fmakunbound 'org-real--get-top))
+(and (fboundp 'org-real--get-left) (fmakunbound 'org-real--get-left))
+
+;;;; Requirements:
+
+(require 'eieio)
+(require 'cl-lib)
+
+;;;; Class definition
+
+(defclass org-real--box ()
+  ((name :initarg :name
+         :type string)
+   (rel :initarg :rel
+        :type string)
+   (rel-box :initarg :rel-box
+            :type org-real--box)
+   (x-order :initarg :x-order
+            :initform 0
+            :type number)
+   (y-order :initarg :y-order
+            :initform 0
+            :type number)
+   (in-front :initarg :in-front
+             :initform nil
+             :type boolean)
+   (behind :initarg :behind
+           :initform nil
+           :type boolean)
+   (parent :initarg :parent
+           :type org-real--box)
+   (children :initarg :children
+             :initform '()
+             :type list)
+   (primary :initarg :primary
+            :initform nil
+            :type boolean)))
+
+;;;; Exports
+
+(defun org-real--create-box (containers)
+  "Create an `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)
+    world))
+
+(defun org-real--merge (boxes)
+  "Merge BOXES into a single box."
+  (if (< (length boxes) 2)
+      (if (= 0 (length boxes))
+          (org-real--box)
+        (car boxes))
+    (let ((world (org-real--box)))
+      (while boxes
+        (org-real--merge-into (pop boxes) world))
+      world)))
+
+;;;; Drawing
+
+(cl-defmethod org-real--draw ((box org-real--box) offset)
+  "Insert an ascii drawing of BOX into the current buffer.
+
+OFFSET is the starting line to start insertion."
+  (let ((children (oref box :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)))))))
+    (mapc
+     (lambda (child) (org-real--draw child offset))
+     children)))
+
+(cl-defmethod org-real--get-width ((box org-real--box))
+  "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)))
+    (if (not children)
+        width
+      (let* ((column-indices (delete-duplicates
+                              (mapcar (lambda (child) (oref child :x-order)) 
children)))
+             (columns (mapcar
+                       (lambda (c)
+                         (seq-filter
+                          (lambda (child)
+                            (= c (oref child :x-order)))
+                          children))
+                       column-indices))
+             (column-widths (mapcar
+                             (lambda (column)
+                               (apply 'max (mapcar 'org-real--get-width 
column)))
+                             columns))
+             (children-width (seq-reduce
+                              (lambda (total width)
+                                (+ total (car org-real--margin) width))
+                              column-widths
+                              (* -1 (car org-real--margin)))))
+        (if (> width (+ (* 2 (car org-real--margin)) children-width))
+            width
+          (+ base-width children-width))))))
+
+(cl-defmethod org-real--get-height ((box org-real--box))
+  "Get the height of BOX."
+  (let* ((in-front (oref 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)))
+    (if (not children)
+        height
+      (let* ((row-indices (delete-duplicates
+                           (mapcar (lambda (child) (oref child :y-order)) 
children)))
+             (rows (mapcar
+                    (lambda (r)
+                      (seq-filter
+                       (lambda (child)
+                         (= r (oref child :y-order)))
+                       children))
+                    row-indices))
+             (row-heights (mapcar
+                           (lambda (row)
+                             (apply 'max (mapcar 'org-real--get-height row)))
+                           rows)))
+        (+ height (seq-reduce '+ row-heights 0))))))
+
+(cl-defmethod org-real--get-top ((box org-real--box))
+  "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))
+             (above (seq-filter
+                     (lambda (child) (and (= x-order (oref child :x-order))
+                                          (< (oref child :y-order) y-order)))
+                     (oref parent :children)))
+             (directly-above (and above (seq-reduce
+                                         (lambda (max child)
+                                           (if (> (oref child :y-order) (oref 
max :y-order))
+                                               child
+                                             max))
+                                         above
+                                         (org-real--box :y-order -9999))))
+             (above-height (and directly-above (apply 'max
+                                                      (mapcar
+                                                       'org-real--get-height
+                                                       (seq-filter
+                                                        (lambda (child)
+                                                          (= (oref 
directly-above :y-order)
+                                                             (oref child 
:y-order)))
+                                                        (oref 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))))))
+
+(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)))))
+
+;;;; Utility expressions
+  
+(defun org-real--create-box-helper (containers parent &optional prev)
+  (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)))))
+    
+    (if (and prev (member (oref box :rel)
+                          '("in" "on" "behind" "in front of")))
+        (progn
+          (oset box :parent prev)
+          (object-add-to-list prev :children box)
+          (if containers
+              (org-real--create-box-helper containers prev box)
+            (oset box :primary t)))
+      (oset box :parent parent)
+      (object-add-to-list parent :children box)
+      (if containers
+          (org-real--create-box-helper containers parent box)
+        (oset box :primary t)))))
+
+(cl-defmethod org-real--map-immediate (fn (box org-real--box))
+  "Map a function FN across all immediate relatives of BOX, including BOX.
+
+Any box with a :rel-box slot equivalent to BOX will be passed to
+FN."
+  (progn
+    (funcall fn box)
+    (mapc
+     (lambda (box) (org-real--map-immediate fn box))
+     (org-real--next box t))))
+
+(cl-defmethod org-real--next ((box org-real--box) &optional exclude-children)
+  "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) '()))))
+    (seq-filter
+     (lambda (relative)
+       (and (slot-boundp relative :rel-box)
+            (string= (oref (oref relative :rel-box) :name)
+                     (oref 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))))
+
+(cl-defmethod org-real--merge-into ((from org-real--box) (to org-real--box))
+  "Merge FROM box into TO box."
+  (let ((from-boxes (reverse (org-real--expand from)))
+        (to-boxes (reverse (org-real--expand to))))
+    (unless (seq-some
+             (lambda (from-box)
+               (seq-some
+                (lambda (to-box)
+                  (when (and (slot-boundp from-box :name)
+                             (slot-boundp to-box :name)
+                             (string= (oref from-box :name) (oref to-box 
:name)))
+                    (org-real--add-matching from-box to-box to)
+                    t))
+                to-boxes))
+             from-boxes)
+      (org-real--flex-add from to to))))
+
+(cl-defmethod org-real--add-matching ((box org-real--box)
+                                      (match org-real--box)
+                                      (world org-real--box))
+  "Add BOX to WORLD after finding a matching box MATCH already in WORLD.
+
+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)
+             (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))
+             (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))
+             (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)
+             (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)))
+
+(cl-defmethod org-real--flex-add ((box org-real--box)
+                                  (parent org-real--box)
+                                  (world org-real--box))
+  "Add BOX to a PARENT box already existing in WORLD.
+
+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))))))
+
+
+
+(provide 'org-real--box)
diff --git a/org-real.el b/org-real.el
index f56c022..5596c99 100644
--- a/org-real.el
+++ b/org-real.el
@@ -23,98 +23,7 @@
 (require 'org)
 (require 'cl-lib)
 
-;;;; Classes
-
-(defclass org-real--box ()
-  ((name :initarg :name
-         :type string)
-   (rel :initarg :rel
-        :type string)
-   (rel-box :initarg :rel-box
-            :type org-real--box)
-   (x-order :initarg :x-order
-            :initform 0
-            :type number)
-   (y-order :initarg :y-order
-            :initform 0
-            :type number)
-   (in-front :initarg :in-front
-             :initform nil
-             :type boolean)
-   (behind :initarg :behind
-           :initform nil
-           :type boolean)
-   (parent :initarg :parent
-           :type org-real--box)
-   (children :initarg :children
-             :initform '()
-             :type list)
-   (primary :initarg :primary
-            :initform nil
-            :type boolean)))
-
-(defun org-real--create-box (containers &optional parent prev)
-  "Create an `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."
-  (if (not parent)
-      (let ((world (org-real--box)))
-        (org-real--create-box containers world)
-        world)
-    (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)))))
-
-      (if (and prev (member (oref box :rel)
-                            '("in" "on" "behind" "in front of")))
-          (progn
-            (oset box :parent prev)
-            (object-add-to-list prev :children box)
-            (if containers
-                (org-real--create-box containers prev box)
-              (oset box :primary t)))
-        (oset box :parent parent)
-        (object-add-to-list parent :children box)
-        (if containers
-            (org-real--create-box containers parent box)
-          (oset box :primary t))))))
+(require 'org-real--box)
 
 ;;;; Faces
 
@@ -129,8 +38,10 @@ parameters are used internally and should not be supplied."
 (defconst org-real-prepositions
   '("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.")
 
@@ -194,154 +105,6 @@ Returns a list of plists with a :name property and 
optionally a
            containers
            "/")))
 
-(defun org-real--map-immediate (fn box)
-  "Map a function across all immediate relatives of a box.
-
-Any box with a :rel-box slot equivalent to BOX will be passed to
-FN."
-  (progn
-    (funcall fn box)
-    (mapc
-     (lambda (box) (org-real--map-immediate fn box))
-     (org-real--next box t))))
-
-(defun org-real--next (box &optional exclude-children)
-  "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) '()))))
-    (seq-filter
-     (lambda (relative)
-       (and (slot-boundp relative :rel-box)
-            (string= (oref (oref relative :rel-box) :name)
-                     (oref box :name))))
-     relatives)))
-
-(defun org-real--merge (boxes)
-  "Merge BOXES into a single box."
-  (if (< (length boxes) 2)
-      (if (= 0 (length boxes))
-          (org-real--box)
-        (car boxes))
-    (let ((world (org-real--box)))
-      (while boxes
-        (org-real--merge-into (pop boxes) world))
-      world)))
-
-(defun org-real--expand (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))))
-
-(defun org-real--merge-into (from to)
-  "Merge FROM box into TO box."
-  (let ((from-boxes (reverse (org-real--expand from)))
-        (to-boxes (reverse (org-real--expand to))))
-    (unless (seq-some
-             (lambda (from-box)
-               (seq-some
-                (lambda (to-box)
-                  (when (and (slot-boundp from-box :name)
-                             (slot-boundp to-box :name)
-                             (string= (oref from-box :name) (oref to-box 
:name)))
-                    (org-real--add-matching from-box to-box to)
-                    t))
-                to-boxes))
-             from-boxes)
-      (org-real--flex-add from to to))))
-
-
-(defun org-real--add-matching (box match world)
-  "Add BOX to WORLD after finding a matching box MATCH already in WORLD.
-
-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)
-             (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))
-             (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))
-             (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)
-             (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)))
-
-(defun org-real--flex-add (box parent world)
-  "Add BOX to a PARENT box already existing in WORLD.
-
-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))))))
-
-
 ;;;; Interactive functions
 
 (defun org-real-world ()
@@ -366,7 +129,6 @@ ARGS are ignored."
          (box (org-real--create-box (copy-tree containers))))
     (org-real--pp box (copy-tree containers))))
 
-
 (defun org-real-complete (&optional existing)
   "Complete a real link or edit EXISTING link."
   (let* ((container-matrix (org-real--parse-buffer))
@@ -439,7 +201,7 @@ passed to it."
 (defun org-real--maybe-edit-link (orig &rest args)
   "Advise `org-insert-link' to advise `read-string' during editing of a link.
 
-ARGS are the arguments passed to `org-insert-link'."
+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)
@@ -548,8 +310,6 @@ describing where BOX is."
     (display-buffer buffer `(display-buffer-pop-up-window
                              (window-width . 80)
                              (window-height . ,height)))))
-
-
 (defun org-real--pp-text (containers)
   "Insert a textual representation of CONTAINERS into the current buffer."
   (let* ((reversed (reverse containers))
@@ -572,177 +332,6 @@ describing where BOX is."
     (fill-paragraph)
     (insert "\n")))
 
-(defun org-real--draw (box offset)
-  "Insert an ascii drawing of BOX into the current buffer.
-
-OFFSET is the starting line to start insertion."
-  (let ((children (oref box :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)))))))
-    (mapc
-     (lambda (child) (org-real--draw child offset))
-     children)))
-
-
-(defun org-real--get-width (box)
-  "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)))
-    (if (not children)
-        width
-      (let* ((column-indices (delete-duplicates
-                              (mapcar (lambda (child) (oref child :x-order)) 
children)))
-             (columns (mapcar
-                       (lambda (c)
-                         (seq-filter
-                          (lambda (child)
-                            (= c (oref child :x-order)))
-                          children))
-                       column-indices))
-             (column-widths (mapcar
-                             (lambda (column)
-                               (apply 'max (mapcar 'org-real--get-width 
column)))
-                             columns))
-             (children-width (seq-reduce
-                              (lambda (total width)
-                                (+ total (car org-real--margin) width))
-                              column-widths
-                              (* -1 (car org-real--margin)))))
-        (if (> width (+ (* 2 (car org-real--margin)) children-width))
-            width
-          (+ base-width children-width))))))
-
-(defun org-real--get-height (box)
-  "Get the height of BOX."
-  (let* ((in-front (oref 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)))
-    (if (not children)
-        height
-      (let* ((row-indices (delete-duplicates
-                           (mapcar (lambda (child) (oref child :y-order)) 
children)))
-             (rows (mapcar
-                    (lambda (r)
-                      (seq-filter
-                       (lambda (child)
-                         (= r (oref child :y-order)))
-                       children))
-                    row-indices))
-             (row-heights (mapcar
-                           (lambda (row)
-                             (apply 'max (mapcar 'org-real--get-height row)))
-                           rows)))
-        (+ height (seq-reduce '+ row-heights 0))))))
-
-(defun org-real--get-top (box)
-  "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))
-             (above (seq-filter
-                     (lambda (child) (and (= x-order (oref child :x-order))
-                                          (< (oref child :y-order) y-order)))
-                     (oref parent :children)))
-             (directly-above (and above (seq-reduce
-                                         (lambda (max child)
-                                           (if (> (oref child :y-order) (oref 
max :y-order))
-                                               child
-                                             max))
-                                         above
-                                         (org-real--box :y-order -9999))))
-             (above-height (and directly-above (apply 'max
-                                                      (mapcar
-                                                       'org-real--get-height
-                                                       (seq-filter
-                                                        (lambda (child)
-                                                          (= (oref 
directly-above :y-order)
-                                                             (oref child 
:y-order)))
-                                                        (oref 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))))))
-
-(defun org-real--get-left (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)))))
-
 (provide 'org-real)
 
 ;;; org-real.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]