[elpa] externals/org-real bf8a26c 105/160: Navigate by relationship; color currenly selected box and rel-box

[ELPA Syncer]

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

    Navigate by relationship; color currenly selected box and rel-box
---
 README.org  |   1 +
 org-real.el | 139 +++++++++++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 110 insertions(+), 30 deletions(-)

diff --git a/README.org b/README.org
index 0f1552d..f954afc 100644
--- a/README.org
+++ b/README.org
@@ -140,6 +140,7 @@ Keep track of real things as org-mode links.
    - =RET / mouse-1= Jump to first occurrence of link
    - =o= Cycle occurrences of links in other window
    - =M-RET= Open all occurences of links by splitting the current window
+   - =r= Jump to the box directly related to the current box
 
    [[file:demo/org-real-mode.gif]]
 
diff --git a/org-real.el b/org-real.el
index b27fcfb..1459813 100644
--- a/org-real.el
+++ b/org-real.el
@@ -38,6 +38,9 @@
 ;;             Pressed multiple times, cycle through occurrences.
 ;;   M-RET - Open all occurrences as separate buffers.
 ;;             This will split the current window as needed.
+;;   r     - Jump to the box directly related to the current box.
+;;             Repeated presses will eventually take you to the
+;;             top level box.
 ;;
 
 ;;; Code:
@@ -134,6 +137,10 @@
 
 ;;;; Faces
 
+(defface org-real-default nil
+  "Default face used in Org Real mode."
+  :group 'org-real)
+
 (defface org-real-primary nil
   "Face for the last thing in a real link."
   :group 'org-real)
@@ -143,6 +150,24 @@
  '((t :foreground "light slate blue"))
  'face-defface-spec)
 
+(defface org-real-selected nil
+  "Face for the current box under cursor."
+  :group 'org-real)
+
+(face-spec-set
+ 'org-real-selected
+ '((t :foreground "light slate blue"))
+ 'face-defface-spec)
+
+(defface org-real-rel nil
+  "Face for the box which is related to the box under the cursor."
+  :group 'org-real)
+
+(face-spec-set
+ 'org-real-rel
+ '((t :foreground "orange"))
+ 'face-defface-spec)
+
 ;;;; Constants & variables
 
 (defconst org-real-prepositions
@@ -377,8 +402,10 @@ The following commands are available:
 
 \\{org-real-mode-map}"
   :group 'org-mode
-  (setq indent-tabs-mode nil)
-  (let ((inhibit-message t)) (toggle-truncate-lines t)))
+  (let ((inhibit-message t))
+    (setq indent-tabs-mode nil)
+    (cursor-sensor-mode t)
+    (toggle-truncate-lines t)))
 
 (mapc
  (lambda (key) (define-key org-real-mode-map (kbd (car key)) (cdr key)))
@@ -733,10 +760,16 @@ non-nil, skip setting :primary slot on the last box."
 
 ;;;; Drawing
 
-(cl-defmethod org-real--draw ((box org-real-box))
+(cl-defmethod org-real--draw ((box org-real-box) &optional arg)
   "Insert an ascii drawing of BOX into the current buffer.
 
-OFFSET is the starting line to start insertion.
+If ARG is non-nil, skip drawing children boxes and only update
+text properties on the border. If ARG is 'selected, draw the
+border using the `org-real-selected' face. If ARG is 'rel, draw
+the border using `org-real-rel' face, else use `org-real-default'
+face.
+
+Uses `org-real--current-offset' to determine row offset.
 
 Adds to list `org-real--box-ring' the buffer position of each
 button drawn."
@@ -764,29 +797,44 @@ button drawn."
                            (when (< (line-number-at-pos) (car coords))
                              (insert (make-string (- (car coords) 
(line-number-at-pos)) ?\n)))
                            (move-to-column (cdr coords) t)
-                           (if primary (put-text-property 0 (length str)
-                                                          'face 
'org-real-primary str))
-                           (insert str)
-                           (let ((remaining-chars (- (save-excursion 
(end-of-line) (current-column))
-                                                     (current-column))))
-                             (delete-char (min (length str) remaining-chars))))
+                           (if arg
+                               (ignore-errors
+                                 (put-text-property (point) (+ (length str) 
(point))
+                                                    'face (cond ((eq arg 
'selected) 'org-real-selected)
+                                                                ((eq arg 'rel) 
'org-real-rel)
+                                                                (t 
'org-real-default))))
+                             (put-text-property 0 (length str)
+                                                'face (if primary
+                                                          'org-real-primary
+                                                        'org-real-default)
+                                                str)
+                             (insert str)
+                             (let ((remaining-chars (- (save-excursion 
(end-of-line) (current-column))
+                                                       (current-column))))
+                               (delete-char (min (length str) 
remaining-chars)))))
                      (draw-name (coords str &optional primary)
-                                (if (not locations)
-                                    (draw coords str primary)
-                                  (forward-line (- (car coords) 
(line-number-at-pos)))
-                                  (when (< (line-number-at-pos) (car coords))
-                                    (insert (make-string (- (car coords) 
(line-number-at-pos)) ?\n)))
-                                  (move-to-column (cdr coords) t)
-                                  (setq box-coords coords)
-                                  (if primary (put-text-property 0 (length str)
-                                                                 'face 
'org-real-primary str))
-                                  (insert-button str
-                                                 'help-echo "Jump to first 
occurence"
-                                                 'keymap 
(org-real--create-button-keymap box))
-                                  (let ((remaining-chars (- (save-excursion 
(end-of-line)
-                                                                            
(current-column))
+                                (when (not arg)
+                                  (if (not locations)
+                                      (draw coords str primary)
+                                    (forward-line (- (car coords) 
(line-number-at-pos)))
+                                    (when (< (line-number-at-pos) (car coords))
+                                      (insert (make-string (- (car coords) 
(line-number-at-pos)) ?\n)))
+                                    (move-to-column (cdr coords) t)
+                                    (setq box-coords coords)
+                                    (if primary (put-text-property 0 (length 
str)
+                                                                   'face 
'org-real-primary
+                                                                   str))
+                                    (put-text-property 0 (length str)
+                                                       'cursor-sensor-functions
+                                                       (list 
(org-real--create-cursor-functions box))
+                                                       str)
+                                    (insert-button str
+                                                   'help-echo "Jump to first 
occurence"
+                                                   'keymap 
(org-real--create-button-keymap box))
+                                    (let ((remaining-chars (- (save-excursion 
(end-of-line)
+                                                                              
(current-column))
                                                             (current-column))))
-                                    (delete-char (min (length str) 
remaining-chars))))))
+                                      (delete-char (min (length str) 
remaining-chars)))))))
             (draw (cons top left)
                   (concat (if double "╔" "┌")
                           (make-string (- width 2) (cond (dashed #x254c)
@@ -820,11 +868,13 @@ button drawn."
                                         (double "║")
                                         (t "│")))
                 (setq r (+ r 1))))))))
-    (apply 'append
-           (if box-coords (list box-coords) nil)
-           (mapcar
-            'org-real--draw
-            (org-real--get-children box)))))
+    (if arg
+        (if box-coords (list box-coords) nil)
+      (apply 'append
+             (if box-coords (list box-coords) nil)
+             (mapcar
+              'org-real--draw
+              (org-real--get-children box))))))
 
 (cl-defmethod org-real--get-width ((box org-real-box))
   "Get the width of BOX."
@@ -1014,6 +1064,22 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
 
 ;;;; Org real mode buttons
 
+(cl-defmethod org-real--create-cursor-functions ((box org-real-box))
+  (with-slots (rel-box) box
+    (lambda (_window _oldpos dir)
+      (let ((inhibit-read-only t)
+            (top (org-real--get-top box))
+            (left (org-real--get-left box)))
+        (save-excursion
+          (if (eq dir 'entered)
+              (progn
+                (if (slot-boundp box :rel-box)
+                    (org-real--draw rel-box 'rel))
+                (org-real--draw box 'selected))
+            (if (slot-boundp box :rel-box)
+                (org-real--draw rel-box t))
+            (org-real--draw box t)))))))
+
 (cl-defmethod org-real--jump-other-window ((box org-real-box))
   "Jump to location of link for BOX in other window."
   (with-slots (locations) box
@@ -1058,6 +1124,18 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
           (switch-to-buffer (marker-buffer marker))
           (goto-char (marker-position marker)))))))
 
+(cl-defmethod org-real--jump-rel ((box org-real-box))
+  (with-slots (rel-box) box
+    (if (not (slot-boundp box :rel-box))
+        'identity
+      (let ((left (org-real--get-left rel-box))
+            (top (org-real--get-top rel-box)))
+        (lambda ()
+          (interactive)
+          (forward-line (- (+ org-real--current-offset top 1 
org-real-padding-y)
+                           (line-number-at-pos)))
+          (move-to-column (+ left 1 org-real-padding-x)))))))
+
 (cl-defmethod org-real--create-button-keymap ((box org-real-box))
   "Create a keymap for a button in Org Real mode.
 
@@ -1068,6 +1146,7 @@ BOX is the box the button is being made for."
       (lambda (key) (cons (kbd (car key)) (cdr key)))
       `(("TAB"       . ,(org-real--cycle-children box))
         ("o"         . ,(org-real--jump-other-window box))
+        ("r"         . ,(org-real--jump-rel box))
         ("<mouse-1>" . ,(org-real--jump-to box))
         ("RET"       . ,(org-real--jump-to box))
         ("M-RET"     . ,(org-real--jump-all box)))))))