[elpa] externals/org-real 5ae3174c55 001/188: initial commit

[ELPA Syncer]

branch: externals/org-real
commit 5ae3174c553e22703faff4ea6e96e26a308cd581
Author: Amy Grinn <grinn.amy@gmail.com>
Commit: Amy Grinn <grinn.amy@gmail.com>

    initial commit
---
 README.org  |   4 +
 examples    |  68 ++++++++++++++
 org-real.el | 295 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 tests.org   |   7 ++
 4 files changed, 374 insertions(+)

diff --git a/README.org b/README.org
new file mode 100644
index 0000000000..c8fe557715
--- /dev/null
+++ b/README.org
@@ -0,0 +1,4 @@
+#+TITLE: Org Real
+
+* Org Real
+  Keep track of real things as org links.
diff --git a/examples b/examples
new file mode 100644
index 0000000000..a6efbf464b
--- /dev/null
+++ b/examples
@@ -0,0 +1,68 @@
+
+  The toothbrush is in the bathroom cabinet on the third shelf
+  to the left of the razors.
+
+  ┌────────────────────────────────────────┐  
+  │                                        
+  │  bathroom cabinet                      │
+  │                                        │
+  │  ┌──────────────────────────────────┐  │
+  │  │                                  │  │
+  │  │  third shelf                     │  │
+  │  │                                  │  │
+  │  │  ┌──────────────┐  ┌──────────┐  │  │
+  │  │  │              │  │          │  │  │
+  │  │  │  toothbrush  │  │  razors  │  │  │
+  │  │  │              │  │          │  │  │
+  │  │  └──────────────┘  └──────────┘  │  │
+  │  │                                  │  │
+  │  └──────────────────────────────────┘  │
+  │                                        │
+  └────────────────────────────────────────┘
+
+  The bike is behind the shed.
+
+  ┌──────────────┐
+  │              │
+  │  shed        │
+  │              │
+  │  ┌╌╌╌╌╌╌╌╌┐  │
+  │  ╎        ╎  │
+  │  ╎  bike  ╎  │
+  │  ╎        ╎  │
+  │  └╌╌╌╌╌╌╌╌┘  │
+  │              │
+  └──────────────┘
+
+  The mosquito spray is in front of the sunscreen in the closet
+
+  ┌──────────────────────────────┐
+  │                              │
+  │  closet                      │
+  │                              │
+  │  ┌────────────────────────┐  │
+  │  │                        │  │
+  │  │  sunscreen             │  │
+  │  │                        │  │
+  │  │  ┌──────────────────┐  │  │
+  │  │  │                  │  │  │
+  │  │  │  mosquito spray  │  │  │
+  │  │  │                  │  │  │
+  │  └──┴──────────────────┴──┘  │
+  │                              │
+  └──────────────────────────────┘
+
+The spare key is above the door frame
+
+  ┌─────────────┐
+  │             │
+  │  spare key  │
+  │             │
+  └─────────────┘
+  ┌──────────────┐  
+  │              │  
+  │  door frame  │  
+  │              │  
+  └──────────────┘  
+
+    
diff --git a/org-real.el b/org-real.el
new file mode 100644
index 0000000000..0939dccb17
--- /dev/null
+++ b/org-real.el
@@ -0,0 +1,295 @@
+(require 'eieio)
+(require 'org)
+(require 'cl)
+
+(defclass org-real--box ()
+  ((name :initarg :name
+         :type string)
+   (style :initarg :style
+          :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)))
+
+(defvar org-real-prepositions
+  '("in" "behind" "in front of" "above" "below" "to the left of" "to the right 
of"))
+
+(defun org-real--create-box (containers &optional parent prev)
+  (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 ((string= rel "in")
+               (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 (oref prev :y-order))
+               (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 (- 1 (oref prev :y-order)))
+               (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 (- 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)))
+              ((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" "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 :parent parent)
+        (object-add-to-list parent :children box)
+        (if containers
+            (org-real--create-box containers parent box))))))
+    
+(defun org-real--parse-url (str)
+  "Parse URL into an org real object"
+  (let* ((url (url-generic-parse-url str))
+         (host (url-host url))
+         (path-and-query (url-path-and-query url))
+         (tokens (cdr
+                     (split-string (concat (car path-and-query) "?"
+                                           (cdr path-and-query))
+                                   "/")))
+         (containers (mapcar
+                      (lambda (token)
+                        (let* ((location (split-string token "?"))
+                               (container (list :name (car location)))
+                               (rel (and (string-match "&?rel=\\([^&]*\\)" 
(cadr location))
+                                         (match-string 1 (cadr location)))))
+                          (if rel
+                              (plist-put container :rel rel)
+                            container)))
+                      tokens)))
+    (add-to-list 'containers (list :name host))))
+
+(org-link-set-parameters "real"
+                         :follow #'org-real-follow)
+
+(defun org-real-follow (url &rest args)
+  (let* ((containers (org-real--parse-url url))
+         (box (org-real--create-box (copy-tree containers))))
+    (org-real--pp box (copy-tree containers))))
+
+(defvar org-real--level)
+
+(defvar org-real--padding '(2 . 1))
+(defvar org-real--margin '(2 . 1))
+
+(defun org-real--pp (box containers)
+  (let ((width (org-real--get-width box))
+        (height (org-real--get-height box)))
+    (with-current-buffer-window "Org Real" nil nil
+      (org-real--pp-text containers)
+      (let ((offset (line-number-at-pos)))
+        (dotimes (_ (+ 10 height)) (insert (concat (make-string width ?\s) 
"\n")))
+        (org-real--draw box offset)
+        (special-mode)))))
+
+(defun org-real--pp-text (containers)
+  (let* ((reversed (reverse containers))
+         (container (pop reversed)))
+    (dotimes (_ (cdr org-real--padding)) (insert "\n"))
+    (insert (make-string (car org-real--padding) ?\s))
+    (insert "The ")
+    (insert (plist-get container :name))
+    (if reversed (insert " is"))
+    (while reversed
+      (insert " ")
+      (insert (plist-get container :rel))
+      (setq container (pop reversed))
+      (insert " the ")
+      (insert (plist-get container :name)))
+    (insert ".")
+    (fill-paragraph)))
+
+(defun org-real--draw (box offset)
+  (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))
+               (children (oref box :children))
+               (dashed (oref box :behind))
+               (align-bottom (oref box :in-front)))
+          (cl-flet ((draw (coords str)
+                       (goto-line (car coords))
+                       (move-to-column (cdr coords) t)
+                       (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)
+            (let ((r (+ top 1))
+                  (c1 left)
+                  (c2 (+ left width -1)))
+              (dotimes (_var (- 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)
+  (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 ((rows '()))
+        (mapc
+         (lambda (child)
+           (add-to-list 'rows (oref child :y-order)))
+         children)
+        (let ((child-widths (mapcar 
+                             (lambda (row)
+                               (+ base-width
+                                  (seq-reduce
+                                   (lambda (sum child) (+ sum
+                                                          (car 
org-real--padding)
+                                                          (org-real--get-width 
child)))
+                                   (seq-filter
+                                    (lambda (child) (= row (oref child 
:y-order)))
+                                    children)
+                                   (* -1 (car org-real--padding)))))
+                             rows)))
+          (apply 'max width child-widths))))))
+
+(defun org-real--get-height (box)
+  (let ((height (+ (if (oref box :in-front)
+                       (* -1 (cdr org-real--margin))
+                     0)
+                   2 ; box walls
+                   (* 2 (cdr org-real--padding))
+                   (cdr org-real--margin)))
+        (children (oref box :children))
+        (in-front (oref box :in-front)))
+    (if (not children)
+        height
+      (let ((columns '()))
+        (mapc
+         (lambda (child) (add-to-list 'columns (oref child :x-order)))
+         children)
+        (let ((child-heights (mapcar
+                              (lambda (col)
+                                (+ height
+                                   (seq-reduce
+                                    (lambda (sum child) (+ sum 
(org-real--get-height child)))
+                                    (seq-filter
+                                     (lambda (child) (= col (oref child 
:x-order)))
+                                     children)
+                                    0)))
+                              columns)))
+          (apply 'max height child-heights))))))
+                     
+(defun org-real--get-top (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))
+                                           (< y-order (oref child :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)))))
+        (if directly-above
+            (+ (cdr org-real--margin) offset (org-real--get-top 
directly-above))
+          top)))))
+
+(defun org-real--get-left (box)
+  (if (not (slot-boundp box :parent))
+      0
+    (let* ((offset (+ 2 (* 2 (car org-real--padding)) (car org-real--margin)))
+           (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 box :x-order) (oref 
child :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)
+             (if (slot-boundp directly-left :name)
+                 (length (oref directly-left :name))
+               0)
+             offset)
+        left))))
+                             
diff --git a/tests.org b/tests.org
new file mode 100644
index 0000000000..23fbdc5c9b
--- /dev/null
+++ b/tests.org
@@ -0,0 +1,7 @@
+
+* TODO Replace [[real://bathroom cabinet/third 
shelf?rel=in/razors?rel=above/toothbrush?rel=to the left of][toothbrush]]
+* SOMEDAY Get new tires for the [[real://shed/bike?rel=behind][bike]]
+* Items to bring to the park
+  - [[real://closet/sunscreen?rel=in/mosquito spray?rel=in front of][mosquito 
spray]]
+* Personal things
+  - [[real://door frame/spare key?rel=above][spare key]]