[elpa] master 3e9e1ac 005/215: Work on filtering eval output

[Rocky Bernstein]

branch: master
commit 3e9e1acb19597a1120658869ab496e00de7b3324
Author: rocky <address@hidden>
Commit: rocky <address@hidden>

    Work on filtering eval output
---
 realgud/common/buffer/command.el   |   11 +++++++++--
 realgud/common/eval.el             |   35 ++++++++++++++++++++++++++++++-----
 realgud/common/track.el            |    1 +
 realgud/debugger/jdb/core.el       |    5 +++--
 realgud/debugger/trepan.pl/core.el |    8 ++++++++
 realgud/debugger/trepan.pl/init.el |   21 ++++++++++++++++++---
 6 files changed, 69 insertions(+), 12 deletions(-)

diff --git a/realgud/common/buffer/command.el b/realgud/common/buffer/command.el
index fc9791a..b49019f 100644
--- a/realgud/common/buffer/command.el
+++ b/realgud/common/buffer/command.el
@@ -30,13 +30,13 @@
     (t (:weight bold)))
   "Face used to highlight debugger run information."
   :group 'realgud
-  :version "24.1")
+  :version "24.3")
 
 (defface debugger-not-running
   '((t :inherit font-lock-warning-face))
   "Face used when debugger or process is not running."
   :group 'realgud
-  :version "24.1")
+  :version "24.3")
 
 
 (defstruct realgud-cmdbuf-info
@@ -69,6 +69,10 @@
                        ;; special handling to map output to a file
                        ;; location, this is set to that special
                        ;; function
+  callback-eval-filter ;; If set, this function strip extraneous output
+                       ;; when evaluating an expression. For example,
+                       ;; some trepan debuggers expression values prefaced 
with:
+                       ;; $DB::D[0] =
 
   ;; FIXME: REMOVE THIS and use regexp-hash
   loc-regexp   ;; Location regular expression string
@@ -98,6 +102,7 @@
 (realgud-struct-field-setter "realgud-cmdbuf-info" "src-shortkey?")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "in-debugger?")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "callback-loc-fn")
