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

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