[elpa] externals/realgud e03446f 36/72: Merge pull request #265 from realgud/feature/comint-truncate-buffer

[Stefan Monnier]

branch: externals/realgud
commit e03446f54c7ee0b4ed3ec7300597046cf1de2bb8
Merge: b854e04 51f55ce
Author: R. Bernstein <rocky@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #265 from realgud/feature/comint-truncate-buffer
    
    Feature/comint truncate buffer
---
 .travis.yml                  |   2 +-
 realgud/common/track-mode.el | 148 +++++++++++++++++++++++++++++++++++--------
 2 files changed, 124 insertions(+), 26 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index ead6950..9529123 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -4,7 +4,7 @@ sudo: no
 env:
 #  - EVM_EMACS=emacs-26.3-travis # Broken on travis
  - EVM_EMACS=emacs-25.3-travis
- - EVM_EMACS=emacs-25.2-travis
+# - EVM_EMACS=emacs-25.2-travis
 
 # Install EVM, version EVM_EMACS
 install:
diff --git a/realgud/common/track-mode.el b/realgud/common/track-mode.el
index 4ca2c63..1df17bf 100644
--- a/realgud/common/track-mode.el
+++ b/realgud/common/track-mode.el
@@ -1,4 +1,4 @@
-;; Copyright (C) 2015-2017 Free Software Foundation, Inc
+;; Copyright (C) 2015-2017, 2020 Free Software Foundation, Inc
 
 ;; Author: Rocky Bernstein <rocky@gnu.org>
 
@@ -39,6 +39,10 @@
                  'realgud-utils)
 (declare-function shell-mode 'shell)
 
+(defconst realgud-track-truncate-default
+  10
+  "When `realgud-truncate-buffer` is called without arguments, save this many 
history location steps.")
+
 (defvar realgud-track-mode-map
   (let ((map  (copy-keymap shell-mode-map)))
     (realgud-populate-debugger-menu map)
@@ -81,7 +85,7 @@
               map)
       (tool-bar-local-item-from-menu
        (car x) (cdr x) map realgud-track-mode-map)))
-  "toolbar use when `realgud' interface is active"
+  "Toolbar used when `realgud' interface is active."
   )
 
 (define-minor-mode realgud-track-mode
@@ -102,13 +106,120 @@
   (realgud-track-mode-setup realgud-track-mode)
   )
 
