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

   1 ;;; Copyright (C) 2013-2014 Rocky Bernstein <rocky@gnu.org>
   2 (eval-when-compile (require 'cl))
   3
   4 (require 'load-relative)
   5 (require-relative-list '("../../common/track" "../../common/lang"
   6                          "../../common/core") "realgud-")
   7 (require-relative-list '("init") "realgud:gub-")
   8
   9 (declare-function realgud-query-cmdline      'realgud-core)
  10 (declare-function realgud-suggest-invocation 'realgud-core)
  11 (declare-function realgud-lang-mode?         'realgud-lang)
  12
  13 ;; FIXME: I think the following could be generalized and moved to
  14 ;; realgud-... probably via a macro.
  15 (defvar realgud:gub-minibuffer-history nil
  16   "minibuffer history list for the command `gub'.")
  17
  18 (easy-mmode-defmap gub-minibuffer-local-map
  19   '(("\C-i" . comint-dynamic-complete-filename))
  20   "Keymap for minibuffer prompting of gud startup command."
  21   :inherit minibuffer-local-map)
  22
  23 ;; FIXME: I think this code and the keymaps and history
  24 ;; variable chould be generalized, perhaps via a macro.
  25 (defun gub-query-cmdline (&optional opt-debugger)
  26   (realgud-query-cmdline
  27    'gub-suggest-invocation
  28    gub-minibuffer-local-map
  29    'realgud:gub-minibuffer-history
  30    opt-debugger))
  31
  32 (defun gub-parse-cmd-args (orig-args)
  33   "Parse command line ARGS for the name of script to debug and its args.
  34
  35 ARGS should contain a tokenized list of the command line to run.
  36
  37 We return the a list containing
  38
  39 - the command processor (e.g. gub.sh) and it's arguments if any - a list of strings
  40 For example for the following input
  41   \'./gub.sh --gub=\"-I\" -- ./gcd.go a b\'
  42
  43 we might return:
  44    (gub (\"-gub=-I\") (./gcd.rb a b))
  45
  46 NOTE: the above should have each item listed in quotes.
  47 "
  48
  49   (let (
  50         (args orig-args)
  51         (interp-regexp ".*\\(^gub\.sh\\|tortoise\\)$")
  52
  53         ;; Things returned
  54         (gub-name "gub.sh")
  55         (gub-args '())
  56         (go-prog-and-args '())
  57         )
  58
  59     (if (not (and args))
  60         ;; Got nothing
  61         (list gub-name gub-args go-prog-and-args)
  62       ;; else
  63       ;; Strip off "gub.sh"
  64       (when (string-match interp-regexp
  65                            (file-name-nondirectory (car args)))
  66         (setq gub-name (pop args))
  67         )
  68
  69       ;; parse options
  70       (while args
  71         (let ((arg (pop args)))
  72           (cond
  73            ((string-match "^-[-]?gub=" arg)
  74             (setq gub-args (nconc gub-args (list arg))))
  75
  76            ((string-match "^-run" arg)
  77             (setq gub-args (nconc gub-args (list arg))))
  78
  79            ((string-match "^-interp=SS" arg)
  80             (setq gub-args (nconc gub-args (list arg))))
  81
  82            ((equal arg "--")) ;; Ignore
  83
  84            ;; Anything else add to gub-args
  85            ('t (setq go-prog-and-args (nconc go-prog-and-args (list arg))))
  86            ))))
  87       (list gub-name gub-args go-prog-and-args)
  88     ))
  89
  90 (defconst realgud:gub-auto-suffix-regexp
  91   "\\.go$"
  92   "Go file suffix"
  93 )
  94
  95 (defun gub-suggest-file-priority(filename)
  96   (let ((priority 2)
  97         (is-not-directory)
  98         )
  99     (if (realgud-lang-mode? filename "go")
 100         (progn
 101           (if (string-match realgud:gub-auto-suffix-regexp filename)
 102               (setq priority 5)
 103             (setq priority 7))
 104           ))
 105     priority
 106     )
 107 )
 108
 109 ;; To silence Warning: reference to free variable
 110 (defvar realgud:gub-command-name)
 111
 112 (defun gub-suggest-invocation (debugger-name)
 113   "Suggest a command invocation via `realgud-suggest-invocaton'"
 114   (realgud-suggest-invocation realgud:gub-command-name
 115                               realgud:gub-minibuffer-history
 116                               "go" "\\.go$"))
 117
 118 ;; Convert a command line as would be typed normally to run a script
 119 ;; into one that invokes an Emacs-enabled debugging session.
 120 ;; "--debugger" in inserted as the first switch.
 121
 122 (defun realgud:gub-massage-args (command-line)
 123   (let* ((new-args (list "--debugger"))
 124          (args (split-string-and-unquote command-line))
 125          (program (car args))
 126          (seen-e nil)
 127          (shift (lambda ()
 128                   (setq new-args (cons (car args) new-args))
 129                   (setq args (cdr args)))))
 130
 131     ;; Pass all switches and -e scripts through.
 132     (while (and args
 133                 (string-match "^-" (car args))
 134                 (not (equal "-" (car args)))
 135                 (not (equal "--" (car args))))
 136       (funcall shift))
 137
 138     (if (or (not args)
 139             (string-match "^-" (car args)))
 140         (error "Can't use stdin as the script to debug"))
 141     ;; This is the program name.
 142     (funcall shift)
 143
 144     (while args
 145       (funcall shift))
 146
 147     (nreverse new-args)
 148     )
 149   )
 150
 151 (defun gub-reset ()
 152   "Gub cleanup - remove debugger's internal buffers (frame,
 153 breakpoints, etc.)."
 154   (interactive)
 155   ;; (gub-breakpoint-remove-all-icons)
 156   (dolist (buffer (buffer-list))
 157     (when (string-match "\\*gub-[a-z]+\\*" (buffer-name buffer))
 158       (let ((w (get-buffer-window buffer)))
 159         (when w
 160           (delete-window w)))
 161       (kill-buffer buffer))))
 162
 163 ;; (defun gub-reset-keymaps()
 164 ;;   "This unbinds the special debugger keys of the source buffers."
 165 ;;   (interactive)
 166 ;;   (setcdr (assq 'gub-debugger-support-minor-mode minor-mode-map-alist)
 167 ;;        gub-debugger-support-minor-mode-map-when-deactive))
 168
 169
 170 (defun realgud:gub-customize ()
 171   "Use `customize' to edit the settings of the `gub' debugger."
 172   (interactive)
 173   (customize-group 'realgud:gub))
 174
 175 (provide-me "realgud:gub-")