branch: externals/org-real
commit 193f14d1e02f36e893e9e07fe765aa9faa9c9931
Author: Tyler Grinn <[email protected]>
Commit: Tyler Grinn <[email protected]>
Refactoring
---
demo/garage.org | 2 +-
org-real.el | 85 +++++++++++++++++++++++++++++----------------------------
2 files changed, 44 insertions(+), 43 deletions(-)
diff --git a/demo/garage.org b/demo/garage.org
index 9cef143..ca2c554 100644
--- a/demo/garage.org
+++ b/demo/garage.org
@@ -12,6 +12,6 @@
- [[real://garage/workbench/nails?rel=on top of][nails]]
- [[real://garage/east wall][East wall]]
- [[real://garage/east wall/rake?rel=on/hoe?rel=to the left
of/snowblower?rel=above][snowblower]]
- - [[real://garage/workbench/hammer?rel=on/screws?rel=to the right
of][screws]]
+ - [[real://garage/workbench/nails?rel=on top of/screws?rel=above][screws]]
- [[real://garage/saw?rel=on][saw]]
- [[real://garage/workbench/paintbrush?rel=in front of/wrench?rel=to the
left of/pliers?rel=below][pliers]]
diff --git a/org-real.el b/org-real.el
index 0dd0b57..c6f6f1b 100644
--- a/org-real.el
+++ b/org-real.el
@@ -1213,50 +1213,51 @@ 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 display-rel-box display-rel name metadata
help-echo) box
+ (with-slots
+ ((actual-rel rel)
+ (actual-rel-box rel-box)
+ display-rel-box
+ display-rel
+ name
+ metadata
+ help-echo)
+ box
(let (tooltip-timer)
(lambda (_window _oldpos dir)
- (let ((inhibit-read-only t))
- (save-excursion
- (if (eq dir 'entered)
- (progn
- (if (slot-boundp box :help-echo)
- (message help-echo))
- (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)) (if (slot-boundp box
:display-rel-box)
- display-rel-box
- rel-box)
- (setq tooltip-timer
- (org-real--tooltip
- (with-temp-buffer
- (insert (format (concat "The %s "
- (if
(org-real--is-plural name) "are" "is")
- " %s the %s.")
- name
- (if (slot-boundp box
:display-rel)
- display-rel
- rel)
- rel-name))
- (let ((fill-column
org-real-tooltip-max-width))
- (fill-paragraph t))
- (buffer-string)))))))
- (if (slot-boundp box :display-rel-box)
- (if (org-real--is-visible display-rel-box t)
- (org-real--draw display-rel-box 'rel))
- (if (and (slot-boundp box :rel-box)
- (org-real--is-visible rel-box t))
- (org-real--draw rel-box 'rel)))
- (org-real--draw box 'selected))
- (if tooltip-timer (cancel-timer tooltip-timer))
- (if (slot-boundp box :display-rel-box)
- (if (org-real--is-visible display-rel-box t)
- (org-real--draw display-rel-box t))
- (if (and (slot-boundp box :rel-box)
- (org-real--is-visible rel-box t))
- (org-real--draw rel-box t)))
- (org-real--draw box t))))))))
+ (let* ((rel-box (and (slot-boundp box :rel-box)
+ (if (slot-boundp box :display-rel-box)
+ display-rel-box
+ actual-rel-box)))
+ (visible-rel-box rel-box))
+ (while (and visible-rel-box (not (org-real--is-visible
visible-rel-box t)))
+ (setq visible-rel-box (with-slots (parent) visible-rel-box
parent)))
+ (when (eq dir 'entered)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (org-real--draw box 'selected)
+ (if visible-rel-box (org-real--draw visible-rel-box 'rel))))
+ (if (slot-boundp box :help-echo) (message help-echo))
+ (if (slot-boundp box :metadata)
+ (setq tooltip-timer (org-real--tooltip metadata))
+ (if (and (slot-boundp box :name) rel-box)
+ (let ((rel-name (with-slots (name) rel-box name))
+ (rel (if (slot-boundp box :display-rel) display-rel
actual-rel)))
+ (setq tooltip-timer
+ (org-real--tooltip
+ (with-temp-buffer
+ (insert (format (concat "The %s "
+ (if (org-real--is-plural
name) "are" "is")
+ " %s the %s.")
+ name rel rel-name))
+ (let ((fill-column org-real-tooltip-max-width))
+ (fill-paragraph t))
+ (buffer-string))))))))
+ (when (eq dir 'left)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (org-real--draw box t)
+ (if visible-rel-box (org-real--draw visible-rel-box t))))
+ (if tooltip-timer (cancel-timer tooltip-timer))))))))
(cl-defmethod org-real--jump-other-window ((box org-real-box))
"Jump to location of link for BOX in other window."
