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

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

[elpa] externals/org-real f1614bf 111/160: Refactoring; killing org real


From: ELPA Syncer
Subject: [elpa] externals/org-real f1614bf 111/160: Refactoring; killing org real buffer if it exists before recreating
Date: Wed, 6 Oct 2021 16:58:27 -0400 (EDT)

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

    Refactoring; killing org real buffer if it exists before recreating
---
 org-real.el | 112 +++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 61 insertions(+), 51 deletions(-)

diff --git a/org-real.el b/org-real.el
index 8018be0..0be47d6 100644
--- a/org-real.el
+++ b/org-real.el
@@ -396,22 +396,14 @@ MAX-LEVEL is the maximum level to show headlines for."
   (org-real--flex-adjust org-real--current-box)
   (let ((inhibit-read-only t))
     (erase-buffer)
-    (setq org-real--box-ring '())
     (if org-real--current-containers
         (org-real--pp-text org-real--current-containers))
     (setq org-real--current-offset (- (line-number-at-pos)
                                       org-real-margin-y
                                       (* 2 org-real-padding-y)))
-    (let ((box-coords (org-real--draw org-real--current-box)))
-      (setq org-real--box-ring
-            (seq-sort
-             '<
-             (mapcar
-              (lambda (coords)
-                (forward-line (- (car coords) (line-number-at-pos)))
-                (move-to-column (cdr coords))
-                (point))
-              box-coords))))
+    (org-real--draw org-real--current-box)
+    (setq org-real--box-ring
+          (seq-sort '< (org-real--get-positions org-real--current-box)))
     (goto-char (point-max))
     (insert "\n")
     (goto-char 0)))
@@ -474,6 +466,8 @@ it.
 VISIBILITY is the initial visibility of children and
 MAX-VISIBILITY is the maximum depth to display when cycling
 visibility."
+  (if-let ((buffer (get-buffer "Org Real")))
+      (kill-buffer buffer))
   (let ((buffer (get-buffer-create "Org Real")))
     (with-current-buffer buffer
       (org-real-mode)
@@ -485,7 +479,6 @@ visibility."
       (org-real-mode-redraw)
       (let* ((width (apply 'max (mapcar 'length (split-string (buffer-string) 
"\n"))))
              (height (count-lines (point-min) (point-max)))
-             (buffer (get-buffer-create "Org Real"))
              (window (or (get-buffer-window buffer)
                          (display-buffer buffer
                                          `(,(or display-buffer-fn
@@ -637,7 +630,7 @@ ORIG is `org-insert-link', ARGS are the arguments passed to 
it."
                                                           (ignore-errors
                                                             (url-type
                                                              
(url-generic-parse-url link))))
-                                                 (plist-get (car (last 
(org-real--parse-url link nil)))
+                                                 (plist-get (car (last 
(org-real--parse-url link)))
                                                             :name))))))
     (unwind-protect
         (if (called-interactively-p 'any)
@@ -764,6 +757,26 @@ non-nil, skip setting :primary slot on the last box."
         (org-real--merge-into (pop boxes) world))
       world)))
 
+(cl-defmethod org-real--merge-into ((from org-real-box) (to org-real-box))
+  "Merge FROM box into TO box."
+  (let (match-found)
+    (mapc
+     (lambda (from-box)
+       (let ((match (org-real--find-matching from-box to)))
+         (while (and (not match) (slot-boundp from-box :rel-box))
+           (setq from-box (with-slots (rel-box) from-box rel-box))
+           (setq match (org-real--find-matching from-box to)))
+         (when match
+           (setq match-found t)
+           (org-real--add-matching from-box match))))
+     (org-real--primary-boxes from))
+    (unless match-found
+      (let ((all-from-children (org-real--get-children from 'all)))
+        (with-slots ((to-children children) (to-behind behind)) to
+          (if (= 1 (length all-from-children))
+              (org-real--flex-add (car all-from-children) to)
+            (org-real--flex-add from to)))))))
+
 (cl-defmethod org-real--update-visibility ((box org-real-box))
   "Update visibility of BOX and all of its children."
   (with-slots (level children hidden-children expand-children) box
@@ -787,6 +800,19 @@ non-nil, skip setting :primary slot on the last box."
            (org-real--get-all children))))))
   (mapc 'org-real--update-visibility (org-real--get-children box 'all)))
 