+(realgud-struct-field-setter "realgud-cmdbuf-info" "callback-eval-filter")
 
 (defun realgud:cmdbuf-follow-buffer(event)
   (interactive "e")
@@ -287,6 +292,8 @@ values set in the debugger's init.el."
             :src-shortkey? 't
             :in-debugger? nil
             :callback-loc-fn (gethash "loc-callback-fn" regexp-hash)
+            :callback-eval-filter (gethash "callback-eval-filter"
+                                           regexp-hash)
             ))
       (setq font-lock-keywords (realgud-cmdbuf-pat "font-lock-keywords"))
       (if font-lock-keywords
diff --git a/realgud/common/eval.el b/realgud/common/eval.el
index 2d851a3..0137941 100644
--- a/realgud/common/eval.el
+++ b/realgud/common/eval.el
@@ -17,13 +17,17 @@
 ;; along with this program.  If not, see
 ;; <http://www.gnu.org/licenses/>.
 
-(require 'load-relative)
 (require 'tooltip)
+(require 'ansi-color)
+(require 'load-relative)
 
-(require-relative-list  '("cmds" "helper")    "realgud-")
+(require-relative-list '("cmds" "helper" "utils")  "realgud-")
+(require-relative-list '("buffer/command")         "realgud-buffer-")
 
 (declare-function realgud:cmd-eval   'realgud-cmd)
 (declare-function realgud-get-cmdbuf 'realgud-helper)
+(declare-function realgud-cmdbuf-pat 'realgud-command)
+(declare-function realgud:strip      'realgud-utils)
 
 (defun realgud:tooltip-eval (event)
   "Show tip for identifier or selection under the mouse.
@@ -48,17 +52,38 @@ This function must return nil if it doesn't handle EVENT."
          ))
       )))
 
-(defun realgud:eval-process-output (process output)
+(defun realgud:eval-process-output (process output-str)
   "Process debugger output and show it in a tooltip window."
   (set-process-filter process 'comint-output-filter)
   (with-current-buffer (realgud-get-cmdbuf)
     (goto-char (process-mark process))
-    (insert output)
+    (insert output-str)
     (set-marker (process-mark process) (point)))
     (setq comint-last-output-start
          (setq realgud-last-output-start (process-mark process)))
 
-  (tooltip-show (tooltip-strip-prompt process output))
+  (tooltip-show (realgud:eval-strip process output-str))
   )
 
+(defun realgud:eval-strip-default(prompt-regexp output-str)
+  (realgud:strip
+   (ansi-color-filter-apply
+    (if (string-match prompt-regexp output-str)
+       (substring output-str 0 (match-beginning 0))
+      output-str))))
+
+
+(defun realgud:eval-strip(process output-str)
+  "Return OUTPUT-STR with any prompt of PROCESS stripped from its end."
+  (save-match-data
+    (with-current-buffer (process-buffer process)
+      (let* ((prompt-pat (realgud-cmdbuf-pat "prompt"))
+            (prompt-regexp (realgud-loc-pat-regexp prompt-pat))
+            (eval-filter (realgud-sget 'cmdbuf-info 'callback-eval-filter))
+            )
+       (if eval-filter
+           (funcall eval-filter output-str)
+         (realgud:eval-strip-default prompt-regexp output-str))
+       ))))
+
 (provide-me "realgud-")
diff --git a/realgud/common/track.el b/realgud/common/track.el
index 2ddfc73..38e6b2c 100644
--- a/realgud/common/track.el
+++ b/realgud/common/track.el
@@ -6,6 +6,7 @@
 
 ;; Shell process buffers that we can hook into:
 (require 'esh-mode)
+(require 'ansi-color)
 (require 'comint)
 
 (require 'load-relative)
diff --git a/realgud/debugger/jdb/core.el b/realgud/debugger/jdb/core.el
index d4d96e9..5fd2d61 100644
--- a/realgud/debugger/jdb/core.el
+++ b/realgud/debugger/jdb/core.el
@@ -9,13 +9,14 @@
 (require-relative-list '("../../common/track"
                          "../../common/core"
                          "../../common/file"
-                         "../../common/lang")
+                         "../../common/lang"
+                         "../../common/utils")
                        "realgud-")
 (require-relative-list '("init") "realgud:jdb-")
 
 (declare-function gud-find-source            'gud)
 
-(declare-function realgud:strip              'realgud)
+(declare-function realgud:strip              'realgud-utils)
 (declare-function realgud:expand-file-name-if-exists 'realgud-core)
 (declare-function realgud-parse-command-arg  'realgud-core)
 (declare-function realgud-query-cmdline      'realgud-core)
diff --git a/realgud/debugger/trepan.pl/core.el 
b/realgud/debugger/trepan.pl/core.el
index 1d3d181..a5c90e7 100644
--- a/realgud/debugger/trepan.pl/core.el
+++ b/realgud/debugger/trepan.pl/core.el
@@ -4,10 +4,12 @@
 (require 'load-relative)
 (require-relative-list '("../../common/track"
                          "../../common/core"
+                         "../../common/eval"
                          "../../common/lang")
                        "realgud-")
 (require-relative-list '("init") "realgud:trepanpl-")
 
+(declare-function realgud:eval-strip-default 'realgud-eval)
 (declare-function realgud:expand-file-name-if-exists 'realgud-core)
 (declare-function realgud-parse-command-arg  'realgud-core)
 (declare-function realgud-query-cmdline      'realgud-core)
@@ -23,6 +25,12 @@
   "Keymap for minibuffer prompting of trepanpl startup command."
   :inherit minibuffer-local-map)
 
+(defun realgud:trepanpl-eval-filter-callback(output-str)
+  (realgud:eval-strip-default realgud:trepanpl-prompt-regexp
+   (if (string-match realgud:trepanpl-eval-result-prefix-regexp output-str)
+       (substring output-str (match-end 0))
+     output-str)))
+
 ;; FIXME: I think this code and the keymaps and history
 ;; variable chould be generalized, perhaps via a macro.
 (defun realgud:trepanpl-query-cmdline (&optional opt-debugger)
diff --git a/realgud/debugger/trepan.pl/init.el 
b/realgud/debugger/trepan.pl/init.el
index a00851e..45e9b53 100644
--- a/realgud/debugger/trepan.pl/init.el
+++ b/realgud/debugger/trepan.pl/init.el
@@ -41,19 +41,31 @@ realgud-loc-pat struct")
        :ignore-file-re  realgud-perl-ignore-file-re)
       )
 
+(defconst realgud:trepanpl-frame-start-regexp
+  "\\(^\\|\n\\)\\(?:-->\\|   \\) #")
+
 ;; Regular expression that describes a trepanpl command prompt
 ;; For example:
 ;;   (trepanpl):
 ;;   ((trepanpl)):
 ;;   (address@hidden):
 ;;   (address@hidden):
+(defconst realgud:trepanpl-prompt-regexp
+  "^(+trepanpl\\(@[0-9]+\\|@main\\)?)+: ")
+
 (setf (gethash "prompt" realgud:trepanpl-pat-hash)
       (make-realgud-loc-pat
-       :regexp "^(+trepanpl\\(@[0-9]+\\|@main\\)?)+: "
+       :regexp realgud:trepanpl-prompt-regexp
+       ))
+
+(defconst realgud:trepanpl-eval-result-prefix-regexp
+  "^\\$DB::D\\[[0-9]+\\] = ")
+
+(setf (gethash "prompt" realgud:trepanpl-pat-hash)
+      (make-realgud-loc-pat
+       :regexp realgud:trepanpl-prompt-regexp
        ))
 
-(defconst realgud:trepanpl-frame-start-regexp
-  "\\(^\\|\n\\)\\(?:-->\\|   \\) #")
 
 (defconst realgud:trepanpl-frame-num-regexp
   "\\([0-9]+\\)")
@@ -204,6 +216,9 @@ backtrace listing.")
 ;;     ;;  (0 trepanpl-frames-current-frame-face append))
 ;;     ))
 
+(setf (gethash "callback-eval-filter" realgud:trepanpl-pat-hash)
+      'realgud:trepanpl-eval-filter-callback)
+
 (setf (gethash realgud:trepanpl-debugger-name realgud-pat-hash) 
realgud:trepanpl-pat-hash)
 
 (defvar realgud:trepanpl-command-hash (make-hash-table :test 'equal)