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

   1 ;;; Copyright (C) 2010, 2014 Rocky Bernstein <rocky@gnu.org>
   2 (require 'comint)
   3 (require 'load-relative)
   4 (require-relative-list '("window") "realgud-")
   5 (require-relative-list '("buffer/helper") "realgud-buffer-")
   6
   7 (declare-function realgud-get-cmdbuf        'realgud-buffer-helper)
   8 (declare-function comint-goto-process-mark  'comint)
   9 (declare-function comint-send-input         'comint)
  10
  11 (defun realgud-send-command-comint (process command-str)
  12   "Assume we are in a comint buffer. Insert COMMAND-STR and
  13 send that input onto the process."
  14   (if (eq 'run (process-status process))
  15       (progn
  16         (comint-goto-process-mark)
  17         (setq comint-last-output-start
  18               (setq realgud-last-output-start (point-marker)))
  19         (insert command-str)
  20         (comint-send-input)
  21         )
  22     ;; else
  23     (message "Process %s not in `run' state; not issuing %s"
  24              process command-str)
  25     )
  26   )
  27
  28 (defalias 'comint-output-filter-orig
  29   (symbol-function 'comint-output-filter))
  30
  31 (defvar realgud-last-output-start)
  32 (defun fake-output-filter(process string)
  33   "A process output filter that saves the results into a temporary buffer."
  34   (with-current-buffer (get-buffer-create "*realgud-process-output-temp*")
  35     (goto-char (point-max))
  36     (set (make-local-variable 'realgud-last-output-start)
  37          (point-marker))
  38     (insert (concat "\n" string))
  39     (goto-char (point-max))))
  40
  41 (defun realgud-send-command-process (process command-str)
  42   "Invoke debugger COMMAND adding that command and the
  43 results into the command buffer."
  44   (fset 'comint-output-filter (symbol-function 'fake-output-filter))
  45   (apply comint-input-sender (list process command-str))
  46   (sit-for 0.25) ;; FIXME with something better
  47   (fset 'comint-output-filter (symbol-function 'comint-output-filter-orig))
  48   )
  49
  50 ;; Here are some other possibilities for functions.
  51 ;; Comint-specific: doesn't insert input into the buffer which is
  52 ;; what gud-call does.
  53 ;;   (apply comint-input-sender (list proc command))
  54 ;;
  55 ;; Works on any process-oriented buffer, not just comint.
  56 ;;   (process-send-string (get-buffer-process (current-buffer))
  57 ;;                        (concat command "\n"))
  58
  59
  60 (defun realgud-send-command (command &optional opt-send-fn opt-buffer)
  61   "Invoke the debugger COMMAND adding that command and the
  62 results into the command buffer."
  63   (let* ((cmdbuf (realgud-get-cmdbuf opt-buffer))
  64          (send-command-fn (or opt-send-fn (function realgud-send-command-comint)))
  65          )
  66     (if cmdbuf
  67         (with-current-buffer cmdbuf
  68           (let ((process (get-buffer-process cmdbuf)))
  69             (unless process
  70               (realgud-cmdbuf-info-in-debugger?= nil)
  71               (error "Command process buffer is not running")
  72               )
  73             (if (realgud-sget 'cmdbuf-info 'in-debugger?)
  74                 (funcall send-command-fn process command)
  75               (error "Command buffer doesn't think a debugger is running")
  76               )
  77             ))
  78       (error "Can't find command process buffer")
  79       )))
  80
  81 (defun realgud-send-command-invisible (command-str)
  82   (realgud-send-command command-str (function realgud-send-command-process)))
  83
  84
  85 (defun realgud-expand-format (fmt-str &optional opt-str opt-buffer)
  86   "Expands commands format characters inside FMT-STRING using values
  87 from the debugging session. OPT-STR is an optional string.
  88 Some %-escapes in the string arguments are expanded. These are:
  89
  90   %f -- Name without directory of current source file.
  91   %F -- Name without directory or extension of current source file.
  92   %x -- Name of current source file.
  93   %X -- Expanded name of current source file.
  94   %d -- Directory of current source file.
  95   %l -- Number of current source line.
  96   %p -- Numeric prefix argument converted to a string
  97         If no prefix argument %p is the null string.
  98   %c -- Fully qualified class name derived from the expression
  99         surrounding point.
 100   %s -- value of opt-str.
 101
 102 "
 103   (let* ((buffer (or opt-buffer (current-buffer)))
 104          (srcbuf (realgud-get-srcbuf buffer))
 105          (src-file-name (and srcbuf (buffer-file-name srcbuf)))
 106          result)
 107     (while (and fmt-str
 108                 (let ((case-fold-search nil))
 109                   (string-match "\\([^%]*\\)%\\([dfFlpxXs]\\)" fmt-str)))
 110       (let* ((key-str (match-string 2 fmt-str))
 111              (key (string-to-char key-str)))
 112         (setq result
 113               (concat
 114                result (match-string 1 fmt-str)
 115                (cond
 116                 ((eq key ?d)
 117                  (or (and src-file-name
 118                           (file-name-directory src-file-name))
 119                      "*source-file-not-found-for-%d"))
 120                 ((eq key ?f)
 121                  (or (and src-file-name
 122                           (file-name-nondirectory src-file-name))
 123                      "*source-file-not-found-for-%f*"))
 124                 ((eq key ?F)
 125                  (or (and src-file-name
 126                           (file-name-sans-extension
 127                            (file-name-nondirectory src-file-name)))
 128                      "*source-file-not-found-for-%F"))
 129                 ((eq key ?l)
 130                  (if srcbuf
 131                      (with-current-buffer srcbuf
 132                        (int-to-string
 133                         (save-restriction
 134                           (widen)
 135                           (+ (count-lines (point-min) (point))
 136                              (if (bolp) 1 0)))))
 137                    "source-buffer-not-found-for-%l"))
 138                 ((eq key ?x)
 139                  (or (and src-file-name src-file-name)
 140                      "*source-file-not-found-for-%x"))
 141                 ((eq key ?X)
 142                  (or (and src-file-name (expand-file-name src-file-name))
 143                      "*source-file-not-found-for-%X"))
 144                 ;; ((eq key ?e)
 145                 ;;  (gud-find-expr))
 146                 ;; ((eq key ?a)
 147                 ;;  (gud-read-address))
 148                 ;; ((eq key ?c)
 149                 ;;   (gud-find-class srcbuf))
 150                 ((eq key ?p) (if opt-str (int-to-string opt-str) ""))
 151                 ((eq key ?s) opt-str)
 152                 (t key)))))
 153       (setq fmt-str (substring fmt-str (match-end 2))))
 154     ;; There might be text left in FMT-STR when the loop ends.
 155     (concat result fmt-str)))
 156
 157 (defun realgud-command (fmt &optional arg no-record? frame-switch? realgud-prompts?)
 158   "Sends a command to the process associated with the command
 159 buffer of the current buffer. A bit of checking is done before
 160 sending the command to make sure that we can find a command
 161 buffer, and that it has a running process associated with it.
 162
 163 FMT is a string which may contain format characters that are
 164 expanded. See `realgud-expand-format' for a list of the format
 165 characters and their meanings.
 166
 167 If NO-RECORD? is set, the command won't be recorded in the
 168 position history. This is often done in status and information
 169 gathering or frame setting commands and is generally *not* done
 170 in commands that continue execution.
 171
 172 If FRAME-SWITCH? is set, the fringe overlay array icon is set to
 173 indicate the depth of the frame.
 174
 175 If REALGUD-PROMPTS? is set, then then issuing the command will cause a
 176 debugger prompt.
 177 "
 178   (interactive "sCommand (may contain format chars): ")
 179   (let* ((command-str (realgud-expand-format fmt arg))
 180          (cmd-buff (realgud-get-cmdbuf))
 181          )
 182     (unless cmd-buff
 183       (error "Can't find command buffer for buffer %s" (current-buffer)))
 184
 185     ;; Display the expanded command in the message area unless the
 186     ;; current buffer is the command buffer.
 187     (unless (realgud-cmdbuf?)
 188       (message "Command: %s" command-str))
 189
 190     (with-current-buffer cmd-buff
 191       (let* ((process (get-buffer-process cmd-buff))
 192              (last-output-end (point-marker))
 193              (in-srcbuf? (realgud-sget 'cmdbuf-info 'in-srcbuf?))
 194              )
 195         (unless process
 196           (error "Can't find process for command buffer %s" cmd-buff))
 197         (unless (eq 'run (process-status process))
 198           (error "Process %s isn't running; status %s" process
 199                  (process-status process)))
 200
 201         (realgud-cmdbuf-info-no-record?= no-record?)
 202         (realgud-cmdbuf-info-frame-switch?= frame-switch?)
 203
 204         ;; Down the line we may handle prompting in a more
 205         ;; sophisticated way. But for now, we handle this by forcing
 206         ;; display of the command buffer.
 207         (if realgud-prompts? (realgud-window-cmd-undisturb-src nil 't))
 208
 209         (realgud-send-command command-str (function realgud-send-command-comint))
 210
 211         ;; Wait for the process-mark to change before changing variables
 212         ;; that effect the hook processing.
 213         (while (and (eq 'run (process-status process))
 214                     (equal last-output-end (process-mark process)))
 215           (sit-for 0))
 216
 217         ;; Reset temporary hook-processing variables to their default state.
 218         (realgud-cmdbuf-info-no-record?= nil)
 219         (realgud-cmdbuf-info-frame-switch?=  nil)
 220         ))))
 221
 222 (provide-me "realgud-")