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

   1 ;;; Copyright (C) 2012-2014 Rocky Bernstein <rocky@gnu.org>
   2 (eval-when-compile (require 'cl))
   3
   4 (require 'load-relative)
   5 (require-relative-list '("../../common/track"
   6                          "../../common/core"
   7                          "../../common/lang")
   8                        "realgud-")
   9 (require-relative-list '("init") "realgud:pdb-")
  10
  11
  12 (declare-function realgud-lang-mode? 'realgud-lang)
  13 (declare-function realgud-parse-command-arg 'realgud-core)
  14 (declare-function realgud-query-cmdline 'realgud-core)
  15 (declare-function realgud-suggest-invocation 'realgud-core)
  16
  17 ;; FIXME: I think the following could be generalized and moved to
  18 ;; realgud-... probably via a macro.
  19 (defvar realgud:pdb-minibuffer-history nil
  20   "minibuffer history list for the command `pdb'.")
  21
  22 (easy-mmode-defmap pdb-minibuffer-local-map
  23   '(("\C-i" . comint-dynamic-complete-filename))
  24   "Keymap for minibuffer prompting of gud startup command."
  25   :inherit minibuffer-local-map)
  26
  27 ;; FIXME: I think this code and the keymaps and history
  28 ;; variable chould be generalized, perhaps via a macro.
  29 (defun pdb-query-cmdline (&optional opt-debugger)
  30   (realgud-query-cmdline
  31    'pdb-suggest-invocation
  32    pdb-minibuffer-local-map
  33    'realgud:pdb-minibuffer-history
  34    opt-debugger))
  35
  36 (defun pdb-parse-cmd-args (orig-args)
  37   "Parse command line ORIG-ARGS for the annotate level and name of script to debug.
  38
  39 ORIG-ARGS should contain a tokenized list of the command line to run.
  40
  41 We return the a list containing:
  42 * the command processor (e.g. python) and it's arguments if any - a list of strings
  43 * the name of the debugger given (e.g. pdb) and its arguments - a list of strings
  44 * the script name and its arguments - list of strings
  45 * whether the annotate or emacs option was given ('-A', '--annotate' or '--emacs) - a boolean
  46
  47 For example for the following input:
  48   (map 'list 'symbol-name
  49    '(python2.6 -O -Qold ./gcd.py a b))
  50
  51 we might return:
  52    ((\"python2.6\" \"-O\" \"-Qold\") (\"pdb\") (\"/tmp/gcd.py\" \"a\" \"b\") nil)
  53
  54 Note that the script name path has been expanded via `expand-file-name'.
  55 "
  56
  57   ;; Parse the following kind of pattern:
  58   ;;  [python python-options] pdb pdb-options script-name script-options
  59   (let (
  60         (args orig-args)
  61         (pair)          ;; temp return from
  62         (python-opt-two-args '())
  63         ;; Python doesn't have mandatory 2-arg options in our sense,
  64         ;; since the two args can be run together, e.g. "-C/tmp" or "-C /tmp"
  65         ;;
  66         (python-two-args '())
  67         ;; pdb doesn't have any arguments
  68         (pdb-two-args '())
  69         (pdb-opt-two-args '())
  70         (interp-regexp
  71          (if (member system-type (list 'windows-nt 'cygwin 'msdos))
  72              "^python[-0-9.]*\\(.exe\\)?$"
  73            "^python[-0-9.]*$"))
  74
  75         ;; Things returned
  76         (annotate-p nil)
  77         (debugger-args '())
  78         (debugger-name nil)
  79         (interpreter-args '())
  80         (script-args '())
  81         (script-name nil)
  82         )
  83
  84     (if (not (and args))
  85         ;; Got nothing: return '(nil, nil)
  86         (list interpreter-args debugger-args script-args annotate-p)
  87       ;; else
  88       ;; Strip off optional "python" or "python182" etc.
  89       (when (string-match interp-regexp
  90                           (file-name-sans-extension
  91                            (file-name-nondirectory (car args))))
  92         (setq interpreter-args (list (pop args)))
  93
  94         ;; Strip off Python-specific options
  95         (while (and args
  96                     (string-match "^-" (car args)))
  97           (setq pair (realgud-parse-command-arg
  98                       args python-two-args python-opt-two-args))
  99           (nconc interpreter-args (car pair))
 100           (setq args (cadr pair))))
 101
 102       ;; Remove "pdb" from "pdb --pdb-options script
 103       ;; --script-options"
 104       (setq debugger-name (file-name-sans-extension
 105                            (file-name-nondirectory (car args))))
 106       (unless (string-match "^\\(pdb\\|cli.py\\)$" debugger-name)
 107         (message
 108          "Expecting debugger name `%s' to be `pdb' or `cli.py'"
 109          debugger-name))
 110       (setq debugger-args (list (pop args)))
 111
 112       ;; Skip to the first non-option argument.
 113       (while (and args (not script-name))
 114         (let ((arg (car args)))
 115           (cond
 116            ;; Options with arguments.
 117            ((string-match "^-" arg)
 118             (setq pair (realgud-parse-command-arg
 119                         args pdb-two-args pdb-opt-two-args))
 120             (nconc debugger-args (car pair))
 121             (setq args (cadr pair)))
 122            ;; Anything else must be the script to debug.
 123            (t (setq script-name (expand-file-name arg))
 124               (setq script-args (cons script-name (cdr args))))
 125            )))
 126       (list interpreter-args debugger-args script-args annotate-p))))
 127
 128 ;; To silence Warning: reference to free variable
 129 (defvar realgud:pdb-command-name)
 130
 131 (defun pdb-suggest-invocation (debugger-name)
 132   "Suggest a pdb command invocation via `realgud-suggest-invocaton'"
 133   (realgud-suggest-invocation realgud:pdb-command-name
 134                               realgud:pdb-minibuffer-history
 135                               "python" "\\.py"))
 136
 137 (defun pdb-reset ()
 138   "Pdb cleanup - remove debugger's internal buffers (frame,
 139 breakpoints, etc.)."
 140   (interactive)
 141   ;; (pdb-breakpoint-remove-all-icons)
 142   (dolist (buffer (buffer-list))
 143     (when (string-match "\\*pdb-[a-z]+\\*" (buffer-name buffer))
 144       (let ((w (get-buffer-window buffer)))
 145         (when w
 146           (delete-window w)))
 147       (kill-buffer buffer))))
 148
 149 ;; (defun pdb-reset-keymaps()
 150 ;;   "This unbinds the special debugger keys of the source buffers."
 151 ;;   (interactive)
 152 ;;   (setcdr (assq 'pdb-debugger-support-minor-mode minor-mode-map-alist)
 153 ;;        pdb-debugger-support-minor-mode-map-when-deactive))
 154
 155
 156 (defun realgud:pdb-customize ()
 157   "Use `customize' to edit the settings of the `pdb' debugger."
 158   (interactive)
 159   (customize-group 'realgud:pdb))
 160
 161 (provide-me "realgud:pdb-")