bug#39179: 27.0.50; [PATCH] Add filter to gdb-mi register buffer

[Yuan Fu <casouri@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 114 bytes --]

Sorry, I forgot to fix the white spaces after period in the commit message. Here is the correct one.

Yuan



[-- Attachment #2: register-fixed.patch --]
[-- Type: application/octet-stream, Size: 9028 bytes --]

From 47bfc24e08b3a07d8a5b9bda8f38cd23421a1ac4 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Sun, 6 Oct 2019 14:10:14 -0400
Subject: [PATCH] Add register filters to gdb-mi

Add filtering feature to register buffer of gdb-mi.
User can add or remove registers they want to see.

On startup, there will be a button "[filter off]" on the header line
of the register buffer.  Clicking on it enables the register filter,
changes the button to "[filter on]" and adds a "[-|+]" button next to
it.  Click "+" to add patterns to the pattern list, click "-" to
remove.  Register whose name matches any pattern in the list is
displayed.  You can also use key "f" for toggle, "+" to add pattern,
"-" to remove pattern.

* lisp/progmodes/gdb-mi.el (gdb-registers-enable-filter,
gdb-registers-filter-pattern-list, gdb-header-click-event-handler,
gdb-registers-add-to-display, gdb-registers-remove-from-display,
gdb-registers-toggle-filter): New functions.
(gdb-registers-handler-custom): Condition check before adding each
register.
(gdb-registers-mode-map): New keys.
(gdb-registers-header): New buttons.
---
 lisp/progmodes/gdb-mi.el | 137 +++++++++++++++++++++++++++++++++++----
 1 file changed, 125 insertions(+), 12 deletions(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 60852e4ad6..aafdbad2c9 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -535,6 +535,24 @@ gdb-show-threads-by-default
   :group 'gdb-buffers
   :version "23.2")
 
+;; Automatically local because we don't want filters persist across gdb sessions.
+(defcustom gdb-registers-enable-filter nil
+  "If t, enable register name filter in register buffer."
+  :local t
+  :type 'boolean
+  :group 'gdb-buffers
+  :version "27.1")
+
+(defcustom gdb-registers-filter-pattern-list nil
+  "Registers that are displayed in register buffer.
+
+Should be a list.  Registers whose name can match
+any of the regexps in the list is displayed."
+  :local t
+  :type 'list
+  :group 'gdb-buffers
+  :version "28.1")
+
 (defvar gdb-debug-log nil
   "List of commands sent to and replies received from GDB.
 Most recent commands are listed first.  This list stores only the last
@@ -4238,6 +4256,53 @@ gdb-frame-locals-buffer
  'gdb-registers-mode
  'gdb-invalidate-registers)
 
+(defun gdb-header-click-event-handler (function)
+  "Return a function that handles clicking event on gdb header buttons.
+
+This function switches to the window where the header locates and
+executes FUNCTION."
+  (lambda (event)
+    (interactive "e")
+    (save-selected-window
+      ;; Make sure we are in the right buffer.
+      (select-window (posn-window (event-start event)))
+      (funcall function))))
+
+(defun gdb-registers-add-to-display ()
+  "Add register to display in register buffer.
+
+Prompt for a register pattern.  The pattern should be a regexp
+pattern matching the name of the register(s) you want to
+display."
+  (interactive)
+  (let ((register (completing-read "Register pattern: "
+                                   gdb-register-names)))
+    (cl-pushnew register gdb-registers-filter-pattern-list)
+    ;; Update register buffer.
+    (gdb-invalidate-registers 'update)))
+
+(defun gdb-registers-remove-from-display ()
+  "Remove register from display in register buffer.
+
+Prompt for a register pattern.  The pattern should be a pattern
+you want to remove from the existing patterns."
+  (interactive)
+  (let ((register (completing-read "Register pattern: "
+                                   gdb-registers-filter-pattern-list
+                                   nil t))) ; require match
+    (setq gdb-registers-filter-pattern-list
+          (remove register gdb-registers-filter-pattern-list))
+    ;; Update register buffer.
+    (gdb-invalidate-registers 'update)))
+
+(defun gdb-registers-toggle-filter ()
+  "Toggle register filter."
+  (interactive)
+  (setq gdb-registers-enable-filter
+        (not gdb-registers-enable-filter))
+  ;; Update register buffer.
+  (gdb-invalidate-registers 'update))
+
 (defun gdb-registers-handler-custom ()
   (when gdb-register-names
     (let ((register-values
@@ -4248,17 +4313,24 @@ gdb-registers-handler-custom
                (value (bindat-get-field register 'value))
                (register-name (nth (string-to-number register-number)
                                    gdb-register-names)))
-          (gdb-table-add-row
-           table
-           (list
-            (propertize register-name
-                        'font-lock-face font-lock-variable-name-face)
-            (if (member register-number gdb-changed-registers)
-                (propertize value 'font-lock-face font-lock-warning-face)
-              value))
-           `(mouse-face highlight
-                        help-echo "mouse-2: edit value"
-                        gdb-register-name ,register-name))))
+          ;; Add register if `gdb-display-these-registers' is t;
+          ;; or any pattern that `gdb-display-these-registers' matches.
+          (when (or (not gdb-registers-enable-filter)
+                    (cl-loop for pattern in gdb-registers-filter-pattern-list
+                             if (string-match pattern register-name)
+                             return t
+                             finally return nil))
+            (gdb-table-add-row
+             table
+             (list
+              (propertize register-name
+                          'font-lock-face font-lock-variable-name-face)
+              (if (member register-number gdb-changed-registers)
+                  (propertize value 'font-lock-face font-lock-warning-face)
+                value))
+             `(mouse-face highlight
+                          help-echo "mouse-2: edit value"
+                          gdb-register-name ,register-name)))))
       (insert (gdb-table-string table " ")))
     (setq mode-name
           (gdb-current-context-mode-name "Registers"))))
@@ -4287,6 +4359,9 @@ gdb-registers-mode-map
                             (gdb-get-buffer-create
                              'gdb-locals-buffer
                              gdb-thread-number) t)))
+    (define-key map "+" #'gdb-registers-add-to-display)
+    (define-key map "-" #'gdb-registers-remove-from-display)
+    (define-key map "f" #'gdb-registers-toggle-filter)
     map))
 
 (defvar gdb-registers-header
@@ -4296,7 +4371,45 @@ gdb-registers-header
                           mode-line-inactive)
    " "
    (gdb-propertize-header "Registers" gdb-registers-buffer
-			  nil nil mode-line)))
+			  nil nil mode-line)
+
+   '(:eval (if (not gdb-registers-enable-filter)
+               (propertize " [filter off]"
+                           'face 'shadow
+                           'help-echo "mouse-1: toggle filter"
+                           'mouse-face 'mode-line-highlight
+                           'local-map (gdb-make-header-line-mouse-map
+                                       'mouse-1
+                                       (gdb-header-click-event-handler
+                                        #'gdb-registers-toggle-filter)))
+             (concat ; enable filter
+              (propertize " [filter on]"
+                          'face '(:weight bold :inherit success)
+                          'help-echo "mouse-1: toggle filter"
+                          'mouse-face 'mode-line-highlight
+                          'local-map (gdb-make-header-line-mouse-map
+                                      'mouse-1
+                                      (gdb-header-click-event-handler
+                                       #'gdb-registers-toggle-filter)))
+              " ["
+              (propertize "-"
+                          'face 'font-lock-warning-face
+                          'help-echo "mouse-1: remove register pattern from display filter"
+                          'mouse-face 'mode-line-highlight
+                          'local-map (gdb-make-header-line-mouse-map
+                                      'mouse-1
+                                      (gdb-header-click-event-handler
+                                       #'gdb-registers-remove-from-display)))
+              "|"
+              (propertize "+"
+                          'face 'font-lock-warning-face
+                          'help-echo "mouse-1: add register pattern to display filter"
+                          'mouse-face 'mode-line-highlight
+                          'local-map (gdb-make-header-line-mouse-map
+                                      'mouse-1
+                                      (gdb-header-click-event-handler
+                                       #'gdb-registers-add-to-display)))
+              "]")))))
 
 (define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
   "Major mode for gdb registers."
-- 
2.25.0