code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/common/track-mode.el

   1 ;;; Copyright (C) 2010-2015 Rocky Bernstein <rocky@gnu.org>
   2 ;;; tracks shell output
   3
   4 (eval-when-compile (require 'cl))
   5 (require 'shell)
   6
   7 (require 'load-relative)
   8 (require-relative-list
   9  '("core"   "helper" "track" "loc" "lochist" "file"
  10    "fringe" "window" "regexp" "menu" "backtrace-mode"
  11    "send"   "shortkey") "realgud-")
  12
  13 (require-relative-list  '("buffer/command") "realgud-buffer-")
  14
  15 ;; FIXME figure out if I can put this in something like a header file.
  16 (declare-function realgud-fringe-erase-history-arrows 'realgud-buffer-command)
  17 (declare-function realgud:track-set-debugger          'realgud-track)
  18 (declare-function realgud-populate-debugger-menu      'realgud-menu)
  19 (declare-function realgud-cmdbuf-info-divert-output?=
  20                   'realgud-buffer-command)
  21 (declare-function realgud-cmdbuf-info-prior-prompt-regexp=
  22                   'realgud-buffer-command)
  23 (declare-function realgud-cmdbuf-info-set?
  24                   'realgud-buffer-command)
  25
  26
  27 (defvar realgud-track-mode-map
  28   (let ((map  (copy-keymap shell-mode-map)))
  29     (realgud-populate-debugger-menu map)
  30     (define-key map [M-right]   'realgud-track-hist-newest)
  31     (define-key map [M-down]    'realgud-track-hist-newer)
  32     (define-key map [M-up]      'realgud-track-hist-older)
  33     (define-key map [M-print]   'realgud-track-hist-older)
  34     (define-key map [M-S-down]  'realgud-track-hist-newest)
  35     (define-key map [M-S-up]    'realgud-track-hist-oldest)
  36     (define-key map "\C-cS" 'realgud-window-src-undisturb-cmd)
  37     map)
  38   "Keymap used in `realgud-track-minor-mode'.")
  39
  40 (defvar realgud:tool-bar-map
  41   (let ((map (make-sparse-keymap)))
  42     (dolist (x '((realgud:cmd-break . "gud/break")
  43                  ;; (realgud:cmd-remove . "gud/remove")
  44                  ;; (realgud:cmd-print . "gud/print")
  45                  ;; (realgud:cmd-pstar . "gud/pstar")
  46                  ;; (realgud:cmd-pp . "gud/pp")
  47                  ;; (realgud:cmd-watch . "gud/watch")
  48                  (realgud:cmd-restart . "gud/run")
  49                  ;; (realgud:cmd-go . "gud/go")
  50                  ;; (realgud:cmd-stop-subjob . "gud/stop")
  51                  (realgud:cmd-continue . "gud/cont")
  52                  (realgud:cmd-until . "gud/until")
  53                  (realgud:cmd-next . "gud/next")
  54                  (realgud:cmd-step . "gud/step")
  55                  (realgud:cmd-finish . "gud/finish")
  56                  ;; (realgud:cmd-nexti . "gud/nexti")
  57                  ;; (realgud:cmd-stepi . "gud/stepi")
  58                  (realgud:cmd-older-frame . "gud/up")
  59                  (realgud:cmd-newer-frame . "gud/down")
  60                  (realgud:cmdbuf-info-describe . "info"))
  61                map)
  62       (tool-bar-local-item-from-menu
  63        (car x) (cdr x) map realgud-track-mode-map)))
  64   "toolbar use when `realgud' interface is active"
  65   )
  66
  67 (define-minor-mode realgud-track-mode
  68   "Minor mode for tracking debugging inside a process shell."
  69   :init-value nil
  70   :global nil
  71   :group 'realgud
  72
  73   :lighter
  74   (:eval (progn
  75            (concat " "
  76                    (if (realgud-cmdbuf-info-set?)
  77                        (realgud-sget 'cmdbuf-info 'debugger-name)
  78                      "dbgr??"))))
  79
  80   :keymap realgud-track-mode-map
  81   ;; Setup/teardown
  82   (realgud-track-mode-setup realgud-track-mode)
  83   )
  84
  85 ;; FIXME: this should have been picked up by require'ing track.
  86 (defvar realgud-track-divert-string)
  87
  88 (defun realgud-track-mode-setup (mode-on?)
  89   "Called when entering or leaving `realgud-track-mode'. Variable
  90 MODE-ON is a boolean which specifies if we are going into or out
  91 of this mode."
  92   (if mode-on?
  93       (let ((process (get-buffer-process (current-buffer))))
  94         (unless process
  95           (setq realgud-track-mode nil)
  96           (error "Can't find a process for buffer %s" (current-buffer)))
  97
  98         (setq realgud-track-divert-string "")
  99         (setq realgud-track-mode 't)
 100
 101         ;; FIXME: save and chain process-sentinel via
 102         ;; (process-sentinel (get-buffer-process (current-buffer)))
 103         (set-process-sentinel process 'realgud-term-sentinel)
 104         (unless (and (realgud-cmdbuf-info-set?)
 105                      (realgud-sget 'cmdbuf-info 'debugger-name))
 106           (call-interactively 'realgud:track-set-debugger))
 107         (if (boundp 'comint-last-output-start)
 108             (progn
 109               (realgud-cmdbuf-info-prior-prompt-regexp= comint-prompt-regexp)
 110               (realgud-cmdbuf-info-divert-output?= nil)
 111               (let* ((regexp-hash
 112                       (and (realgud-cmdbuf-info? realgud-cmdbuf-info)
 113                            (realgud-sget 'cmdbuf-info 'regexp-hash)))
 114                      (prompt-pat (and regexp-hash
 115                                       (gethash "prompt" regexp-hash))))
 116                 (if prompt-pat
 117                     (setq comint-prompt-regexp
 118                             (realgud-loc-pat-regexp prompt-pat)))))
 119           (set-marker comint-last-output-start (point)))
 120
 121         (set (make-local-variable 'tool-bar-map) realgud:tool-bar-map)
 122         (add-hook 'comint-output-filter-functions
 123                   'realgud-track-comint-output-filter-hook)
 124         (add-hook 'eshell-output-filter-functions
 125                   'realgud-track-eshell-output-filter-hook)
 126         (run-mode-hooks 'realgud-track-mode-hook))
 127   ;; else
 128     (progn
 129       (if (and (boundp 'comint-last-output-start) realgud-cmdbuf-info)
 130         (setq comint-prompt-regexp
 131            (realgud-sget 'cmdbuf-info 'prior-prompt-regexp))
 132         )
 133       (kill-local-variable 'realgud:tool-bar-map)
 134       (realgud-fringe-erase-history-arrows)
 135       (remove-hook 'comint-output-filter-functions
 136                    'realgud-track-comint-output-filter-hook)
 137       (remove-hook 'eshell-output-filter-functions
 138                     'realgud-track-eshell-output-filter-hook)
 139       (let* ((cmd-process (get-buffer-process (current-buffer)))
 140              (status (if cmd-process
 141                          (list (propertize (format ":%s"
 142                                                    (process-status cmd-process))
 143                             'face 'debugger-running))
 144                        ""))
 145              )
 146         (setq mode-line-process status)
 147         ;; Force mode line redisplay soon.
 148         (force-mode-line-update)
 149         ;; FIXME: This is a workaround. Without this, we comint doesn't
 150         ;; process commands
 151         (unless (member 'comint-mode minor-mode-list) (comint-mode))
 152         )
 153
 154       ;; FIXME: restore/unchain old process sentinels.
 155       )
 156     )
 157   )
 158
 159 ;; For name == "trepan", produces:
 160 ;;   (defvar trepan-track-mode nil
 161 ;;     "Non-nil if using trepan track-mode ... "
 162 ;;   (defvar trepan-track-mode-map (make-sparse-keymap))
 163 ;;   (defvar trepan-short-key-mode-map (make-sparse-keymap))
 164 ;;   (set-keymap-parent trepan-short-key-mode-map realgud-short-key-mode-map)
 165 (defmacro realgud-track-mode-vars (name)
 166   `(progn
 167      (defvar ,(intern (concat name "-track-mode")) nil
 168         ,(format "Non-nil if using %s-track-mode as a minor mode of some other mode.
 169 Use the command `%s-track-mode' to toggle or set this variable." name name))
 170      (defvar ,(intern (concat name "-track-mode-map")) (make-sparse-keymap)
 171        ,(format "Keymap used in `%s-track-mode'." name))
 172      (defvar ,(intern (concat name "-short-key-mode-map")) (make-sparse-keymap))
 173     ))
 174
 175 ;; FIXME: The below could be a macro? I have a hard time getting
 176 ;; macros right.
 177 (defun realgud-track-mode-body(name)
 178   "Used in by custom debuggers: pydbgr, trepan, gdb, etc. NAME is
 179 the name of the debugger which is used to preface variables."
 180   (realgud:track-set-debugger name)
 181   (funcall (intern (concat "realgud-define-" name "-commands")))
 182   (if (intern (concat name "-track-mode"))
 183       (progn
 184         (setq realgud-track-mode 't)
 185         (run-mode-hooks (intern (concat name "-track-mode-hook"))))
 186     (progn
 187       (setq realgud-track-mode nil)
 188       )))
 189
 190 (defun realgud:track-mode-disable()
 191   "Disable the debugger track-mode hook"
 192   (interactive "")
 193   (if realgud-track-mode
 194       (setq realgud-track-mode nil)
 195     (message "Debugger is not in track mode")))
 196
 197 (defun realgud:track-mode-enable()
 198   "Enable the debugger track-mode hook"
 199   (interactive "")
 200   (if realgud-track-mode
 201       (message "Debugger track mode is already enabled.")
 202     (setq realgud-track-mode t))
 203   )
 204
 205 (provide-me "realgud-")