[elpa] externals/org-real 7d9d67d 044/160: Rearranging

[ELPA Syncer]

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

    Rearranging
---
 org-real.el | 501 ++++++++++++++++++++++++++++++------------------------------
 1 file changed, 250 insertions(+), 251 deletions(-)

diff --git a/org-real.el b/org-real.el
index e1a7a2f..28df092 100644
--- a/org-real.el
+++ b/org-real.el
@@ -71,7 +71,236 @@ vertical padding"
   '("in" "on" "behind" "in front of" "above" "below" "to the left of" "to the 
right of")
   "List of available prepositions for things.")
 
-;;;; Class definitions
+;;;; Interactive functions
+
+(defun org-real-world ()
+  "View all real links in the current buffer."
+  (interactive)
+  (org-real--pp
+   (org-real--merge
+    (mapcar
+     (lambda (containers)
+       (org-real--make-instance 'org-real-box containers))
+     (org-real--parse-buffer)))))
+
+
+;;;; Pretty printing
+
+(defun org-real--pp (box &optional containers)
+  "Pretty print BOX in a popup buffer.
+
+If CONTAINERS is passed in, also pretty print a sentence
+describing where BOX is."
+  (let ((top (org-real--get-top box))
+        (width (org-real--get-width box))
+        (height (org-real--get-height box))
+        (inhibit-read-only t)
+        (buffer (get-buffer-create "Org Real")))
+    (with-current-buffer buffer
+      (erase-buffer)
+      (toggle-truncate-lines t)
+      (if containers (org-real--pp-text containers))
+      (let ((offset (- (line-number-at-pos)
+                       (cdr org-real-margin)
+                       (* 2 (cdr org-real-padding)))))
+        (dotimes (_ (+ top height)) (insert (concat (make-string width ?\s) 
"\n")))
+        (org-real--draw box offset)
+        (special-mode)))
+    (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))
+         (container (pop reversed))
+         (primary-name (plist-get container :name)))
+    (dotimes (_ (cdr org-real-padding)) (insert "\n"))
+    (insert (make-string (car org-real-padding) ?\s))
+    (insert "The ")
+    (put-text-property 0 (length primary-name) 'face 'org-real-primary
+                       primary-name)
+    (insert primary-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)
+    (insert "\n")))
+
+;;;; `org-insert-link' configuration
+
+(org-link-set-parameters "real"
+                         :follow #'org-real-follow
+                         :complete #'org-real-complete)
+
+(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--make-instance 'org-real-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))
+         (containers (if existing
+                         (org-real--parse-url existing)
+                       (org-real--complete-thing "Thing: " container-matrix))))
+    (catch 'confirm
+      (while t
+        (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)
+            (throw 'confirm containers))
+           ((eq response 'backspace)
+            (pop containers)
+            (if (= 0 (length containers))
+                (setq containers (org-real--complete-thing "Thing: " 
container-matrix))))
+           ((eq response ?+)
+            (let* ((top (plist-get (car containers) :name))
+                   (preposition
+                    (completing-read (concat "The " top " is: ") 
org-real-prepositions nil t))
+                   (additional-containers
+                    (org-real--complete-thing (concat "The " top " is " 
preposition " the: ") container-matrix)))
+              (setcar containers (plist-put (car containers) :rel preposition))
+              (setq containers (append additional-containers containers))))))))
+    (org-real--to-link containers)))
+
+(defun org-real--complete-thing (prompt container-matrix)
+  "Use `completing-read' with PROMPT to get a list of containers.
+
+CONTAINER-MATRIX is used to generate possible completions.  The
+return value is the longest list of containers from the matrix
+that contains, as the last element, a container with a name
+matching the one returned from `completing-read'."
+  (let* ((completions (mapcar
+                       (lambda (container) (plist-get container :name))
+                       (apply 'append container-matrix)))
+         (result (completing-read prompt completions nil 'confirm))
+         (existing-containers (car (seq-sort
+                                    (lambda (a b) (> (length a) (length b)))
+                                    (mapcar
+                                     (lambda (containers)
+                                       (cl-subseq containers 0
+                                                  (+ 1 
(org-real--find-last-index
+                                                        (lambda (container)
+                                                          (string= (plist-get 
container :name) result))
+                                                        containers))))
+                                     (seq-filter
+                                      (lambda (containers)
+                                        (seq-some
+                                         (lambda (container)
+                                           (string= (plist-get container 
:name) result))
+                                         containers))
+                                      container-matrix))))))
+    (if existing-containers
+        existing-containers
+      `((:name ,result)))))
+
+;;; Hooks
+
+(defun org-real--read-string-advice (orig prompt link &rest args)
+  "Advise `read-string' during `org-insert-link' to use custom completion.
+
+ORIG is `read-string', PROMPT and LINK and ARGS are the arguments
+passed to it."
+  (if (string= "real" (ignore-errors (url-type (url-generic-parse-url link))))
+      (org-real-complete link)
+    (apply orig prompt link args)))
+
+(defun org-real--maybe-edit-link (orig &rest args)
+  "Advise `org-insert-link' to advise `read-string' during editing of a 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 '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 _)
+  "Apply any change 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)))
+     ((org-in-regexp org-link-plain-re)
+      (setq new-link (org-unbracket-string "<" ">" (match-string 0)))))
+    (when (and new-link
+               (string= "real" (ignore-errors (url-type (url-generic-parse-url 
new-link)))))
+      (let ((new-containers (reverse (org-real--parse-url new-link))))
+        (while new-containers
+          (let ((primary (plist-get (car new-containers) :name))
+                (changes '())
+                old-containers)
+            (org-element-map (org-element-parse-buffer) 'link
+              (lambda (old-link)
+                (when (string= (org-element-property :type old-link) "real")
+                  (setq old-containers (reverse (org-real--parse-url
+                                                 (org-element-property 
:raw-link old-link))))
+                  
+                  (when-let* ((new-index 0)
+                              (old-index (seq-position
+                                          old-containers
+                                          primary
+                                          (lambda (a b) (string= (plist-get a 
:name) b))))
+                              (begin (org-element-property :begin old-link))
+                              (end (org-element-property :end old-link))
+                              (replace-link (org-real--to-link
+                                             (reverse
+                                              (append (cl-subseq 
old-containers 0 old-index)
+                                                      new-containers))))
+                              (old-desc ""))
+                    (when (catch 'conflict
+                            (if (not (= (length new-containers) (- (length 
old-containers) old-index)))
+                                (throw 'conflict t))
+                            (while (< new-index (length new-containers))
+                              (if (or (not (string= (plist-get (nth new-index 
new-containers) :name)
+                                                    (plist-get (nth old-index 
old-containers) :name)))
+                                      (not (string= (plist-get (nth new-index 
new-containers) :rel)
+                                                    (plist-get (nth old-index 
old-containers) :rel))))
+                                  (throw 'conflict t))
+                              (setq new-index (+ 1 new-index))
+                              (setq old-index (+ 1 old-index)))
+                            nil)
+                      (goto-char begin)
+                      (if (org-in-regexp org-link-bracket-re 1)
+                          (setq old-desc (when (match-end 2) 
(match-string-no-properties 2))))
+                      (push
+                       `(lambda ()
+                          (delete-region ,begin ,end)
+                          (goto-char ,begin)
+                          (insert (org-real--link-make-string ,replace-link 
,old-desc)))
+                       changes))))))
+            (when (and changes
+                       (or replace-all (let ((response
+                                              (read-char-choice
+                                               (concat
+                                                "Replace all occurrences of "
+                                                primary
+                                                " in current buffer? y/n/a ")
+                                               '(?y ?Y ?n ?N ?a ?A)
+                                               t)))
+                                         (cond
+                                          ((or (= response ?y) (= response 
?Y)) t)
+                                          ((or (= response ?n) (= response 
?N)) nil)
+                                          ((or (= response ?a) (= response ?A))
+                                           (setq replace-all t))))))
+              (mapc 'funcall changes)))
+          (pop new-containers)))))
+  (message nil))
+
+(advice-add 'org-insert-link :after #'org-real--apply)
+
+;;;; Class definitions and public methods
 
 (defclass org-real-box-collection ()
   ((box :initarg :box
@@ -110,6 +339,22 @@ vertical padding"
   "A representation of a box in 3D space.")
 
 
+(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 ((_ (subclass org-real-box)) containers)
   "Create an instance of `org-real-box' from CONTAINERS.
 
@@ -216,12 +461,9 @@ 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 (with-slots (in-front) box in-front))
-         (height (+ (if in-front
-                        (* -1 (cdr org-real-margin))
-                      0)
+         (height (+ (if in-front -1 0)
                     3 ; box walls + text
-                    (cdr org-real-padding)
-                    (cdr org-real-margin)))
+                    (* 2 (cdr org-real-padding))))
          (children (with-slots (children) box (org-real--get-all children))))
     (if (not children)
         height
@@ -317,23 +559,7 @@ OFFSET is the starting line to start insertion."
                 (org-real--get-left rel-box)
               left)))))))
 
-;;;; `org-real-box' utility expressions
-
-(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))
+;;;; Private class methods
 
 (cl-defmethod org-real--make-instance-helper (containers parent (prev 
org-real-box))
   "Help create a 3D representation of CONTAINERS.
@@ -582,8 +808,7 @@ that the width of WORLD is kept below 80 characters if 
possible."
               (oset box :y-order (+ 1 last-sibling-y))
               (oset box :x-order 0))))))))
 
-
-;;;; General utility expressions
+;;;; Utility expressions
 
 (defun org-real--find-last-index (pred sequence)
   "Return the index of the last element for which (PRED element) is non-nil in 
SEQUENCE."
@@ -665,232 +890,6 @@ Returns a list of plists with a :name property and 
optionally a
            containers
            "/")))
 
-;;;; Interactive functions
-
-(defun org-real-world ()
-  "View all real links in the current buffer."
-  (interactive)
-  (org-real--pp
-   (org-real--merge
-    (mapcar
-     (lambda (containers)
-       (org-real--make-instance 'org-real-box containers))
-     (org-real--parse-buffer)))))
-
-;;;; `org-insert-link' configuration
-
-(org-link-set-parameters "real"
-                         :follow #'org-real-follow
-                         :complete #'org-real-complete)
-
-(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--make-instance 'org-real-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))
-         (containers (if existing
-                         (org-real--parse-url existing)
-                       (org-real--complete-thing "Thing: " container-matrix))))
-    (catch 'confirm
-      (while t
-        (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)
-            (throw 'confirm containers))
-           ((eq response 'backspace)
-            (pop containers)
-            (if (= 0 (length containers))
-                (setq containers (org-real--complete-thing "Thing: " 
container-matrix))))
-           ((eq response ?+)
-            (let* ((top (plist-get (car containers) :name))
-                   (preposition
-                    (completing-read (concat "The " top " is: ") 
org-real-prepositions nil t))
-                   (additional-containers
-                    (org-real--complete-thing (concat "The " top " is " 
preposition " the: ") container-matrix)))
-              (setcar containers (plist-put (car containers) :rel preposition))
-              (setq containers (append additional-containers containers))))))))
-    (org-real--to-link containers)))
-
-(defun org-real--complete-thing (prompt container-matrix)
-  "Use `completing-read' with PROMPT to get a list of containers.
-
-CONTAINER-MATRIX is used to generate possible completions.  The
-return value is the longest list of containers from the matrix
-that contains, as the last element, a container with a name
-matching the one returned from `completing-read'."
-  (let* ((completions (mapcar
-                       (lambda (container) (plist-get container :name))
-                       (apply 'append container-matrix)))
-         (result (completing-read prompt completions nil 'confirm))
-         (existing-containers (car (seq-sort
-                                    (lambda (a b) (> (length a) (length b)))
-                                    (mapcar
-                                     (lambda (containers)
-                                       (cl-subseq containers 0
-                                                  (+ 1 
(org-real--find-last-index
-                                                        (lambda (container)
-                                                          (string= (plist-get 
container :name) result))
-                                                        containers))))
-                                     (seq-filter
-                                      (lambda (containers)
-                                        (seq-some
-                                         (lambda (container)
-                                           (string= (plist-get container 
:name) result))
-                                         containers))
-                                      container-matrix))))))
-    (if existing-containers
-        existing-containers
-      `((:name ,result)))))
-
-;;; Hooks
-
-(defun org-real--read-string-advice (orig prompt link &rest args)
-  "Advise `read-string' during `org-insert-link' to use custom completion.
-
-ORIG is `read-string', PROMPT and LINK and ARGS are the arguments
-passed to it."
-  (if (string= "real" (ignore-errors (url-type (url-generic-parse-url link))))
-      (org-real-complete link)
-    (apply orig prompt link args)))
-
-(defun org-real--maybe-edit-link (orig &rest args)
-  "Advise `org-insert-link' to advise `read-string' during editing of a 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 '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 _)
-  "Apply any change 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)))
-     ((org-in-regexp org-link-plain-re)
-      (setq new-link (org-unbracket-string "<" ">" (match-string 0)))))
-    (when (and new-link
-               (string= "real" (ignore-errors (url-type (url-generic-parse-url 
new-link)))))
-      (let ((new-containers (reverse (org-real--parse-url new-link))))
-        (while new-containers
-          (let ((primary (plist-get (car new-containers) :name))
-                (changes '())
-                old-containers)
-            (org-element-map (org-element-parse-buffer) 'link
-              (lambda (old-link)
-                (when (string= (org-element-property :type old-link) "real")
-                  (setq old-containers (reverse (org-real--parse-url
-                                                 (org-element-property 
:raw-link old-link))))
-                  
-                  (when-let* ((new-index 0)
-                              (old-index (seq-position
-                                          old-containers
-                                          primary
-                                          (lambda (a b) (string= (plist-get a 
:name) b))))
-                              (begin (org-element-property :begin old-link))
-                              (end (org-element-property :end old-link))
-                              (replace-link (org-real--to-link
-                                             (reverse
-                                              (append (cl-subseq 
old-containers 0 old-index)
-                                                      new-containers))))
-                              (old-desc ""))
-                    (when (catch 'conflict
-                            (if (not (= (length new-containers) (- (length 
old-containers) old-index)))
-                                (throw 'conflict t))
-                            (while (< new-index (length new-containers))
-                              (if (or (not (string= (plist-get (nth new-index 
new-containers) :name)
-                                                    (plist-get (nth old-index 
old-containers) :name)))
-                                      (not (string= (plist-get (nth new-index 
new-containers) :rel)
-                                                    (plist-get (nth old-index 
old-containers) :rel))))
-                                  (throw 'conflict t))
-                              (setq new-index (+ 1 new-index))
-                              (setq old-index (+ 1 old-index)))
-                            nil)
-                      (goto-char begin)
-                      (if (org-in-regexp org-link-bracket-re 1)
-                          (setq old-desc (when (match-end 2) 
(match-string-no-properties 2))))
-                      (push
-                       `(lambda ()
-                          (delete-region ,begin ,end)
-                          (goto-char ,begin)
-                          (insert (org-real--link-make-string ,replace-link 
,old-desc)))
-                       changes))))))
-            (when (and changes
-                       (or replace-all (let ((response
-                                              (read-char-choice
-                                               (concat
-                                                "Replace all occurrences of "
-                                                primary
-                                                " in current buffer? y/n/a ")
-                                               '(?y ?Y ?n ?N ?a ?A)
-                                               t)))
-                                         (cond
-                                          ((or (= response ?y) (= response 
?Y)) t)
-                                          ((or (= response ?n) (= response 
?N)) nil)
-                                          ((or (= response ?a) (= response ?A))
-                                           (setq replace-all t))))))
-              (mapc 'funcall changes)))
-          (pop new-containers)))))
-  (message nil))
-
-(advice-add 'org-insert-link :after #'org-real--apply)
-
-;;;; Pretty printing
-
-(defun org-real--pp (box &optional containers)
-  "Pretty print BOX in a popup buffer.
-
-If CONTAINERS is passed in, also pretty print a sentence
-describing where BOX is."
-  (let ((top (org-real--get-top box))
-        (width (org-real--get-width box))
-        (height (org-real--get-height box))
-        (inhibit-read-only t)
-        (buffer (get-buffer-create "Org Real")))
-    (with-current-buffer buffer
-      (erase-buffer)
-      (toggle-truncate-lines t)
-      (if containers (org-real--pp-text containers))
-      (let ((offset (- (line-number-at-pos)
-                       (cdr org-real-margin)
-                       (* 2 (cdr org-real-padding)))))
-        (dotimes (_ (+ top height)) (insert (concat (make-string width ?\s) 
"\n")))
-        (org-real--draw box offset)
-        (special-mode)))
-    (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))
-         (container (pop reversed))
-         (primary-name (plist-get container :name)))
-    (dotimes (_ (cdr org-real-padding)) (insert "\n"))
-    (insert (make-string (car org-real-padding) ?\s))
-    (insert "The ")
-    (put-text-property 0 (length primary-name) 'face 'org-real-primary
-                       primary-name)
-    (insert primary-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)
-    (insert "\n")))
 
 (provide 'org-real)