+(defun realgud-track-remove-hooks()
+  (let ((mode (realgud:canonic-major-mode)))
+    (cond ((eq mode 'eshell)
+          (remove-hook 'eshell-output-filter-functions
+                       'realgud-track-eshell-output-filter-hook))
+         ((eq mode 'comint)
+          (remove-hook 'comint-output-filter-functions
+                       'realgud-track-comint-output-filter-hook))
+         )))
+
+(defun realgud-track-add-hooks()
+  (let ((mode (realgud:canonic-major-mode)))
+    (cond ((eq mode 'eshell)
+          (add-hook 'eshell-output-filter-functions
+                    'realgud-track-eshell-output-filter-hook))
+         ((eq mode 'comint)
+          (add-hook 'comint-output-filter-functions
+                    'realgud-track-comint-output-filter-hook))
+         )))
+
+;; We will hijack comint-truncate-buffer to augment it with awareness of
+;; realgud. We save the original value and restore that when leaving the mode.
+(defalias 'comint-truncate-buffer-orig
+  (symbol-function 'comint-truncate-buffer))
+
+(defun realgud-track-truncate-buffer (&optional last-n)
+  "Truncate the buffer to the last LAST-N history commands.
+This function could be on `comint-output-filter-functions' or bound to a key."
+  (interactive "p")
+  (if (realgud-cmdbuf?)
+      (let* ((info realgud-cmdbuf-info)
+            (loc-hist (realgud-cmdbuf-info-loc-hist info))
+            (loc-ring (realgud-loc-hist-ring loc-hist))
+            (locs (ring-elements loc-ring))
+            (clamped-last-n (min (or last-n realgud-track-truncate-default)
+                                 (length locs)))
+            (i (max 0 clamped-last-n))
+            (loc (ring-ref loc-ring i))
+            (cmd-marker)
+            )
+
+       (when (y-or-n-p
+              (format-message
+               "Truncate buffer to last %d steps and destroy older realgud 
debug history? "
+               clamped-last-n))
+
+         (save-excursion
+           ;; Find a location marker in the history associated with 
clamped-last-n
+           (while (and (not (realgud-loc? loc)) (> i 0))
+             (setq i (1- i))
+             (setq loc (ring-ref loc-ring i)))
+
+           (when (realgud-loc? loc)
+             ;; Delete up to loc.
+             (setq cmd-marker (realgud-loc-cmd-marker loc))
+             (goto-char cmd-marker)
+             (forward-line 0)
+             (beginning-of-line)
+             (let ((inhibit-read-only t))
+               (delete-region
+                (or (and (boundp 'realgud-point-min) realgud-point-min)
+                    (point-min))
+                (point)))
+
+             ;; Clear out location history for portion that was deleted.
+             (while (> (ring-length loc-ring) clamped-last-n)
+               (ring-remove loc-ring))
+
+             ;; Set new last position and restore realgud tracking hooks.
+             (setf (realgud-cmdbuf-info-last-input-end realgud-cmdbuf-info) 
(point-max))
+             (realgud-track-add-hooks)
+           ))
+       ))
+    ;; else
+    (message "Nothing done - not in command buffer")
+    ))
+
+(defun realgud-track-clear-buffer()
+  "Remove the entire command buffer.
+This is like `comint-clear-buffer' or `comint-truncate-buffer' except we
+coordinate the delete with realgud so that it doesn't get bolixed
+by marker removal."
+  (interactive "")
+  (if (realgud-cmdbuf?)
+      (when (y-or-n-p "Clear buffer and destroy realgud debug history? ")
+       (realgud-track-remove-hooks)
+
+       ;; Delete buffer from the beginning to just before the last input 
region.
+       (save-excursion
+         (goto-char (process-mark (get-buffer-process (current-buffer))))
+         (forward-line 0)
+         (beginning-of-line)
+         (let ((inhibit-read-only t))
+           (delete-region
+            (or (and (boundp 'realgud-point-min) realgud-point-min))
+            (point))))
+
+       ;; Set new last position, while location history, and restore realgud 
tracking hooks.
+       (setf (realgud-cmdbuf-info-last-input-end realgud-cmdbuf-info) 
(point-max))
+       (setf (realgud-cmdbuf-info-loc-hist realgud-cmdbuf-info) 
(make-realgud-loc-hist))
+       (realgud-track-add-hooks)
+       )
+    ;; else
+    (message "Nothing done - not in command buffer")
+    ))
+
+
 ;; FIXME: this should have been picked up by require'ing track.
 (defvar realgud-track-divert-string)
 
 (defun realgud-track-mode-setup (mode-on?)
-  "Called when entering or leaving `realgud-track-mode'. Variable
-MODE-ON is a boolean which specifies if we are going into or out
-of this mode."
+  "Mode setup when entering or leaving `realgud-track-mode'.
+Variable MODE-ON? is a boolean which specifies if we are going
+into or out of this mode."
   (if mode-on?
       (let ((process (get-buffer-process (current-buffer))))
        (unless process
@@ -139,14 +250,7 @@ of this mode."
          (set-marker comint-last-output-start (point)))
 
        (set (make-local-variable 'tool-bar-map) realgud:tool-bar-map)
-       (let ((mode (realgud:canonic-major-mode)))
-         (cond ((eq mode 'eshell)
-                (add-hook 'eshell-output-filter-functions
-                          'realgud-track-eshell-output-filter-hook))
-               ((eq mode 'comint)
-                (add-hook 'comint-output-filter-functions
-                          'realgud-track-comint-output-filter-hook))
-               ))
+       (realgud-track-add-hooks)
        (run-mode-hooks 'realgud-track-mode-hook))
   ;; else
     (progn
@@ -156,14 +260,7 @@ of this mode."
        )
       (kill-local-variable 'realgud:tool-bar-map)
       (realgud-fringe-erase-history-arrows)
-      (let ((mode (realgud:canonic-major-mode)))
-       (cond ((eq mode 'eshell)
-              (remove-hook 'eshell-output-filter-functions
-                   'realgud-track-eshell-output-filter-hook))
-             ((eq mode 'comint)
-              (remove-hook 'comint-output-filter-functions
-                           'realgud-track-comint-output-filter-hook))
-             ))
+      (realgud-track-remove-hooks)
       (let* ((cmd-process (get-buffer-process (current-buffer)))
             (status (if cmd-process
                         (list (propertize (format ":%s"
@@ -191,6 +288,7 @@ of this mode."
 ;;   (defvar trepan-short-key-mode-map (make-sparse-keymap))
 ;;   (set-keymap-parent trepan-short-key-mode-map realgud-short-key-mode-map)
 (defmacro realgud-track-mode-vars (name)
+  "Create a number of track-mode variables based on the debugger name NAME."
   `(progn
      (defvar ,(intern (concat name "-track-mode")) nil
        ,(format "Non-nil if using %s-track-mode as a minor mode of some other 
mode.
@@ -203,8 +301,8 @@ Use the command `%s-track-mode' to toggle or set this 
variable." name name))
 ;; FIXME: The below could be a macro? I have a hard time getting
 ;; macros right.
 (defun realgud-track-mode-body(name)
-  "Used in by custom debuggers: pydbgr, trepan, gdb, etc. NAME is
-the name of the debugger which is used to preface variables."
+  "This function is used in by custom debuggers: trepan3k, remake, gdb, etc.
+NAME is the name of the debugger which is used to preface variables."
   (realgud:track-set-debugger name)
   (funcall (intern (concat "realgud-define-" name "-commands")))
   (if (intern (concat name "-track-mode"))
@@ -216,7 +314,7 @@ the name of the debugger which is used to preface 
variables."
       )))
 
 (defun realgud:track-mode-disable()
-  "Disable the debugger track-mode hook"
+  "Disable the debugger track-mode hook."
   (interactive "")
   (if realgud-track-mode
       (progn
@@ -229,7 +327,7 @@ the name of the debugger which is used to preface 
variables."
     (message "Debugger is not in track mode")))
 
 (defun realgud:track-mode-enable()
-  "Enable the debugger track-mode hook"
+  "Enable the debugger track-mode hook."
   (interactive "")
   (if realgud-track-mode
       (message "Debugger track mode is already enabled.")