+(cl-defmethod org-real--get-positions ((box org-real-box))
+  "Get the buffer position of the names of BOX and its children."
+  (if-let ((pos (and (slot-boundp box :name)
+                     (let ((top (org-real--get-top box))
+                           (left (org-real--get-left box)))
+                       (forward-line (- (+ org-real--current-offset 1 top 
org-real-padding-y)
+                                        (line-number-at-pos)))
+                       (move-to-column (+ 1 left org-real-padding-x))
+                       (point)))))
+      (apply 'append (list pos) (mapcar 'org-real--get-positions 
(org-real--get-children box)))
+    (apply 'append (mapcar 'org-real--get-positions (org-real--get-children 
box)))))
+
+
 ;;;; Drawing
 
 (cl-defmethod org-real--draw ((box org-real-box) &optional arg)
@@ -1096,27 +1122,23 @@ If INCLUDE-ON-TOP is non-nil, also include height on 
top of box."
 (cl-defmethod org-real--create-cursor-function ((box org-real-box))
   "Create cursor functions for entering and leaving BOX."
   (with-slots (rel rel-box name metadata) box
-    (let (timer)
+    (let (tooltip-timer)
       (lambda (_window _oldpos dir)
         (let ((inhibit-read-only t))
           (save-excursion
             (if (eq dir 'entered)
                 (progn
-                  (if org-real-tooltips
-                      (setq timer
-                            (run-with-idle-timer
-                             org-real-tooltip-timeout nil
-                             (lambda ()
-                               (if (slot-boundp box :metadata)
-                                   (org-real--tooltip metadata)
-                                 (if (and (slot-boundp box :name) (slot-boundp 
box :rel))
-                                     (with-slots ((rel-name name)) rel-box
-                                       (org-real--tooltip (format "The %s is 
%s the %s."
-                                                                  name rel 
rel-name)))))))))
+                  (if (slot-boundp box :metadata)
+                      (setq tooltip-timer (org-real--tooltip metadata))
+                    (if (and (slot-boundp box :name) (slot-boundp box :rel))
+                        (with-slots ((rel-name name)) rel-box
+                          (setq tooltip-timer
+                                (org-real--tooltip (format "The %s is %s the 
%s."
+                                                           name rel 
rel-name))))))
                   (if (slot-boundp box :rel-box)
                       (org-real--draw rel-box 'rel))
                   (org-real--draw box 'selected))
-              (if timer (cancel-timer timer))
+              (if tooltip-timer (cancel-timer tooltip-timer))
               (if (slot-boundp box :rel-box)
                   (org-real--draw rel-box t))
               (org-real--draw box t))))))))
@@ -1169,7 +1191,7 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
   "Jump to the box directly related to BOX."
   (with-slots (rel-box) box
     (if (not (slot-boundp box :rel-box))
-        'identity
+        (lambda () (interactive))
       (let ((left (org-real--get-left rel-box))
             (top (org-real--get-top rel-box)))
         (lambda ()
@@ -1409,26 +1431,6 @@ PREV must already exist in PARENT."
    (lambda (next) (org-real--add-next next match))
    (org-real--next box)))
 
-(cl-defmethod org-real--merge-into ((from org-real-box) (to org-real-box))
-  "Merge FROM box into TO box."
-  (let (match-found)
-    (mapc
-     (lambda (from-box)
-       (let ((match (org-real--find-matching from-box to)))
-         (while (and (not match) (slot-boundp from-box :rel-box))
-           (setq from-box (with-slots (rel-box) from-box rel-box))
-           (setq match (org-real--find-matching from-box to)))
-         (when match
-           (setq match-found t)
-           (org-real--add-matching from-box match))))
-     (org-real--primary-boxes from))
-    (unless match-found
-      (let ((all-from-children (org-real--get-children from 'all)))
-        (with-slots ((to-children children) (to-behind behind)) to
-          (if (= 1 (length all-from-children))
-              (org-real--flex-add (car all-from-children) to)
-            (org-real--flex-add from to)))))))
-
 (cl-defmethod org-real--add-next ((next org-real-box)
                                   (prev org-real-box)
                                   &optional force-visible)
@@ -1753,9 +1755,17 @@ characters if possible."
 
 (defun org-real--tooltip (str)
   "Show a popup tooltip with STR contents."
-  (popup-tip (concat "\n" str "\n")
-             :parent-offset 1
-             :margin org-real-padding-x))
+  (let ((marker (point-marker)))
+    (when org-real-tooltips
+      (run-with-idle-timer
+       org-real-tooltip-timeout nil
+       (lambda ()
+         (if (and (eq (marker-buffer marker)
+                      (current-buffer))
+                  (eq (marker-position marker)
+                      (point)))
+             (popup-tip (concat "\n" str "\n")
+                        :margin org-real-padding-x)))))))
 
 (defun org-real--find-last-index (pred sequence)
   "Return the index of the last element for which (PRED element) is non-nil in 
SEQUENCE."
@@ -1789,7 +1799,7 @@ LINK is escaped with backslashes for inclusion in buffer."
         (org-link-escape link)
         (if description (format "[%s]" description) "")))))
 
-(defun org-real--parse-url (str marker)
+(defun org-real--parse-url (str &optional marker)
   "Parse STR into a list of plists.
 
 Returns a list of plists with a :name property and optionally a



reply via email to

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