code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/debugger/jdb/core.el

   1 ;;; Copyright (C) 2014 Rocky Bernstein <rocky@gnu.org>
   2 (eval-when-compile (require 'cl))
   3
   4 ;; We use gud to handle the classpath-to-filename mapping
   5 (require 'gud)
   6 (require 'compile) ;; for compilation-find-file
   7
   8 (require 'load-relative)
   9 (require-relative-list '("../../common/track"
  10                          "../../common/core"
  11                          "../../common/file"
  12                          "../../common/lang")
  13                        "realgud-")
  14 (require-relative-list '("init") "realgud:jdb-")
  15
  16 (declare-function gud-find-source            'gud)
  17
  18 (declare-function realgud:strip              'realgud)
  19 (declare-function realgud:expand-file-name-if-exists 'realgud-core)
  20 (declare-function realgud-parse-command-arg  'realgud-core)
  21 (declare-function realgud-query-cmdline      'realgud-core)
  22 (declare-function realgud-suggest-invocation 'realgud-core)
  23 (declare-function realgud:file-loc-from-line 'realgud-file)
  24
  25 ;; FIXME: I think the following could be generalized and moved to
  26 ;; realgud-... probably via a macro.
  27 (defvar realgud:jdb-minibuffer-history nil
  28   "minibuffer history list for the command `realgud:jdb'.")
  29
  30 (easy-mmode-defmap jdb-minibuffer-local-map
  31   '(("\C-i" . comint-dynamic-complete-filename))
  32   "Keymap for minibuffer prompting of gud startup command."
  33   :inherit minibuffer-local-map)
  34
  35 ;; FIXME: I think this code and the keymaps and history
  36 ;; variable chould be generalized, perhaps via a macro.
  37 (defun realgud:jdb-query-cmdline (&optional opt-debugger)
  38   (realgud-query-cmdline
  39    'jdb-suggest-invocation
  40    jdb-minibuffer-local-map
  41    'realgud:jdb-minibuffer-history
  42    opt-debugger))
  43
  44 (defun realgud:jdb-dot-to-slash (str)
  45   "Change '.' to '/' in STR but chop off from the last . to the end. For example
  46 ca.mgcill.rocky.snpEff.main => ca/mcgill/rocky/snpEff"
  47       ;;(setq str (replace-regexp-in-string "\\([^\\.]+\\.\\)[^\\.]+$" "\\1" str))
  48       ;;(setq str (replace-regexp-in-string "\\.$" "" str))
  49       (setq str (replace-regexp-in-string "\\." "/" str))
  50       str)
  51
  52 (defvar realgud:jdb-file-remap (make-hash-table :test 'equal)
  53   "How to remap Java files in jdb when we otherwise can't find in
  54   the filesystem. The hash key is the file string we saw, and the
  55   value is associated filesystem string presumably in the
  56   filesystem")
  57
  58 (defun realgud:jdb-find-file(filename)
  59   "A find-file specific for java/jdb. We use `gdb-jdb-find-source' to map a
  60 name to a filename. Failing that we can add on .java to the name. Failing that
  61 we will prompt for a mapping and save that in `realgud:jdb-file-remap' when
  62 that works."
  63   (let* ((transformed-file)
  64          (stripped-filename (realgud:strip filename))
  65          (gud-jdb-filename (gud-jdb-find-source stripped-filename))
  66         )
  67     (cond
  68      ((and gud-jdb-filename (file-exists-p gud-jdb-filename))
  69       gud-jdb-filename)
  70      ((file-exists-p (setq transformed-file (concat stripped-filename ".java")))
  71       transformed-file)
  72      ('t
  73       (if (gethash stripped-filename realgud:jdb-file-remap)
  74           (let ((remapped-filename))
  75             (setq remapped-filename (gethash stripped-filename realgud:jdb-file-remap))
  76             (if (file-exists-p remapped-filename)
  77                 remapped-filename
  78               ;; else
  79               (and (remhash filename realgud-file-remap) nil)))
  80         ;; else
  81         (let ((remapped-filename)
  82               (guess-filename (realgud:jdb-dot-to-slash filename)))
  83           (setq remapped-filename
  84                 (buffer-file-name
  85                  (compilation-find-file (point-marker) guess-filename
  86                                         nil "%s.java")))
  87           (when (and remapped-filename (file-exists-p remapped-filename))
  88             (puthash stripped-filename remapped-filename realgud:jdb-file-remap)
  89             remapped-filename
  90             ))
  91         ))
  92      ))
  93   )
  94
  95 (defun realgud:jdb-loc-fn-callback(text filename lineno source-str
  96                                         ignore-file-re cmd-mark)
  97   (realgud:file-loc-from-line filename lineno
  98                               cmd-mark source-str nil
  99                               ignore-file-re 'realgud:jdb-find-file))
 100
 101 (defun realgud:jdb-parse-cmd-args (orig-args)
 102   "Parse command line ARGS for the annotate level and name of script to debug.
 103
 104 ORIG-ARGS should contain a tokenized list of the command line to run.
 105
 106 We return the a list containing
 107
 108 * the command debugger (e.g. jdb)
 109
 110 * debugger command rguments if any - a list of strings
 111
 112 * the script name and its arguments - list of strings
 113
 114 For example for the following input
 115    '(\"jdb\" \"-classpath . ./TestMe.java a b\"))
 116
 117 we might return:
 118    (\"jdb\" nil \"TestMe\"))
 119
 120 Note that the script name path has been expanded via `expand-file-name'.
 121 "
 122
 123   ;; Parse the following kind of pattern:
 124   ;;  [ruby ruby-options] jdb jdb-options script-name script-options
 125   (let (
 126         (args orig-args)
 127         (interp-regexp
 128          (if (member system-type (list 'windows-nt 'cygwin 'msdos))
 129              "^jdb*\\(.exe\\)?$"
 130            "^jdb*$"))
 131         (jdb-name)
 132         ;;
 133         ;; One dash is added automatically to the below, so
 134         ;; attach is really -attach
 135         (jdb-two-args '("attach" "sourcepath" "classpath" "dbgtrace"))
 136
 137         ;; Things returned
 138         (debugger-args '())
 139         (program-args '()))
 140
 141     (if (not (and args))
 142         ;; Got nothing: return '(nil nil nil)
 143         (list jdb-name nil debugger-args program-args)
 144       ;; else
 145       ;; Strip off optional "jdb" or "jdb.exe" etc.
 146       (when (string-match interp-regexp (car args))
 147         (setq jdb-name (car args))
 148         (setq program-args (nconc program-args (cdr args))))
 149
 150       (list jdb-name debugger-args program-args))))
 151
 152 ;; To silence Warning: reference to free variable
 153 (defvar realgud:jdb-command-name)
 154
 155 (defun jdb-suggest-invocation (debugger-name)
 156   "Suggest a jdb command invocation via `realgud-suggest-invocaton'"
 157   (realgud-suggest-invocation realgud:jdb-command-name
 158                               realgud:jdb-minibuffer-history
 159                               "java" "\\.java$" "jdb"))
 160
 161 (defun jdb-reset ()
 162   "Jdb cleanup - remove debugger's internal buffers (frame,
 163 breakpoints, etc.)."
 164   (interactive)
 165   ;; (jdb-breakpoint-remove-all-icons)
 166   (dolist (buffer (buffer-list))
 167     (when (string-match "\\*jdb-[a-z]+\\*" (buffer-name buffer))
 168       (let ((w (get-buffer-window buffer)))
 169         (when w
 170           (delete-window w)))
 171       (kill-buffer buffer))))
 172
 173 ;; (defun jdb-reset-keymaps()
 174 ;;   "This unbinds the special debugger keys of the source buffers."
 175 ;;   (interactive)
 176 ;;   (setcdr (assq 'jdb-debugger-support-minor-mode minor-mode-map-alist)
 177 ;;        jdb-debugger-support-minor-mode-map-when-deactive))
 178
 179
 180 (defun realgud:jdb-customize ()
 181   "Use `customize' to edit the settings of the `jdb' debugger."
 182   (interactive)
 183   (customize-group 'realgud:jdb))
 184
 185 (provide-me "realgud:jdb-")