[nongnu] elpa/inf-ruby 871158bcad 255/265: Merge pull request #153 from tunnes/feature-create-eval-overlay

[ELPA Syncer]

branch: elpa/inf-ruby
commit 871158bcad08a30a1e3b0ec6984f081651b3cec4
Merge: 2fae1a8ba9 6943bf1e78
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: GitHub <noreply@github.com>

    Merge pull request #153 from tunnes/feature-create-eval-overlay
    
    [FEAT] Creating evaluation results in an overlay on the current buffer
---
 inf-ruby.el | 172 ++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 149 insertions(+), 23 deletions(-)

diff --git a/inf-ruby.el b/inf-ruby.el
index b35f7d9495..144900c62e 100755
--- a/inf-ruby.el
+++ b/inf-ruby.el
@@ -503,28 +503,154 @@ Must not contain ruby meta characters.")
     (if suffix
        (comint-send-string (inf-ruby-proc) suffix))
     (comint-send-string (inf-ruby-proc) (concat "\n" term "\n"))
-    (when print (ruby-print-result))))
-
-(defun ruby-print-result ()
+    (ruby-print-result print)))
+
+(defface inf-ruby-result-overlay-face
+  '((((class color) (background light))
+     :background "grey90" :box (:line-width -1 :color "yellow"))
+    (((class color) (background dark))
+     :background "grey10" :box (:line-width -1 :color "black")))
+  "Face used to display evaluation results at the end of line.")
+
+;; Overlay
+
+(defun inf-ruby--make-overlay (l r type &rest props)
+  "Place an overlay between L and R and return it.
+TYPE is a symbol put on the overlay's category property.  It is
+used to easily remove all overlays from a region with:
+    (remove-overlays start end 'category TYPE)
+PROPS is a plist of properties and values to add to the overlay."
+  (let ((o (make-overlay l (or r l) (current-buffer))))
+    (overlay-put o 'category type)
+    (overlay-put o 'inf-ruby-temporary t)
+    (while props (overlay-put o (pop props) (pop props)))
+    (push #'inf-ruby--delete-overlay (overlay-get o 'modification-hooks))
+    o))
+
+(defun inf-ruby--delete-overlay (ov &rest _)
+  "Safely delete overlay OV.
+Never throws errors, and can be used in an overlay's
+modification-hooks."
+  (ignore-errors (delete-overlay ov)))
+
+(defun inf-ruby--make-result-overlay (value where duration &rest props)
+  "Place an overlay displaying VALUE at the end of line.
+VALUE is used as the overlay's after-string property, meaning it
+is displayed at the end of the overlay.  The overlay itself is
+placed from beginning to end of current line.
+Return nil if the overlay was not placed or if it might not be
+visible, and return the overlay otherwise.
+Return the overlay if it was placed successfully, and nil if it
+failed.
+All arguments beyond these (PROPS) are properties to be used on
+the overlay."
+  (let ((format " => %s ")
+       (prepend-face 'inf-ruby-result-overlay-face)
+       (type 'result))
+    (declare (indent 1))
+    (while (keywordp (car props))
+      (setq props (cddr props)))
+    ;; If the marker points to a dead buffer, don't do anything.
+    (let ((buffer (cond
+                   ((markerp where) (marker-buffer where))
+                   ((markerp (car-safe where)) (marker-buffer (car where)))
+                   (t (current-buffer)))))
+      (with-current-buffer buffer
+       (save-excursion
+          (when (number-or-marker-p where)
+            (goto-char where))
+          ;; Make sure the overlay is actually at the end of the sexp.
+          (skip-chars-backward "\r\n[:blank:]")
+          (let* ((beg (if (consp where)
+                          (car where)
+                       (save-excursion
+                          (backward-sexp 1)
+                          (point))))
+                (end (if (consp where)
+                          (cdr where)
+                       (line-end-position)))
+                (display-string (format format value))
+                (o nil))
+            (remove-overlays beg end 'category type)
+            (funcall #'put-text-property
+                     0 (length display-string)
+                     'face prepend-face
+                     display-string)
+            ;; If the display spans multiple lines or is very long, display it 
at
+            ;; the beginning of the next line.
+            (when (or (string-match "\n." display-string)
+                      (> (string-width display-string)
+                        (- (window-width) (current-column))))
+              (setq display-string (concat " \n" display-string)))
+            ;; Put the cursor property only once we're done manipulating the
+            ;; string, since we want it to be at the first char.
+            (put-text-property 0 1 'cursor 0 display-string)
+            (when (> (string-width display-string) (* 3 (window-width)))
+              (setq display-string
+                    (concat (substring display-string 0 (* 3 (window-width)))
+                            "...\nResult truncated.")))
+            ;; Create the result overlay.
+            (setq o (apply #'inf-ruby--make-overlay
+                           beg end type
+                           'after-string display-string
+                           props))
+            (pcase duration
+              ((pred numberp) (run-at-time duration nil 
#'inf-ruby--delete-overlay o))
+              (`command (if this-command
+                            (add-hook 'pre-command-hook
+                                      #'inf-ruby--remove-result-overlay
+                                      nil 'local)
+                          (inf-ruby--remove-result-overlay))))
+            (let ((win (get-buffer-window buffer)))
+              ;; Left edge is visible.
+              (when (and win
+                        (<= (window-start win) (point))
+                        ;; In 24.3 `<=' is still a binary predicate.
+                        (<= (point) (window-end win))
+                        ;; Right edge is visible. This is a little conservative
+                        ;; if the overlay contains line breaks.
+                        (or (< (+ (current-column) (string-width value))
+                               (window-width win))
+                             (not truncate-lines)))
+               o))))))))
+
+(defun inf-ruby--remove-result-overlay ()
+  "Remove result overlay from current buffer.
+This function also removes itself from `pre-command-hook'."
+  (remove-hook 'pre-command-hook #'inf-ruby--remove-result-overlay 'local)
+  (remove-overlays nil nil 'category 'result))
+
+(defun inf-ruby--eval-overlay (value)
+  "Make overlay for VALUE at POINT."
+  (inf-ruby--make-result-overlay (format "%S" value) (point) 'command)
+  value)
+
+(defun ruby-print-result (&optional insert)
   "Print the result of the last evaluation in the current buffer."
+  (let ((proc (inf-ruby-proc))
+        (result (ruby-print-result-value)))
+    (if insert
+        (insert result)
+      (inf-ruby--eval-overlay result))))
+
+(defun ruby-print-result-value ()
   (let ((proc (inf-ruby-proc)))
-    (insert
-     (with-current-buffer (or (inf-ruby-buffer)
-                              inf-ruby-buffer)
-       (while (not (and comint-last-prompt
-                        (goto-char (car comint-last-prompt))
-                        (looking-at inf-ruby-first-prompt-pattern)))
-         (accept-process-output proc))
-       (re-search-backward inf-ruby-prompt-pattern)
-       (or (re-search-forward " => " (car comint-last-prompt) t)
-           ;; Evaluation seems to have failed.
-           ;; Try to extract the error string.
-           (let* ((inhibit-field-text-motion t)
-                  (s (buffer-substring-no-properties (point) 
(line-end-position))))
-             (while (string-match inf-ruby-prompt-pattern s)
-               (setq s (replace-match "" t t s)))
-             (error "%s" s)))
-       (buffer-substring-no-properties (point) (line-end-position))))))
+    (with-current-buffer (or (inf-ruby-buffer)
+                             inf-ruby-buffer)
+      (while (not (and comint-last-prompt
+                       (goto-char (car comint-last-prompt))
+                       (looking-at inf-ruby-first-prompt-pattern)))
+        (accept-process-output proc))
+      (re-search-backward inf-ruby-prompt-pattern)
+      (or (re-search-forward " => " (car comint-last-prompt) t)
+          ;; Evaluation seems to have failed.
+          ;; Try to extract the error string.
+          (let* ((inhibit-field-text-motion t)
+                 (s (buffer-substring-no-properties (point) 
(line-end-position))))
+            (while (string-match inf-ruby-prompt-pattern s)
+              (setq s (replace-match "" t t s)))
+            (error "%s" s)))
+      (buffer-substring-no-properties (point) (line-end-position)))))
 
 (defun ruby-send-definition ()
   "Send the current definition to the inferior Ruby process."
@@ -557,7 +683,7 @@ Must not contain ruby meta characters.")
   "Send the previous sexp to the inferior Ruby process."
   (interactive "P")
   (ruby-send-region (save-excursion (ruby-backward-sexp) (point)) (point))
-  (when print (ruby-print-result)))
+  (ruby-print-result print))
 
 (defun ruby-send-last-stmt (&optional print)
   "Send the preceding statement to the inferior Ruby process."
@@ -577,7 +703,7 @@ Must not contain ruby meta characters.")
           (back-to-indentation))
         (setq beg (point)))))
     (ruby-send-region beg (point)))
-  (when print (ruby-print-result)))
+  (ruby-print-result print))
 
 (defun ruby-send-block (&optional print)
   "Send the current block to the inferior Ruby process."
@@ -588,7 +714,7 @@ Must not contain ruby meta characters.")
     (let ((end (point)))
       (ruby-beginning-of-block)
       (ruby-send-region (point) end)))
-  (when print (ruby-print-result)))
+  (ruby-print-result print))
 
 (defvar ruby-last-ruby-buffer nil
   "The last buffer we switched to `inf-ruby' from.")