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

   1 ;;; Copyright (C) 2010-2015 Rocky Bernstein <rocky@gnu.org>
   2 (require 'load-relative)
   3 (require-relative-list '("custom" "helper" "key" "lochist" "loc" "menu")
   4                        "realgud-")
   5 (require-relative-list '("buffer/command" "buffer/helper" "buffer/source")
   6                        "realgud-buffer-")
   7
   8 (eval-when-compile
   9   (defvar realgud:tool-bar-map) ;; Fully defined in track-mode
  10 )
  11
  12
  13 (declare-function realgud-cmdbuf?                       'realgud-buffer-command)
  14 (declare-function realgud:debugger-name-transform       'realgud-helper)
  15 (declare-function realgud-get-cmdbuf                    'realgud-buffer-helper)
  16 (declare-function realgud:loc-follow                    'realgud-loc)
  17 (declare-function realgud-loc-hist-item-at              'realgud-lochist)
  18 (declare-function realgud-cmdbuf-loc-hist               'realgud-command)
  19 (declare-function realgud-populate-debugger-menu        'realgud-menu)
  20 (declare-function realgud-populate-common-keys          'realgud-key)
  21 (declare-function realgud-populate-src-buffer-map-plain 'realgud-key)
  22 (declare-function realgud-srcbuf-info-short-key?=,      'realgud-source)
  23 (declare-function realgud-srcbuf-info-was-read-only?=   'realgud-source)
  24 (declare-function realgud-srcbuf?                       'realgud-buffer-source)
  25
  26 ;; (defvar realgud::tool-bar-map) ;; fully defined in track-mode.el
  27
  28 (defvar realgud:shortkey-mode-map
  29   (let ((map (make-sparse-keymap)))
  30     (suppress-keymap map)
  31     (realgud-populate-debugger-menu map)
  32     (realgud-populate-common-keys map)
  33     (realgud-populate-src-buffer-map-plain map)
  34     (define-key map "1"        'realgud-goto-arrow1)
  35     (define-key map "2"        'realgud-goto-arrow2)
  36     (define-key map "3"        'realgud-goto-arrow3)
  37     (define-key map "4"        'realgud:goto-loc-hist-4)
  38     (define-key map "5"        'realgud:goto-loc-hist-5)
  39     (define-key map "6"        'realgud:goto-loc-hist-6)
  40     (define-key map "7"        'realgud:goto-loc-hist-7)
  41     (define-key map "8"        'realgud:goto-loc-hist-8)
  42     (define-key map "9"        'realgud:goto-loc-hist-9)
  43     (define-key map "b"        'realgud:cmd-break)
  44     (define-key map "c"        'realgud:cmd-continue)
  45     (define-key map "e"        'realgud:cmd-eval-region)
  46     (define-key map "U"        'realgud:cmd-until)
  47
  48     ;; FIXME: these can go to a common routine
  49     (define-key map "<"        'realgud:cmd-newer-frame)
  50     (define-key map ">"        'realgud:cmd-older-frame)
  51     (define-key map "d"        'realgud:cmd-newer-frame)
  52     (define-key map "u"        'realgud:cmd-older-frame)
  53     (define-key map "l"        'realgud-recenter-arrow)
  54     (define-key map "C"        'realgud-window-cmd-undisturb-src)
  55     (define-key map "I"        'realgud:cmdbuf-info-describe)
  56     (define-key map "S"        'realgud-window-src-undisturb-cmd)
  57
  58     (define-key map "R"        'realgud:cmd-restart)
  59     (define-key map "!"        'realgud:cmd-shell)
  60     (define-key map [insert]   'realgud-short-key-mode)
  61     (define-key map [(control x)(control q)] 'realgud-short-key-mode)
  62     map)
  63   "Keymap used in `realgud-short-key-mode'.")
  64
  65 ;; Implementation note: This is the mode that does all the work, it's
  66 ;; local to the buffer that is affected.
  67 (define-minor-mode realgud-short-key-mode
  68   "Minor mode with short keys for source buffers for the `dbgr' debugger.
  69 The buffer is read-only when the minor mode is active.
  70
  71 \\{realgud:shortkey-mode-map}"
  72   :group 'realgud
  73   :global nil
  74   :init-value nil
  75   :lighter " ShortKeys"
  76   :keymap realgud:shortkey-mode-map
  77   ;; executed on activation/deactivation:
  78   (realgud-short-key-mode-setup realgud-short-key-mode))
  79
  80 (defun realgud-get-short-key-mode-map (cmdbuf)
  81   (when (realgud-cmdbuf? cmdbuf)
  82     (with-current-buffer cmdbuf
  83       (let* ((info realgud-cmdbuf-info)
  84              (debugger-name
  85               (realgud:debugger-name-transform
  86                (realgud-cmdbuf-info-debugger-name info)))
  87              (keymap-symbol
  88               (intern
  89                (replace-regexp-in-string
  90                 "\\." ""
  91                 (concat debugger-name "-short-key-mode-map"))))
  92              (keymap (eval keymap-symbol))
  93              )
  94         (cond ((keymapp keymap) keymap)
  95               ('t nil))
  96         ))
  97     ))
  98
  99 (defun realgud-short-key-mode-setup (mode-on?)
 100   "Called when entering or leaving `realgud-short-key-mode'. Variable
 101 MODE-ON? a boolean which specifies if we are going into or out of this mode."
 102   (if (realgud-srcbuf?)
 103     (let* ((cmdbuf (realgud-get-cmdbuf))
 104            (shortkey-keymap (realgud-get-short-key-mode-map cmdbuf))
 105            )
 106
 107       ;; If there's a shortkey keymap that is custom
 108       ;; for this debugger mode, use it.
 109       (when shortkey-keymap
 110         (cond
 111          (mode-on?
 112           (set (make-local-variable 'tool-bar-map) realgud:tool-bar-map)
 113           (use-local-map shortkey-keymap))
 114          ('t
 115           (kill-local-variable 'realgud:tool-bar-map)
 116           (use-local-map nil))
 117           ))
 118
 119       ;; Ensure action only is performed when the state actually is toggled.
 120       ;; or when not read-only
 121       (when (or (not buffer-read-only)
 122                 (not (eq (realgud-sget 'srcbuf-info 'short-key?) mode-on?)))
 123         ;; Save the current state, so we can determine when the
 124         ;; state is toggled in the future.
 125         (when (not (eq (realgud-sget 'srcbuf-info 'short-key?) mode-on?))
 126           (realgud-srcbuf-info-short-key?= mode-on?)
 127           (setq realgud-short-key-mode mode-on?)
 128           (if mode-on?
 129               ;; mode is being turned on.
 130               (progn
 131                 (realgud-srcbuf-info-was-read-only?= buffer-read-only)
 132
 133                 ;; If there's a shortkey keymap that is custom
 134                 ;; for this debugger mode, use it.
 135                 (if shortkey-keymap (use-local-map shortkey-keymap))
 136
 137                 (local-set-key [m-insert] 'realgud-short-key-mode)
 138                 (when realgud-srcbuf-lock (setq buffer-read-only t))
 139                 (run-mode-hooks 'realgud-short-key-mode-hook))
 140             ;; mode is being turned off: restore read-only state.
 141             (setq buffer-read-only
 142                   (realgud-sget 'srcbuf-info 'was-read-only?))))
 143     ;; (with-current-buffer-safe cmdbuf
 144     ;;   (realgud-cmdbuf-info-src-shortkey?= mode-on?)
 145     ;;   (realgud-cmdbuf-info-in-srcbuf?= mode-on?)
 146     ;;   )
 147     ))
 148     (progn
 149       (setq realgud-short-key-mode nil)
 150       (error "buffer %s does not seem to be attached to a debugger"
 151            (buffer-name)))))
 152
 153 (defun realgud-short-key-mode-off ()
 154   "Turn off `realgud-short-key-mode' in all buffers."
 155   (interactive)
 156   (save-excursion
 157       (dolist (buf (buffer-list))
 158         (set-buffer buf)
 159         (when realgud-short-key-mode
 160           (realgud-short-key-mode-setup 0)))))
 161
 162 (defun realgud-populate-src-buffer-map (map)
 163   "Bind all common keys and menu used in the dbgr src buffers.
 164 This includes the keys bound to `realgud-key-prefix' (typically C-x
 165 C-a)."
 166   (realgud-populate-src-buffer-map-plain map)
 167   (realgud-populate-common-keys map)
 168   (let ((prefix-map (make-sparse-keymap)))
 169     (realgud-populate-debugger-menu map)
 170     (realgud-populate-src-buffer-map-plain prefix-map)
 171     (define-key map realgud-key-prefix prefix-map)))
 172
 173 (defun realgud:goto-loc-hist(num)
 174   "Go to position nth from the newest position."
 175   (let ((cmdbuf (realgud-get-cmdbuf)))
 176     (if cmdbuf
 177       (let* ((loc-hist (realgud-cmdbuf-loc-hist cmdbuf))
 178             (loc (realgud-loc-hist-item-at loc-hist (- num)))
 179             (loc-marker (realgud-loc-marker loc)))
 180         (realgud:loc-follow loc-marker))
 181       ;; else
 182         (message "No command buffer associated with this buffer")
 183     )))
 184
 185
 186 (defun realgud:goto-loc-hist-4 ()
 187   "Go to position 4th from the newest position."
 188   (interactive "")
 189   (realgud:goto-loc-hist 4))
 190
 191 (defun realgud:goto-loc-hist-5 ()
 192   "Go to position 5th from the newest position."
 193   (interactive "")
 194   (realgud:goto-loc-hist 5))
 195
 196 (defun realgud:goto-loc-hist-6 ()
 197   (interactive "")
 198   (realgud:goto-loc-hist 6))
 199
 200 (defun realgud:goto-loc-hist-7 ()
 201   "Go to position 7th from the newest position."
 202   (interactive "")
 203   (realgud:goto-loc-hist 7))
 204
 205 (defun realgud:goto-loc-hist-8 ()
 206   "Go to position 8th from the newest position."
 207   (interactive "")
 208   (realgud:goto-loc-hist 8))
 209
 210 (defun realgud:goto-loc-hist-9 ()
 211   "Go to position 9th from the newest position."
 212   (interactive "")
 213   (realgud:goto-loc-hist 9))
 214
 215 (provide-me "realgud-")
 216
 217 ;;; Local variables:
 218 ;;; End: