diff --git a/ChangeLog b/ChangeLog index dda62a9..f612159 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2022-03-11 John Ciolfi + + * matlab-netshell.el, matlab-shell-gud.el, matlab-shell.el, matlab.el, mlgud.el + Fix conflict between matlab-shell debugging and C++ (or other language) debugging. + - matlab-shell debugging previously leveraged gud.el for debugging of *.m files. + - C++ debugging also leverages gud.el for debugging. + - Only one instance of a gud.el debugger can be active. If you run two, say + *.m debugging and C++ debugging. Then you get odd errors such as the + ebbreak not being recognized by gdb. + To fix these issue, I copied gud.el and made a new namespace "mlgud". I also + removed a lot of unused code from mlgud.el, though there's still more that can + be removed. Now one can debug *.m files and *.cpp files in one Emacs session. + 2021-11-22 Uwe Brauer * company-matlab-shell.el: 677 correct a silly typo diff --git a/matlab-netshell.el b/matlab-netshell.el index 667197a..71c8aad 100644 --- a/matlab-netshell.el +++ b/matlab-netshell.el @@ -122,7 +122,7 @@ response from some Emacs based request." ;; Interpret the command. (cond ((string= "init" cmd) ;; Make sure GUD bindings are available, but do so in - ;; the netshell buffer so when gud bundings run, they + ;; the netshell buffer so when mlgud bundings run, they ;; don't stomp on C-c matlab-mode bindings. (with-current-buffer (process-buffer proc) (matlab-shell-mode-gud-enable-bindings)) diff --git a/matlab-shell-gud.el b/matlab-shell-gud.el index a532220..ec36aea 100644 --- a/matlab-shell-gud.el +++ b/matlab-shell-gud.el @@ -21,13 +21,13 @@ ;; ;; GUD (grand unified debugger) support for MATLAB shell. ;; -;; Includes setting up gud mode in the shell, and all filters, etc specific -;; to supporting gud. +;; Includes setting up mlgud mode in the shell, and all filters, etc specific +;; to supporting mlgud. (require 'matlab-shell) (eval-and-compile - (require 'gud) + (require 'mlgud) (require 'eieio) ) @@ -52,16 +52,16 @@ Disable this option if the tooltips are too slow in your setup." (defmacro matlab-at-fcn (cmd) "Define CMD to be a GUD command that works w/ shell or netshell." - ;; Note `arg' comes from gud-def declaration + ;; Note `arg' comes from mlgud-def declaration `(if (matlab-shell-active-p) - (gud-call (concat ,cmd "%%") arg) + (mlgud-call (concat ,cmd "%%") arg) (if (matlab-netshell-active-p) - (matlab-netshell-eval (gud-format-command ,cmd arg)) + (matlab-netshell-eval (mlgud-format-command ,cmd arg)) (error "No MATLAB shell active")))) (defmacro matlab-gud-fcn (cmd) "Define CMD forms to be sent to a MATLAB shell." - ;; Note `arg' comes from gud-def declaration + ;; Note `arg' comes from mlgud-def declaration `(if gud-matlab-debug-active (matlab-at-fcn ,cmd) (error "MATLAB debugging not active"))) @@ -70,46 +70,46 @@ Disable this option if the tooltips are too slow in your setup." (defun matlab-shell-mode-gud-enable-bindings () "Enable GUD features for `matlab-shell' in the current buffer." - ;; Make sure this is safe to use gud to debug MATLAB - (when (not (fboundp 'gud-def)) - (error "Your Emacs is missing `gud-def' which means matlab-shell won't work correctly. Stopping")) + ;; Make sure this is safe to use mlgud to debug MATLAB + (when (not (fboundp 'mlgud-def)) + (error "Your Emacs is missing `mlgud-def' which means matlab-shell won't work correctly. Stopping")) - (gud-def gud-break (matlab-at-fcn "ebstop in %d%f at %l") "\C-b" "Set breakpoint at current line.") - (gud-def gud-remove (matlab-at-fcn "ebclear in %d%f at %l") "\C-x" "Remove breakpoint at current line.") - (gud-def gud-step (matlab-gud-fcn "dbstep in") "\C-s" "Step one source line, possibly into a function.") - (gud-def gud-next (matlab-gud-fcn "dbstep %p") "\C-n" "Step over one source line.") - (gud-def gud-cont (matlab-gud-fcn "dbcont") "\C-r" "Continue with display.") - (gud-def gud-stop-subjob (matlab-gud-fcn "dbquit") "\C-q" "Quit debugging.") ;; gud toolbar stop - (gud-def gud-finish (matlab-gud-fcn "dbstep out") "\C-f" "Finish executing current function.") - (gud-def gud-up (matlab-gud-fcn "dbup") "<" "Up N stack frames (numeric arg).") - (gud-def gud-down (matlab-gud-fcn "dbdown") ">" "Down N stack frames (numeric arg).") - (gud-def gud-list-breakpoints (matlab-at-fcn "ebstatus") "\C-v" "List breakpoints") - (gud-def gud-show-stack (matlab-at-fcn "ebstack") "\C-w" "Show stack") - ;; using (gud-def gud-print "%e" "\C-p" "Eval expression at point") fails - ;; (gud-def gud-print "% gud-print not available" "\C-p" "gud-print not available.") + (mlgud-def mlgud-break (matlab-at-fcn "ebstop in %d%f at %l") "Set breakpoint at current line.") + (mlgud-def mlgud-remove (matlab-at-fcn "ebclear in %d%f at %l") "Remove breakpoint at current line.") + (mlgud-def mlgud-step (matlab-gud-fcn "dbstep in") "Step one source line, possibly into a function.") + (mlgud-def mlgud-next (matlab-gud-fcn "dbstep %p") "Step over one source line.") + (mlgud-def mlgud-cont (matlab-gud-fcn "dbcont") "Continue execution.") + (mlgud-def mlgud-stop-subjob (matlab-gud-fcn "dbquit") "Quit debugging.") ;; mlgud toolbar stop + (mlgud-def mlgud-finish (matlab-gud-fcn "dbstep out") "Finish executing current function.") + (mlgud-def mlgud-up (matlab-gud-fcn "dbup") "Up N stack frames (numeric arg).") + (mlgud-def mlgud-down (matlab-gud-fcn "dbdown") "Down N stack frames (numeric arg).") + (mlgud-def mlgud-list-breakpoints (matlab-at-fcn "ebstatus") "List breakpoints") + (mlgud-def mlgud-show-stack (matlab-at-fcn "ebstack") "Show stack") + ;; using (mlgud-def mlgud-print "%e" "\C-p" "Eval expression at point") fails + ;; (mlgud-def mlgud-print "% mlgud-print not available" "\C-p" "mlgud-print not available.") (when window-system (setq gud-matlab-tool-bar-map - (let ((map (make-sparse-keymap))) - (dolist (x '((gud-break . "gud/break") - (gud-remove . "gud/remove") - (gud-cont . "gud/cont") - (gud-next . "gud/next") - (gud-step . "gud/step") - (gud-finish . "gud/finish") - (gud-stop-subjob . "gud/stop") - (mlg-show-stack . "gud/all") - (gud-list-breakpoints . "describe") - )) - (tool-bar-local-item-from-menu - (car x) (cdr x) map matlab-mode-map)) - map)) + (let ((map (make-sparse-keymap))) + (dolist (x '((mlgud-break . "gud/break") + (mlgud-remove . "gud/remove") + (mlgud-cont . "gud/cont") + (mlgud-next . "gud/next") + (mlgud-step . "gud/step") + (mlgud-finish . "gud/finish") + (mlgud-stop-subjob . "gud/stop") + (mlg-show-stack . "gud/all") + (mlgud-list-breakpoints . "describe") + )) + (tool-bar-local-item-from-menu + (car x) (cdr x) map matlab-mode-map)) + map)) ) - - (if (fboundp 'gud-make-debug-menu) - (gud-make-debug-menu)) + + (if (fboundp 'mlgud-make-debug-menu) + (mlgud-make-debug-menu)) (when (boundp 'tool-bar-map) ; not --without-x (kill-local-variable 'tool-bar-map)) @@ -118,27 +118,25 @@ Disable this option if the tooltips are too slow in your setup." ;;;###autoload (defun matlab-shell-gud-startup () "Configure GUD when a new `matlab-shell' is initialized." - (gud-mode) + (mlgud-mode) - ;; type of gud mode - (setq gud-minor-mode 'matlab) - - ;; This starts us supporting gud tooltips. - (add-to-list 'gud-tooltip-modes 'matlab-mode) - - (make-local-variable 'gud-marker-filter) - (setq gud-marker-filter 'gud-matlab-marker-filter) - (make-local-variable 'gud-find-file) - (setq gud-find-file 'gud-matlab-find-file) + ;; type of mlgud mode + (setq mlgud-minor-mode 'matlab) - ;; XEmacs doesn't seem to have this concept already. Oh well. - (make-local-variable 'gud-marker-acc) - (setq gud-marker-acc nil) + ;; This starts us supporting mlgud tooltips. + (add-to-list 'mlgud-tooltip-modes 'matlab-mode) + + (make-local-variable 'mlgud-marker-filter) + (setq mlgud-marker-filter 'gud-matlab-marker-filter) + (make-local-variable 'mlgud-find-file) + (setq mlgud-find-file 'gud-matlab-find-file) + + (global-matlab-shell-inactive-gud-minor-mode 1) ;; Setup our debug tracker. (add-hook 'matlab-shell-prompt-appears-hook #'gud-matlab-debug-tracker) - - (gud-set-buffer)) + + (mlgud-set-buffer)) ;;; GUD Functions (defun gud-matlab-massage-args (file args) @@ -151,14 +149,14 @@ FILE is ignored, and ARGS is returned." "Find file F when debugging frames in MATLAB." (save-excursion (let* ((realfname (if (string-match "\\.\\(p\\)$" f) - (progn - (aset f (match-beginning 1) ?m) - f) - f)) - (buf (find-file-noselect realfname t))) + (progn + (aset f (match-beginning 1) ?m) + f) + f)) + (buf (find-file-noselect realfname t))) (set-buffer buf) - (if (fboundp 'gud-make-debug-menu) - (gud-make-debug-menu)) + (if (fboundp 'mlgud-make-debug-menu) + (mlgud-make-debug-menu)) buf))) @@ -167,6 +165,10 @@ FILE is ignored, and ARGS is returned." ;; MATLAB's process filter handles output from the MATLAB process and ;; interprets it for formatting text, and for running the debugger. + +(defvar matlab-shell-gud--marker-acc "") +(make-variable-buffer-local 'matlab-shell-gud--marker-acc) + (defvar gud-matlab-marker-regexp-plain-prompt "^K?>>" "Regular expression for finding a prompt.") @@ -182,90 +184,90 @@ FILE is ignored, and ARGS is returned." (defun gud-matlab-marker-filter (string) "Filters STRING for the Unified Debugger based on MATLAB output." - (setq gud-marker-acc (concat gud-marker-acc string)) + (setq matlab-shell-gud--marker-acc (concat matlab-shell-gud--marker-acc string)) (let ((output "") (frame nil)) ;; ERROR DELIMITERS ;; Newer MATLAB's wrap error text in {^H }^H characters. ;; Convert into something COMINT won't delete so we can scan them. - (while (string-match "{" gud-marker-acc) - (setq gud-marker-acc (replace-match matlab-shell-errortext-start-text t t gud-marker-acc 0))) + (while (string-match "{" matlab-shell-gud--marker-acc) + (setq matlab-shell-gud--marker-acc (replace-match matlab-shell-errortext-start-text t t matlab-shell-gud--marker-acc 0))) + + (while (string-match "}" matlab-shell-gud--marker-acc) + (setq matlab-shell-gud--marker-acc (replace-match matlab-shell-errortext-end-text t t matlab-shell-gud--marker-acc 0))) - (while (string-match "}" gud-marker-acc) - (setq gud-marker-acc (replace-match matlab-shell-errortext-end-text t t gud-marker-acc 0))) - ;; DEBUG PROMPTS - (when (string-match gud-matlab-marker-regexp-K>> gud-marker-acc) + (when (string-match gud-matlab-marker-regexp-K>> matlab-shell-gud--marker-acc) ;; Newer MATLAB's don't print useful info. We'll have to ;; search backward for the previous line to see if a frame was ;; displayed. (when (and (not frame) (not gud-matlab-dbhotlink)) - (let ((dbhlcmd (if matlab-shell-echoes - "dbhotlink()%%%\n" - ;; If no echo, force an echo - "disp(['dbhotlink()%%%' newline]);dbhotlink();\n"))) - ;;(when matlab-shell-io-testing (message "!!> [%s]" dbhlcmd)) - (process-send-string (get-buffer-process gud-comint-buffer) dbhlcmd) - ) - (setq gud-matlab-dbhotlink t) - ) + (let ((dbhlcmd (if matlab-shell-echoes + "dbhotlink()%%%\n" + ;; If no echo, force an echo + "disp(['dbhotlink()%%%' newline]);dbhotlink();\n"))) + ;;(when matlab-shell-io-testing (message "!!> [%s]" dbhlcmd)) + (process-send-string (get-buffer-process mlgud-comint-buffer) dbhlcmd) + ) + (setq gud-matlab-dbhotlink t) + ) ) ;; If we're forced to ask for a stack hotlink, we will see it come in via the ;; process output. Don't output anything until a K prompt is seen after the display ;; of the dbhotlink command. (when gud-matlab-dbhotlink - (let ((start (string-match "dbhotlink()%%%" gud-marker-acc)) - (endprompt nil)) - (if start - (progn - (setq output (substring gud-marker-acc 0 start) - gud-marker-acc (substring gud-marker-acc start)) + (let ((start (string-match "dbhotlink()%%%" matlab-shell-gud--marker-acc)) + (endprompt nil)) + (if start + (progn + (setq output (substring matlab-shell-gud--marker-acc 0 start) + matlab-shell-gud--marker-acc (substring matlab-shell-gud--marker-acc start)) - ;; The hotlink text will persist until we see the K prompt. - (when (string-match gud-matlab-marker-regexp-plain-prompt gud-marker-acc) - (setq endprompt (match-end 0)) + ;; The hotlink text will persist until we see the K prompt. + (when (string-match gud-matlab-marker-regexp-plain-prompt matlab-shell-gud--marker-acc) + (setq endprompt (match-end 0)) - ;; (when matlab-shell-io-testing (message "!!xx [%s]" (substring gud-marker-acc 0 endprompt))) + ;; (when matlab-shell-io-testing (message "!!xx [%s]" (substring matlab-shell-gud--marker-acc 0 endprompt))) - ;; We're done with the text! - ;; Capture the text that describes the new stack frame. - (save-match-data - (let* ((expr-end (match-beginning 0)) - (m1 (string-match "dbhotlink()%%%\n" gud-marker-acc)) - (expr-start (match-end 0)) - (expression (substring gud-marker-acc expr-start expr-end))) + ;; We're done with the text! + ;; Capture the text that describes the new stack frame. + (save-match-data + (let* ((expr-end (match-beginning 0)) + (m1 (string-match "dbhotlink()%%%\n" matlab-shell-gud--marker-acc)) + (expr-start (match-end 0)) + (expression (substring matlab-shell-gud--marker-acc expr-start expr-end))) - (when (> (length expression) 0) - (condition-case ERR - (let ((forms (read expression))) - (when forms - ;;(message "About to evaluate forms: \"%S\"" forms) - (eval forms))) - (error - (message "Failed to evaluate dbhotlink expression: \"%s\"" expression) - (message "Error is: %S" ERR) - ) - )) - )) + (when (> (length expression) 0) + (condition-case ERR + (let ((forms (read expression))) + (when forms + ;;(message "About to evaluate forms: \"%S\"" forms) + (eval forms))) + (error + (message "Failed to evaluate dbhotlink expression: \"%s\"" expression) + (message "Error is: %S" ERR) + ) + )) + )) + + ;;Remove it from the accumulator. + (setq matlab-shell-gud--marker-acc (substring matlab-shell-gud--marker-acc endprompt)) + ;; If we got all this at the same time, push output back onto the accumulator for + ;; the next code bit to push it out. + (setq matlab-shell-gud--marker-acc (concat output matlab-shell-gud--marker-acc) + output "" + gud-matlab-dbhotlink nil) + )) + ;; Else, waiting for a link, but hasn't shown up yet. + ;; TODO - what can I do here to fix var setting if it gets + ;; locked? + (when (string-match gud-matlab-marker-regexp->> matlab-shell-gud--marker-acc) + ;; A non-k prompt showed up. We're not going to get out request. + (setq gud-matlab-dbhotlink nil)) + ))) - ;;Remove it from the accumulator. - (setq gud-marker-acc (substring gud-marker-acc endprompt)) - ;; If we got all this at the same time, push output back onto the accumulator for - ;; the next code bit to push it out. - (setq gud-marker-acc (concat output gud-marker-acc) - output "" - gud-matlab-dbhotlink nil) - )) - ;; Else, waiting for a link, but hasn't shown up yet. - ;; TODO - what can I do here to fix var setting if it gets - ;; locked? - (when (string-match gud-matlab-marker-regexp->> gud-marker-acc) - ;; A non-k prompt showed up. We're not going to get out request. - (setq gud-matlab-dbhotlink nil)) - ))) - ;; This if makes sure that the entirety of an error output is brought in ;; so that matlab-shell-mode doesn't try to display a file that only partially ;; exists in the buffer. Thus, if MATLAB output: @@ -275,91 +277,91 @@ FILE is ignored, and ARGS is returned." ;; The below used to match against the prompt, not \n, but then text that ;; had error: in it for some other reason wouldn't display at all. (if (and matlab-prompt-seen ;; don't pause output if prompt not seen - gud-matlab-dbhotlink ;; pause output if waiting on debugger - ) - ;; We could be collecting debug info. Wait before output. - nil + gud-matlab-dbhotlink ;; pause output if waiting on debugger + ) + ;; We could be collecting debug info. Wait before output. + nil ;; Finish off this part of the output. None of our special stuff ;; ends with a \n, so display those as they show up... - (while (string-match "^[^\n]*\n" gud-marker-acc) - (setq output (concat output (substring gud-marker-acc 0 (match-end 0))) - gud-marker-acc (substring gud-marker-acc (match-end 0)))) + (while (string-match "^[^\n]*\n" matlab-shell-gud--marker-acc) + (setq output (concat output (substring matlab-shell-gud--marker-acc 0 (match-end 0))) + matlab-shell-gud--marker-acc (substring matlab-shell-gud--marker-acc (match-end 0)))) + + (if (string-match (concat gud-matlab-marker-regexp-plain-prompt "\\s-*$") matlab-shell-gud--marker-acc) + (setq output (concat output matlab-shell-gud--marker-acc) + matlab-shell-gud--marker-acc "")) - (if (string-match (concat gud-matlab-marker-regexp-plain-prompt "\\s-*$") gud-marker-acc) - (setq output (concat output gud-marker-acc) - gud-marker-acc "")) - ;; Check our output for a prompt, and existence of a frame. ;; If this is true, throw out the debug arrow stuff. (if (and (string-match (concat gud-matlab-marker-regexp->> "\\s-*$") output) - gud-last-last-frame) - (progn - ;; Clean up gud stuff. - (setq overlay-arrow-position nil - gud-last-last-frame nil - gud-overlay-arrow-position nil) - ;; If stack is showing, clean it up. - (let* ((buff (mlg-set-stack nil)) - (win (get-buffer-window buff))) - (when win - (select-window win) - (mlg-stack-quit) - )) - ;; Refresh stuff - (sit-for 0) - )) + mlgud-last-last-frame) + (progn + ;; Clean up mlgud stuff. + (setq overlay-arrow-position nil + mlgud-last-last-frame nil + mlgud-overlay-arrow-position nil) + ;; If stack is showing, clean it up. + (let* ((buff (mlg-set-stack nil)) + (win (get-buffer-window buff))) + (when win + (select-window win) + (mlg-stack-quit) + )) + ;; Refresh stuff + (sit-for 0) + )) ;; Check for any text that would be embarrassing to display partially. ;; If we don't see any, feel free to dump the rest of the accumulation buffer - (unless (or (string-match (regexp-quote "[%s] [%s]" output gud-marker-acc)) + (message "-->[%s] [%s]" output matlab-shell-gud--marker-acc)) ;;(message "Looking for prompt in %S" output) (when (and (not matlab-shell-suppress-prompt-hooks) - (string-match gud-matlab-marker-regexp-plain-prompt output)) + (string-match gud-matlab-marker-regexp-plain-prompt output)) ;; Now that we are about to dump this, run our prompt hook. ;;(message "PROMPT!") (setq matlab-shell-prompt-hook-cookie t)) - + output)) ;;; Stack tracking ;; (defclass mlg-stack-frame () ((file :initarg :file - :type string - :documentation - "The filename this frame belongs to.") + :type string + :documentation + "The filename this frame belongs to.") (name :initarg :name - :type string - :documentation - "The name of the location of this frame") + :type string + :documentation + "The name of the location of this frame") (line :initarg :line - :type integer - :documentation - "The line number for this frame")) + :type integer + :documentation + "The line number for this frame")) "A single stack frame from MATLAB.") (cl-defmethod mlg-print ((frame mlg-stack-frame) longestname) "Use print to output this stack FRAME. LONGESTNAME specifies the how long the longest name we can expect is." (let* ((namefmt (concat "%" (number-to-string (or longestname 10)) "s")) - (str (concat (propertize (format namefmt (oref frame name)) 'face 'font-lock-function-name-face) - " " - (propertize (format "%3d" (oref frame line)) 'face 'bold) - " " - (propertize (oref frame file) 'face 'font-lock-constant-face)))) + (str (concat (propertize (format namefmt (oref frame name)) 'face 'font-lock-function-name-face) + " " + (propertize (format "%3d" (oref frame line)) 'face 'bold) + " " + (propertize (oref frame file) 'face 'font-lock-constant-face)))) (setq str (propertize str 'object frame)) str)) @@ -373,10 +375,10 @@ LONGESTNAME specifies the how long the longest name we can expect is." (setq mlg-stack nil) (dolist (L newstack) (push (make-instance 'mlg-stack-frame - :file (nth 0 L) - :name (nth 1 L) - :line (nth 2 L)) - mlg-stack)) + :file (nth 0 L) + :name (nth 1 L) + :line (nth 2 L)) + mlg-stack)) (setq mlg-stack (nreverse mlg-stack)) (mlg-refresh-stack-buffer) ;;(message "Updated Stack") @@ -393,10 +395,10 @@ LONGESTNAME specifies the how long the longest name we can expect is." "Specify a NEWFRAME provided by MATLAB we should visit." (setq mlg-frame newframe) (let ((file (oref (nth (1- newframe) mlg-stack) file)) - (line (oref (nth (1- newframe) mlg-stack) line))) + (line (oref (nth (1- newframe) mlg-stack) line))) (if (< line 0) (setq line (- line))) - (setq gud-last-frame (cons file line)) - ;;(message "Gud FRAME set to %S" gud-last-frame) + (setq mlgud-last-frame (cons file line)) + ;;(message "Gud FRAME set to %S" mlgud-last-frame) ) ) @@ -404,58 +406,58 @@ LONGESTNAME specifies the how long the longest name we can expect is." "Setup windows to show FRAME from the current stack frame." (let ((newframe (or frame mlg-frame))) (if (and mlg-stack (<= newframe (length mlg-stack))) - ;; Make sure we have a stack window. - (let* ((buff (get-buffer "*MATLAB stack*")) - (win (get-buffer-window buff))) - (if (or (not buff) (not win)) - (mlg-show-stack) - ;; else, do refresh stuff. - (select-window win)) - - ;; Still around, go do it. - (goto-char (point-min)) - (forward-line (1- frame)) - (mlg-stack-choose) - ) + ;; Make sure we have a stack window. + (let* ((buff (get-buffer "*MATLAB stack*")) + (win (get-buffer-window buff))) + (if (or (not buff) (not win)) + (mlg-show-stack) + ;; else, do refresh stuff. + (select-window win)) + + ;; Still around, go do it. + (goto-char (point-min)) + (forward-line (1- frame)) + (mlg-stack-choose) + ) ;; Else no frame. Look for the window, and close it. (let* ((buff (get-buffer "*MATLAB stack*")) - (win (get-buffer-window buff))) + (win (get-buffer-window buff))) - (when win (delete-window win))) + (when win (delete-window win))) ))) (defun mlg-refresh-stack-buffer () "Refresh the buffer displaying stack." (save-excursion (let ((buff (get-buffer-create "*MATLAB stack*")) - (namelen 5) - (inhibit-read-only t)) + (namelen 5) + (inhibit-read-only t)) (dolist (S mlg-stack) - (when (> (length (oref S name)) namelen) - (setq namelen (length (oref S name))))) - + (when (> (length (oref S name)) namelen) + (setq namelen (length (oref S name))))) + (set-buffer buff) (erase-buffer) (let ((cnt 1)) - (dolist (F mlg-stack) - (insert (format "%2d" cnt)) - (if (and mlg-frame (= cnt mlg-frame)) - (insert " >> ") - (insert " -- ")) - (insert (mlg-print F namelen) "\n") - (setq cnt (1+ cnt)))) + (dolist (F mlg-stack) + (insert (format "%2d" cnt)) + (if (and mlg-frame (= cnt mlg-frame)) + (insert " >> ") + (insert " -- ")) + (insert (mlg-print F namelen) "\n") + (setq cnt (1+ cnt)))) (mlg-stack-mode) (goto-char (point-min)) (current-buffer)))) - + (defun mlg-show-stack () "Display the MATLAB stack in an interactive buffer." (interactive) (let ((buff (mlg-refresh-stack-buffer))) - + (display-buffer buff '((display-buffer-at-bottom) @@ -466,7 +468,7 @@ LONGESTNAME specifies the how long the longest name we can expect is." (select-window (get-buffer-window buff)) (goto-char 3) )) - + (defvar mlg-stack-mode-map (let ((km (make-sparse-keymap))) (define-key km [return] 'mlg-stack-choose) @@ -529,39 +531,39 @@ Visit the file presented in that stack frame." (beginning-of-line) (forward-char 10) (let* ((sf (get-text-property (point) 'object)) - (f (oref sf file)) - (l (oref sf line)) - (buff (find-file-noselect f t))) - (display-buffer - buff - '((display-buffer-reuse-window display-buffer-use-some-window) - (inhibit-same-window . t)) - ) - (let ((win (selected-window))) - (select-window (get-buffer-window buff)) - (goto-char (point-min)) - (forward-line (1- l)) - (select-window win)) - )))) + (f (oref sf file)) + (l (oref sf line)) + (buff (find-file-noselect f t))) + (display-buffer + buff + '((display-buffer-reuse-window display-buffer-use-some-window) + (inhibit-same-window . t)) + ) + (let ((win (selected-window))) + (select-window (get-buffer-window buff)) + (goto-char (point-min)) + (forward-line (1- l)) + (select-window win)) + )))) ;;; Breakpoint Trackers ;; (defclass mlg-breakpoint () ((file :initarg :file - :type string - :documentation - "The filename this breakpoint belongs to.") + :type string + :documentation + "The filename this breakpoint belongs to.") (name :initarg :name - :type string - :documentation - "Name of the function this breakpoint is in.") + :type string + :documentation + "Name of the function this breakpoint is in.") (line :initarg :line - :type integer - :documentation - "The line number for this breakpoint") + :type integer + :documentation + "The line number for this breakpoint") (overlay :documentation - :default nil - "The overlay indicating the presence of this breakpoint.") + :default nil + "The overlay indicating the presence of this breakpoint.") ) "Representation of a breakpoint. Used to track active breakpoints, and how to show them.") @@ -570,11 +572,11 @@ Used to track active breakpoints, and how to show them.") "Use print to output this breakpoint BREAK. LONGESTNAME specifies the how long the longest name we can expect is." (let* ((namefmt (concat "%" (number-to-string (or longestname 10)) "s")) - (str (concat (propertize (format namefmt (oref break name)) 'face 'font-lock-function-name-face) - " " - (propertize (format "%3d" (oref break line)) 'face 'bold) - " " - (propertize (oref break file) 'face 'font-lock-constant-face)))) + (str (concat (propertize (format namefmt (oref break name)) 'face 'font-lock-function-name-face) + " " + (propertize (format "%3d" (oref break line)) 'face 'bold) + " " + (propertize (oref break file) 'face 'font-lock-constant-face)))) (setq str (propertize str 'object break)) str)) @@ -593,15 +595,15 @@ LONGESTNAME specifies the how long the longest name we can expect is." (let ((found nil)) (dolist (BP matlab-gud-visible-breakpoints) (when (and (string= (oref BP file) file) - (= (oref BP line) line)) - (setq found t))) + (= (oref BP line) line)) + (setq found t))) (when (not found) (setq matlab-gud-visible-breakpoints - (cons (make-instance 'mlg-breakpoint - :file file - :name fcn - :line line) - matlab-gud-visible-breakpoints)) + (cons (make-instance 'mlg-breakpoint + :file file + :name fcn + :line line) + matlab-gud-visible-breakpoints)) (mlg-activate (car matlab-gud-visible-breakpoints)) )) ;; The first time breakpoints are added, make sure we can activate breakpoints @@ -612,25 +614,25 @@ LONGESTNAME specifies the how long the longest name we can expect is." (defun mlg-del-breakpoint (file fcn line) "Add a visible breakpoint to FILE at LINE." (let ((BPS matlab-gud-visible-breakpoints) - (NBPS nil)) + (NBPS nil)) (while BPS (if (and (string= (oref (car BPS) file) file) - (= (oref (car BPS) line) line)) - ;; Deactivate - (mlg-deactivate (car BPS)) - ;; Not being removed, add to list. - (setq NBPS (cons (car BPS) NBPS))) + (= (oref (car BPS) line) line)) + ;; Deactivate + (mlg-deactivate (car BPS)) + ;; Not being removed, add to list. + (setq NBPS (cons (car BPS) NBPS))) (setq BPS (cdr BPS))) - + (setq matlab-gud-visible-breakpoints - (nreverse NBPS)))) + (nreverse NBPS)))) (defface mlg-breakpoint-face (list (list t - (list :background nil - :foreground nil - :underline "red1"))) + (list :background nil + :foreground nil + :underline "red1"))) "*Face to use to highlight breakpoints." :group 'matlab-shell) @@ -638,42 +640,42 @@ LONGESTNAME specifies the how long the longest name we can expect is." "Activate breakpoint BP if needed." ;; yes overlay, but inactive (when (and (slot-boundp bp 'overlay) - (oref bp overlay) - (not (overlay-buffer (oref bp overlay)))) - (oset bp overlay nil)) - - (let ((buff (find-buffer-visiting (oref bp file)))) - ;; No overlay, and we can make one. - (when (and (or (not (slot-boundp bp 'overlay)) - (not (oref bp overlay))) - buff) - (with-current-buffer buff - (goto-char (point-min)) - (forward-line (1- (oref bp line))) - (let ((ol (matlab-make-overlay (save-excursion - (back-to-indentation) - (point)) - (point-at-eol) buff nil nil))) - ;; Store it - (oset bp overlay ol) - ;; Setup cool stuff - (matlab-overlay-put ol 'face 'mlg-breakpoint-face) - (matlab-overlay-put ol 'before-string - (propertize "#" - 'display - '(left-fringe - filled-square - matlab-shell-error-face)) - )))) - )) + (oref bp overlay) + (not (overlay-buffer (oref bp overlay)))) + (oset bp overlay nil)) + + (let ((buff (find-buffer-visiting (oref bp file)))) + ;; No overlay, and we can make one. + (when (and (or (not (slot-boundp bp 'overlay)) + (not (oref bp overlay))) + buff) + (with-current-buffer buff + (goto-char (point-min)) + (forward-line (1- (oref bp line))) + (let ((ol (matlab-make-overlay (save-excursion + (back-to-indentation) + (point)) + (point-at-eol) buff nil nil))) + ;; Store it + (oset bp overlay ol) + ;; Setup cool stuff + (matlab-overlay-put ol 'face 'mlg-breakpoint-face) + (matlab-overlay-put ol 'before-string + (propertize "#" + 'display + '(left-fringe + filled-square + matlab-shell-error-face)) + )))) + )) (cl-defmethod mlg-deactivate ((bp mlg-breakpoint)) "Deactivate this breakpoint BP." (when (slot-boundp bp 'overlay) (with-slots (overlay) bp (when (and overlay (overlayp overlay)) - (delete-overlay overlay) - (setq overlay nil))))) + (delete-overlay overlay) + (setq overlay nil))))) (defun mlg-breakpoint-activate-buffer-opened-hook () "Activate any breakpoints in a buffer when that buffer is read in." @@ -698,31 +700,31 @@ LONGESTNAME specifies the how long the longest name we can expect is." "Refresh the buffer displaying breakpoints." (save-excursion (let ((buff (get-buffer-create "*MATLAB breakpoints*")) - (namelen 5) - (inhibit-read-only t)) + (namelen 5) + (inhibit-read-only t)) (dolist (S matlab-gud-visible-breakpoints) - (when (> (length (oref S name)) namelen) - (setq namelen (length (oref S name))))) - + (when (> (length (oref S name)) namelen) + (setq namelen (length (oref S name))))) + (set-buffer buff) (erase-buffer) (let ((cnt 1)) - (dolist (F matlab-gud-visible-breakpoints) - (insert (format "%2d - " cnt)) - (insert (mlg-print F namelen) "\n") - (setq cnt (1+ cnt)))) + (dolist (F matlab-gud-visible-breakpoints) + (insert (format "%2d - " cnt)) + (insert (mlg-print F namelen) "\n") + (setq cnt (1+ cnt)))) (mlg-breakpoint-mode) (goto-char (point-min)) (current-buffer)))) - + (defun mlg-show-breakpoints () "Display the MATLAB stack in an interactive buffer." (interactive) (let ((buff (mlg-refresh-breakpoint-buffer))) - + (display-buffer buff '((display-buffer-at-bottom) @@ -733,8 +735,8 @@ LONGESTNAME specifies the how long the longest name we can expect is." (select-window (get-buffer-window buff)) (goto-char 3) )) - - + + (defvar mlg-breakpoint-mode-map (let ((km (make-sparse-keymap))) (define-key km [return] 'mlg-breakpoint-choose) @@ -797,20 +799,20 @@ Visit the file presented in that breakpoint frame." (beginning-of-line) (forward-char 10) (let* ((sf (get-text-property (point) 'object)) - (f (oref sf file)) - (l (oref sf line)) - (buff (find-file-noselect f t))) - (display-buffer - buff - '((display-buffer-reuse-window display-buffer-use-some-window) - (inhibit-same-window . t)) - ) - (let ((win (selected-window))) - (select-window (get-buffer-window buff)) - (goto-char (point-min)) - (forward-line (1- l)) - (select-window win)) - )))) + (f (oref sf file)) + (l (oref sf line)) + (buff (find-file-noselect f t))) + (display-buffer + buff + '((display-buffer-reuse-window display-buffer-use-some-window) + (inhibit-same-window . t)) + ) + (let ((win (selected-window))) + (select-window (get-buffer-window buff)) + (goto-char (point-min)) + (forward-line (1- l)) + (select-window win)) + )))) ;;; K prompt state and hooks. @@ -825,21 +827,25 @@ Call debug activate/deactivate features." (beginning-of-line) (cond ((and gud-matlab-debug-active (looking-at gud-matlab-marker-regexp->>)) - (setq gud-matlab-debug-active nil) - (when (boundp 'tool-bar-map) ; not --without-x - (with-current-buffer (matlab-shell-active-p) (kill-local-variable 'tool-bar-map))) - (global-matlab-shell-gud-minor-mode -1) - (run-hooks 'gud-matlab-debug-deactivate-hook)) + ;; Debugger was active and we are back at prompt + (setq gud-matlab-debug-active nil) + (when (boundp 'tool-bar-map) ; not --without-x + (with-current-buffer (matlab-shell-active-p) (kill-local-variable 'tool-bar-map))) + (global-matlab-shell-gud-minor-mode -1) + (global-matlab-shell-inactive-gud-minor-mode 1) + (run-hooks 'gud-matlab-debug-deactivate-hook)) ((and (not gud-matlab-debug-active) (looking-at gud-matlab-marker-regexp-K>>)) - (setq gud-matlab-debug-active t) - (when (boundp 'tool-bar-map) ; not --without-x - (with-current-buffer (matlab-shell-active-p) - (setq-local tool-bar-map gud-matlab-tool-bar-map))) - (global-matlab-shell-gud-minor-mode 1) - (run-hooks 'gud-matlab-debug-activate-hook)) + ;; Debugger was NOT active and we are now in debug prompt + (setq gud-matlab-debug-active t) + (when (boundp 'tool-bar-map) ; not --without-x + (with-current-buffer (matlab-shell-active-p) + (setq-local tool-bar-map gud-matlab-tool-bar-map))) + (global-matlab-shell-gud-minor-mode 1) + (global-matlab-shell-inactive-gud-minor-mode -1) + (run-hooks 'gud-matlab-debug-activate-hook)) (t - ;; All clear - )))) + ;; All clear + )))) ) ;;; MATLAB SHELL GUD Minor Mode @@ -849,36 +855,63 @@ Call debug activate/deactivate features." (defvar matlab-shell-gud-minor-mode-map (let ((km (make-sparse-keymap)) - (key ?\ )) + (key ?\ )) (while (<= key ?~) (define-key km (string key) 'matlab-shell-gud-mode-help-notice) (setq key (1+ key))) (define-key km "h" 'matlab-shell-gud-mode-help) - ;; gud bindings. - (define-key km "b" 'gud-break) - (define-key km "x" 'gud-remove) - (define-key km "c" 'gud-cont) - (define-key km "s" 'gud-step) - (define-key km " " 'gud-step) - (define-key km "n" 'gud-next) - (define-key km "f" 'gud-finish) - (define-key km "q" 'gud-stop-subjob) - ;(define-key km "u" 'gud-up) - ;(define-key km "d" 'gud-down) - (define-key km "<" 'gud-up) - (define-key km ">" 'gud-down) + ;; mlgud bindings. + (define-key km "b" 'mlgud-break) + (define-key km "x" 'mlgud-remove) + (define-key km "c" 'mlgud-cont) + (define-key km " " 'mlgud-step) + (define-key km "s" 'mlgud-step) + (define-key km "n" 'mlgud-next) + (define-key km "f" 'mlgud-finish) + (define-key km "q" 'mlgud-stop-subjob) + (define-key km "<" 'mlgud-up) + (define-key km ">" 'mlgud-down) (define-key km "w" 'mlg-show-stack) - (define-key km "v" 'gud-list-breakpoints) + (define-key km "v" 'mlgud-list-breakpoints) (define-key km "e" 'matlab-shell-gud-show-symbol-value) - ;; (define-key km "p" gud-print) - ;;(define-key km "" 'matlab-shell-gud-mode-edit) (define-key km "\C-x\C-q" 'matlab-shell-gud-mode-edit) ; like toggle-read-only - + km) "Keymap used by matlab mode maintainers.") +(defun matlab-shell-gud-mode-help-notice () + "Default binding for most keys in `matlab-shell-gud-minor-mode'. +Shows a help message in the mini buffer." + (interactive) + (error "MATLAB shell GUD minor-mode: Press 'h' for help, 'e' to go back to editing")) + +(defun matlab-shell-gud-mode-help () + "Show the default binding for most keys in `matlab-shell-gud-minor-mode'." + (interactive) + (describe-minor-mode 'matlab-shell-gud-minor-mode)) + +(defun matlab-shell-gud-mode-edit () + "Turn off `matlab-shell-gud-minor-mode' so you can edit again." + (interactive) + (global-matlab-shell-gud-minor-mode -1)) + +(defun matlab-shell-gud-show-symbol-value (sym) + "Show the value of the symbol SYM under point from MATLAB shell." + (interactive + (list + (if (use-region-p) + ;; Don't ask user anything, just take it. + (buffer-substring-no-properties (region-beginning) (region-end)) + (let ((word (matlab-read-word-at-point))) + (read-from-minibuffer "MATLAB variable: " (cons word 0)))))) + (let ((txt (matlab-shell-collect-command-output + (concat "disp(" sym ")")))) + (if (not (string-match "ERRORTXT" txt)) + (matlab-output-to-temp-buffer "*MATLAB Help*" txt) + (message "Error evaluating MATLAB expression")))) + ;;;###autoload (define-minor-mode matlab-shell-gud-minor-mode "Minor mode activated when `matlab-shell' K>> prompt is active. @@ -889,46 +922,43 @@ mouse hovers over a symbol when debugging. Debug commands are: \\[matlab-shell-gud-mode-edit] - Edit file (toggle read-only) Allows editing file without causing MATLAB to exit debug mode. - \\[gud-break] - Add breakpoint (ebstop in FILE at point) - \\[gud-remove] - Remove breakpoint (ebclear in FILE at point) - \\[gud-list-breakpoints] - List breakpoints (ebstatus) - \\[gud-step] - Step (dbstep in) - \\[gud-next] - Next (dbstep) - \\[gud-finish] - Finish function (dbstep out) - \\[gud-cont] - Continue (dbcont) + \\[mlgud-break] - Add breakpoint (ebstop in FILE at point) + \\[mlgud-remove] - Remove breakpoint (ebclear in FILE at point) + \\[mlgud-list-breakpoints] - List breakpoints (ebstatus) + \\[mlgud-step] - Step (dbstep in) + \\[mlgud-next] - Next (dbstep) + \\[mlgud-finish] - Finish function (dbstep out) + \\[mlgud-cont] - Continue (dbcont) \\[matlab-shell-gud-show-symbol-value] - Evaluate expression \\[mlg-show-stack] - Where am I (ebstack) - \\[gud-stop-subjob] - Quit (dbquit)" + \\[mlgud-stop-subjob] - Quit (dbquit)" nil " MGUD" matlab-shell-gud-minor-mode-map - + ;; Make the buffer read only (if matlab-shell-gud-minor-mode (progn - ;; Enable - (when (buffer-file-name) (setq buffer-read-only t)) - (when matlab-shell-debug-tooltips-p - (gud-tooltip-mode 1) - (add-hook 'tooltip-functions 'gud-matlab-tooltip-tips) - ) - ;; Replace gud's toolbar which keeps stomping - ;; on our toolbar. - (make-local-variable 'gud-tool-bar-map) - (setq gud-tool-bar-map gud-matlab-tool-bar-map) - ) + ;; Enable + (when (buffer-file-name) (setq buffer-read-only t)) + (when matlab-shell-debug-tooltips-p + (mlgud-tooltip-mode 1) + (add-hook 'tooltip-functions 'gud-matlab-tooltip-tips) + ) + ;; Replace mlgud's toolbar which keeps stomping + ;; on our toolbar. + (make-local-variable 'mlgud-tool-bar-map) + (setq mlgud-tool-bar-map gud-matlab-tool-bar-map) + ) ;; Disable (when (buffer-file-name) (setq buffer-read-only (not (file-writable-p (buffer-file-name))))) - + ;; Always disable tooltips, in case configured while in the mode. - (gud-tooltip-mode -1) + (mlgud-tooltip-mode -1) (remove-hook 'tooltip-functions 'gud-matlab-tooltip-tips) ;; Disable the debug toolboar (when (boundp 'tool-bar-map) ; not --without-x - (kill-local-variable 'tool-bar-map)) - - ) - ) + (kill-local-variable 'tool-bar-map)))) ;;;###autoload (define-global-minor-mode global-matlab-shell-gud-minor-mode @@ -936,71 +966,93 @@ Debug commands are: (lambda () "Should we turn on in this buffer? Only if in a MATLAB mode." (when (eq major-mode 'matlab-mode) - (matlab-shell-gud-minor-mode 1))) - ) + (matlab-shell-gud-minor-mode 1)))) -(defun matlab-shell-gud-show-symbol-value (sym) - "Show the value of the symbol SYM under point from MATLAB shell." - (interactive - (list - (if (use-region-p) - ;; Don't ask user anything, just take it. - (buffer-substring-no-properties (region-beginning) (region-end)) - (let ((word (matlab-read-word-at-point))) - (read-from-minibuffer "MATLAB variable: " (cons word 0)))))) - (let ((txt (matlab-shell-collect-command-output - (concat "disp(" sym ")")))) - (if (not (string-match "ERRORTXT" txt)) - (matlab-output-to-temp-buffer "*MATLAB Help*" txt) - (message "Error evaluating MATLAB expression")))) +;;; MATLAB SHELL Inactive GUD Minor Mode +(defvar matlab-shell-inactive-gud-minor-mode-map + (let ((km (make-sparse-keymap))) + (define-key km "\C-c\C-d\C-h" 'matlab-shell-inactive-gud-mode-help) -(defun matlab-shell-gud-mode-edit () - "Turn off `matlab-shell-gud-minor-mode' so you can edit again." - (interactive) - (global-matlab-shell-gud-minor-mode -1)) + ;; mlgud bindings when debugger is inactive. When inactive, only bindings such as mlgud-break + ;; make sense. However, we also keep these bindings when the debugger is active for consistency. + (define-key km (kbd "C-c C-d b") 'mlgud-break) + (define-key km (kbd "C-c C-d x") 'mlgud-remove) + (define-key km (kbd "C-c C-d c") 'mlgud-cont) + (define-key km (kbd "C-c C-d SPC") 'mlgud-step) + (define-key km (kbd "C-c C-d s") 'mlgud-step) + (define-key km (kbd "C-c C-d n") 'mlgud-next) + (define-key km (kbd "C-c C-d f") 'mlgud-finish) + (define-key km (kbd "C-c C-d q") 'mlgud-stop-subjob) + (define-key km (kbd "C-c C-d <") 'mlgud-up) + (define-key km (kbd "C-c C-d >") 'mlgud-down) + (define-key km (kbd "C-c C-d w") 'mlg-show-stack) + (define-key km (kbd "C-c C-d v") 'mlgud-list-breakpoints) + (define-key km (kbd "C-c C-d e") 'matlab-shell-gud-show-symbol-value) -(defun matlab-shell-gud-mode-help-notice () - "Default binding for most keys in `matlab-shell-gud-minor-mode'. -Shows a help message in the mini buffer." - (interactive) - (error "MATLAB shell GUD minor-mode: Press 'h' for help, 'e' to go back to editing")) + km) + "Keymap used by matlab mode maintainers.") -(defun matlab-shell-gud-mode-help () +;;;###autoload +(define-minor-mode matlab-shell-inactive-gud-minor-mode + "Minor mode activated when `matlab-shell' K>> prompt is inactive. +\\ +Debug commands are: + \\[mlgud-break] - Add breakpoint (ebstop in FILE at point) + \\[mlgud-remove] - Remove breakpoint (ebclear in FILE at point) + \\[mlgud-list-breakpoints] - List breakpoints (ebstatus) +" + nil " I-MGUD" matlab-shell-inactive-gud-minor-mode-map + + ;; Always disable tooltips, in case configured while in the mode. + (mlgud-tooltip-mode -1) + (remove-hook 'tooltip-functions 'gud-matlab-tooltip-tips) + + (when (boundp 'tool-bar-map) ; not --without-x + (kill-local-variable 'tool-bar-map))) + +(defun matlab-shell-inactive-gud-mode-help () "Show the default binding for most keys in `matlab-shell-gud-minor-mode'." (interactive) - (describe-minor-mode 'matlab-shell-gud-minor-mode) - ) + (describe-minor-mode 'matlab-shell-gud-minor-mode)) + +;;;###autoload +(define-global-minor-mode global-matlab-shell-inactive-gud-minor-mode + matlab-shell-inactive-gud-minor-mode + (lambda () + "Should we turn on in this buffer? Only if in a MATLAB mode." + (when (eq major-mode 'matlab-mode) + (matlab-shell-inactive-gud-minor-mode 1)))) ;;; Tooltips ;; -;; Using the gud tooltip feature for a bunch of setup, but then +;; Using the mlgud tooltip feature for a bunch of setup, but then ;; just override the tooltip fcn (see the mode) with this function ;; as an additional piece. (defun gud-matlab-tooltip-tips (event) "Implementation of the tooltip feature for MATLAB. -Much of this was copied from `gud-tooltip-tips'. +Much of this was copied from `mlgud-tooltip-tips'. This function must return nil if it doesn't handle EVENT." (when (and (eventp event) (tooltip-event-buffer event)) (with-current-buffer (tooltip-event-buffer event) - (when (and gud-tooltip-mode - matlab-shell-gud-minor-mode - (buffer-name gud-comint-buffer) ; might be killed - ) - (let ((expr (matlab-shell-gud-find-tooltip-expression event)) - (txt nil)) - (when expr - (setq txt (matlab-shell-collect-command-output - (concat "emacstipstring(" expr ")"))) + (when (and mlgud-tooltip-mode + matlab-shell-gud-minor-mode + (buffer-name mlgud-comint-buffer) ; might be killed + ) + (let ((expr (matlab-shell-gud-find-tooltip-expression event)) + (txt nil)) + (when expr + (setq txt (matlab-shell-collect-command-output + (concat "emacstipstring(" expr ")"))) - (when (not (string-match "ERRORTXT" txt)) + (when (not (string-match "ERRORTXT" txt)) - (tooltip-show (concat expr "=\n" txt) - (or gud-tooltip-echo-area - tooltip-use-echo-area - (not tooltip-mode))) - t))))))) + (tooltip-show (concat expr "=\n" txt) + (or mlgud-tooltip-echo-area + tooltip-use-echo-area + (not tooltip-mode))) + t))))))) (defun matlab-shell-gud-find-tooltip-expression (event) "Identify an expression to output in a tooltip at EVENT. @@ -1011,39 +1063,39 @@ if it looks like a function call, it will return nil." (with-current-buffer (tooltip-event-buffer event) ;; Only do this for MATLAB stuff. (when matlab-shell-gud-minor-mode - - (let ((point (posn-point (event-end event)))) - (if (use-region-p) - (when (and (<= (region-beginning) point) (<= point (region-end))) - (buffer-substring (region-beginning) (region-end))) - ;; This snippet copied from tooltip.el, then modified to - ;; detect matlab functions - (save-excursion - (goto-char point) - (let* ((origin (point)) - (start (progn - (skip-syntax-backward "w_") - ;; find full . expression - (while (= (preceding-char) ?.) - (forward-char -1) - (skip-syntax-backward "w_")) - (point))) - (pstate (syntax-ppss))) - (unless (or (looking-at "[0-9]") - (nth 3 pstate) - (nth 4 pstate)) - (goto-char origin) - (skip-syntax-forward "w_") - (when (> (point) start) - ;; At this point, look to see we are looking at (. If so - ;; we need to grab that stuff too. - (if (not (looking-at "\\s-*(")) - (buffer-substring-no-properties start (point)) - ;; Also grab the arguments - (matlab-forward-sexp) - (buffer-substring-no-properties start (point))) - ))))))))) + (let ((point (posn-point (event-end event)))) + (if (use-region-p) + (when (and (<= (region-beginning) point) (<= point (region-end))) + (buffer-substring (region-beginning) (region-end))) + + ;; This snippet copied from tooltip.el, then modified to + ;; detect matlab functions + (save-excursion + (goto-char point) + (let* ((origin (point)) + (start (progn + (skip-syntax-backward "w_") + ;; find full . expression + (while (= (preceding-char) ?.) + (forward-char -1) + (skip-syntax-backward "w_")) + (point))) + (pstate (syntax-ppss))) + (unless (or (looking-at "[0-9]") + (nth 3 pstate) + (nth 4 pstate)) + (goto-char origin) + (skip-syntax-forward "w_") + (when (> (point) start) + ;; At this point, look to see we are looking at (. If so + ;; we need to grab that stuff too. + (if (not (looking-at "\\s-*(")) + (buffer-substring-no-properties start (point)) + ;; Also grab the arguments + (matlab-forward-sexp) + (buffer-substring-no-properties start (point))) + ))))))))) (provide 'matlab-shell-gud) @@ -1055,6 +1107,6 @@ if it looks like a function call, it will return nil." ;; LocalWords: COMINT errortext dbhlcmd comint endprompt mello mlg EMACSCAP ;; LocalWords: defclass initarg defmethod longestname namefmt propertize oref ;; LocalWords: newstack nreverse newframe namelen cnt prev MStack BP del NBPS -;; LocalWords: defface bp oset ol eol overlayp MBreakpoints MGUD gud's +;; LocalWords: defface bp oset ol eol overlayp MBreakpoints MGUD mlgud's ;; LocalWords: toolboar minibuffer ERRORTXT eventp emacstipstring posn pstate ;; LocalWords: ppss sexp diff --git a/matlab-shell.el b/matlab-shell.el index 4e5ed06..cc92232 100644 --- a/matlab-shell.el +++ b/matlab-shell.el @@ -31,7 +31,7 @@ (require 'server) (eval-and-compile - (require 'gud) + (require 'mlgud) (require 'shell) ) @@ -563,7 +563,7 @@ Try C-h f matlab-shell RET")) ;;; PROCESS FILTERS & SENTINEL ;; ;; These are wrappers around the GUD filters so we can pre and post process -;; decisions by comint and gud. +;; decisions by comint and mlgud. (defvar matlab-shell-capturetext-start-text "" "Text used as simple signal for text that should be captured.") (defvar matlab-shell-capturetext-end-text "" @@ -635,7 +635,7 @@ STRING is the recent output from PROC to be filtered." matlab-shell-flush-accumulation-buffer nil)) (with-current-buffer buff - (gud-filter proc string)) + (mlgud-filter proc string)) ;; In case things get switched around on us (with-current-buffer buff @@ -656,7 +656,7 @@ PROC is the function which experienced a change in state. STRING is a description of what happened." (let ((buff (process-buffer proc))) (with-current-buffer buff - (gud-sentinel proc string)))) + (mlgud-sentinel proc string)))) ;;; COMINT support fcns ;; @@ -1933,8 +1933,8 @@ If DEBUG is non-nil, then setup GUD debugging features." (goto-char (point-min)) (forward-line (1- (string-to-number el))) (when debug - (setq gud-last-frame (cons (buffer-file-name) (string-to-number el))) - (gud-display-frame)) + (setq mlgud-last-frame (cons (buffer-file-name) (string-to-number el))) + (mlgud-display-frame)) (setq ec (string-to-number ec)) (if (> ec 0) (forward-char (1- ec))))) @@ -1953,7 +1953,7 @@ If DEBUG is non-nil, then setup GUD debugging features." (matlab-find-other-window-file-line-column ef el ec debug))) ((string-match "^matlab:*\\(.*\\)$" url) (process-send-string - (get-buffer-process gud-comint-buffer) + (get-buffer-process mlgud-comint-buffer) (concat (substring url (match-beginning 1) (match-end 1)) "\n"))))) (defun matlab-shell-last-error () @@ -2413,12 +2413,13 @@ Return the name of the temporary file." (goto-char (point-min)) (dolist (F functions) (save-excursion - ;; Copy all local functions to script. - (let ((ft (matlab-semantic-tag-text F orig))) - (goto-char (point-max)) - (insert "% Copy of " (semantic-tag-name F) "\n\n") - (insert ft) - (insert "\n%%\n"))) + (when (re-search-forward (semantic-tag-name F) nil t) + ;; Found, copy it in. + (let ((ft (matlab-semantic-tag-text F orig))) + (goto-char (point-max)) + (insert "% Copy of " (semantic-tag-name F) "\n\n") + (insert ft) + (insert "\n%%\n")))) ) ;; Save buffer, and setup ability to run this new script. @@ -2460,31 +2461,31 @@ Argument FNAME specifies if we should echo the region to the command line." ;;; matlab-shell.el ends here -;; LocalWords: el Ludlam zappo compat comint gud Slience defcustom el cb +;; LocalWords: el Ludlam zappo compat comint mlgud Slience defcustom el cb ;; LocalWords: nodesktop defface autostart netshell emacsclient errorscanning ;; LocalWords: cco defun setq Keymaps keymap kbd featurep fboundp subprocess ;; LocalWords: online EDU postoutput progn subjob eol mlfile emacsinit msbn pc ;; LocalWords: Thx Chappaz windowid dirtrackp dbhot erroexamples Ludlam zappo -;; LocalWords: compat comint gud Slience defcustom nodesktop defface emacscd +;; LocalWords: compat comint mlgud Slience defcustom nodesktop defface emacscd ;; LocalWords: autostart netshell emacsclient errorscanning cco defun setq el ;; LocalWords: Keymaps keymap kbd featurep fboundp subprocess online EDU ;; LocalWords: postoutput progn subjob eol mlfile emacsinit msbn pc Thx Ludlam ;; LocalWords: Chappaz windowid dirtrackp dbhot erroexamples cdr ENDPT dolist ;; LocalWords: overlaystack mref deref errortext ERRORTXT Missmatched zappo -;; LocalWords: shellerror dbhotlink realfname aset buf noselect tcp auth ef -;; LocalWords: dbhotlinks compat comint gud Slience defcustom capturetext +;; LocalWords: shellerror dbhotlink realfname aset buf noselect auth ef +;; LocalWords: dbhotlinks compat comint mlgud Slience defcustom capturetext ;; LocalWords: nodesktop defface autostart netshell emacsclient errorscanning ;; LocalWords: cco defun setq Keymaps keymap kbd featurep fboundp subprocess ;; LocalWords: online EDU postoutput progn subjob eol mlfile emacsinit msbn pc ;; LocalWords: Thx Chappaz windowid dirtrackp dbhot erroexamples cdr ENDPT ;; LocalWords: dolist overlaystack mref deref errortext ERRORTXT Missmatched -;; LocalWords: shellerror dbhotlink realfname aset buf noselect tcp auth ef +;; LocalWords: shellerror dbhotlink realfname aset buf noselect auth ef ;; LocalWords: dbhotlinks dbhlcmd endprompt mello pmark memq promptend ;; LocalWords: numchars integerp emacsdocomplete mycmd ba nreverse EMACSCAP ;; LocalWords: emacsdocompletion subfield fil byteswap stringp cbuff mapcar bw ;; LocalWords: FCN's alist BUILTINFLAG dired bol bobp numberp lattr princ ;; LocalWords: minibuffer fn matlabregex stackexchange doesnt lastcmd Emacsen -;; LocalWords: notimeout stacktop eltest testme localfcn LF mlx meth fileref +;; LocalWords: notimeout stacktop eltest testme localfcn LF meth fileref ;; LocalWords: funcall ec basec sk ignoredups boundp nondirectory edir sexp iq ;; LocalWords: Fixup mapc ltype noshow emacsrunregion cnt commandline elipsis ;; LocalWords: newf bss fname nt initcmd nsa ecc ecca clientcmd buffname diff --git a/matlab.el b/matlab.el index 9eb7aa7..2df157f 100644 --- a/matlab.el +++ b/matlab.el @@ -594,25 +594,25 @@ point, but it will be restored for them." ["Edit File (toggle read-only)" matlab-shell-gud-mode-edit :help "Exit MATLAB debug minor mode to edit without exiting MATLAB's K>> prompt." :visible gud-matlab-debug-active ] - ["Add Breakpoint (ebstop in FILE at point)" gud-break + ["Add Breakpoint (ebstop in FILE at point)" mlgud-break :active (matlab-shell-active-p) :help "When MATLAB debugger is active, set break point at current M-file point"] - ["Remove Breakpoint (ebclear in FILE at point)" gud-remove + ["Remove Breakpoint (ebclear in FILE at point)" mlgud-remove :active (matlab-shell-active-p) - :help "Show all active breakpoints in a separate buffer." ] - ["List Breakpoints (ebstatus)" gud-list-breakpoints + :help "When MATLAB debugger is active, remove break point in FILE at point." ] + ["List Breakpoints (ebstatus)" mlgud-list-breakpoints :active (matlab-shell-active-p) :help "List active breakpoints."] - ["Step (dbstep in)" gud-step + ["Step (dbstep in)" mlgud-step :active gud-matlab-debug-active :help "When MATLAB debugger is active, step into line"] - ["Next (dbstep)" gud-next + ["Next (dbstep)" mlgud-next :active gud-matlab-debug-active :help "When MATLAB debugger is active, step one line"] - ["Finish function (dbstep out)" gud-finish + ["Finish function (dbstep out)" mlgud-finish :active gud-matlab-debug-active :help "When MATLAB debugger is active, run to end of function"] - ["Continue (dbcont)" gud-cont + ["Continue (dbcont)" mlgud-cont :active gud-matlab-debug-active :help "When MATLAB debugger is active, run to next break point or finish"] ["Evaluate Expression" matlab-shell-gud-show-symbol-value @@ -621,14 +621,14 @@ point, but it will be restored for them." ["Show Stack" mlg-show-stack :active gud-matlab-debug-active :help "When MATLAB debugger is active, show the stack in a buffer."] -;;; Advertise these more if we can get them working w/ gud's frame show. -;;; ["Up Call Stack (dbup)" gud-up +;;; Advertise these more if we can get them working w/ mlgud's frame show. +;;; ["Up Call Stack (dbup)" mlgud-up ;;; :active gud-matlab-debug-active ;;; :help "When MATLAB debugger is active and at break point, go up a frame"] -;;; ["Down Call Stack (dbdown)" gud-down +;;; ["Down Call Stack (dbdown)" mlgud-down ;;; :active gud-matlab-debug-active ;;; :help "When MATLAB debugger is active and at break point, go down a frame"] - ["Quit debugging (dbquit)" gud-stop-subjob + ["Quit debugging (dbquit)" mlgud-stop-subjob :active gud-matlab-debug-active :help "When MATLAB debugger is active, stop debugging"] ) @@ -3243,10 +3243,10 @@ desired. Optional argument FAST is not used." ;;; matlab.el ends here ;; LocalWords: el Wette mwette caltech edu Ludlam eludlam defconst online mfiles ebstop ebclear -;; LocalWords: compat easymenu defcustom CASEINDENT COMMANDINDENT sexp defun ebstatus mlg gud's +;; LocalWords: compat easymenu defcustom CASEINDENT COMMANDINDENT sexp defun ebstatus mlg mlgud's ;; LocalWords: mmode setq progn sg Fns Alist elipsis vf functionname vers subjob flb fle elisp ;; LocalWords: minibuffer featurep fboundp facep zmacs defface cellbreak bcend lastcompute noblock -;; LocalWords: cellbreaks overline keymap torkel ispell gud allstring strchar decl lcbounds setcar +;; LocalWords: cellbreaks overline keymap torkel ispell mlgud allstring strchar decl lcbounds setcar ;; LocalWords: bs eu bc ec searchlim eol charvec Matchers ltype cdr if'd setcdr bcwrapped ;; LocalWords: uicontext setcolor mld keywordlist mapconcat pragmas Classdefs ;; LocalWords: dem Za Imenu imenu alist prog reindent unindent boundp fn diff --git a/mlgud.el b/mlgud.el new file mode 100644 index 0000000..95199e2 --- /dev/null +++ b/mlgud.el @@ -0,0 +1,1298 @@ +;;; mlgud.el --- parts of gud.el for matlab-shell -*- lexical-binding:t -*- + +;; This contains parts of gud.el prefixed with matlab and modified to support `matlab-shell'. gud +;; does not support multiple debuggers. For matlab-shell, we'd need to be able to debug MATLAB in +;; `matlab-shell', while in another buffer uses `gud-gdb' or `gdb' from gud.el to debug C++ code. + +;; Emacs 24 gud.el info: + +;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers + +;; Copyright (C) 1992-1996, 1998, 2000-2015 Free Software Foundation, +;; Inc. + +;; Author: Eric S. Raymond +;; Maintainer: emacs-devel@gnu.org +;; Keywords: unix, tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The ancestral gdb.el was by W. Schelter . +;; It was later rewritten by rms. Some ideas were due to Masanobu. Grand +;; Unification (sdb/dbx support) by Eric S. Raymond Barry +;; Warsaw hacked the mode to use comint.el. Shane Hartman +;; added support for xdb (HPUX debugger). Rick Sladkey +;; wrote the GDB command completion code. Dave Love +;; added the IRIX kluge, re-implemented the Mips-ish variant +;; and added a menu. Brian D. Carlstrom combined the IRIX +;; kluge with the gud-xdb-directories hack producing gud-dbx-directories. +;; Derek L. Davies added support for jdb (Java +;; debugger.) + +;;; Code: + +(require 'comint) + +(defvar gdb-active-process) +(defvar gdb-define-alist) +(defvar gdb-macro-info) +(defvar gdb-show-changed-values) +(defvar gdb-source-window) +(defvar gdb-var-list) +(defvar hl-line-mode) +(defvar hl-line-sticky-flag) + + +;; ====================================================================== +;; MLGUD commands must be visible in C buffers visited by MLGUD + +(defgroup mlgud nil + "The \"Grand Unified Debugger\" interface. +Supported debuggers include gdb, sdb, dbx, xdb, perldb, +pdb (Python), and jdb." + :group 'processes + :group 'tools) + + + + +(defvar mlgud-marker-filter nil) +(put 'mlgud-marker-filter 'permanent-local t) +(defvar mlgud-find-file nil) +(put 'mlgud-find-file 'permanent-local t) + +(defun mlgud-marker-filter (&rest args) + (apply mlgud-marker-filter args)) + +(defvar mlgud-minor-mode nil) +(put 'mlgud-minor-mode 'permanent-local t) + +(defvar mlgud-comint-buffer nil) + +(defvar mlgud-keep-buffer nil) + +(defun mlgud-symbol (sym &optional soft minor-mode) + "Return the symbol used for SYM in MINOR-MODE. +MINOR-MODE defaults to `mlgud-minor-mode'. +The symbol returned is `mlgud--'. +If SOFT is non-nil, returns nil if the symbol doesn't already exist." + (unless (or minor-mode mlgud-minor-mode) (error "mlGud internal error")) + (funcall (if soft 'intern-soft 'intern) + (format "mlgud-%s-%s" (or minor-mode mlgud-minor-mode) sym))) + +(defun mlgud-val (sym &optional minor-mode) + "Return the value of `mlgud-symbol' SYM. Default to nil." + (let ((sym (mlgud-symbol sym t minor-mode))) + (if (boundp sym) (symbol-value sym)))) + +(defvar mlgud-running nil + "Non-nil if debugged program is running. +Used to gray out relevant toolbar icons.") + +(defvar mlgud-target-name "--unknown--" + "The apparent name of the program being debugged in a mlgud buffer.") + +;; Use existing Info buffer, if possible. +(defun mlgud-goto-info () + "Go to relevant Emacs info node." + (interactive) + (if (eq mlgud-minor-mode 'gdbmi) + (info-other-window "(emacs)GDB Graphical Interface") + (info-other-window "(emacs)Debuggers"))) + +(defun mlgud-tool-bar-item-visible-no-fringe () + (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) + (eq (buffer-local-value 'major-mode (window-buffer)) 'gdb-memory-mode) + (and (eq mlgud-minor-mode 'gdbmi) + (> (car (window-fringes)) 0))))) + +(declare-function gdb-gud-context-command "gdb-mi.el") + +(defun mlgud-stop-subjob () + (interactive) + (with-current-buffer mlgud-comint-buffer + (cond ((string-equal mlgud-target-name "emacs") + (comint-stop-subjob)) + ((eq mlgud-minor-mode 'jdb) + (mlgud-call "suspend")) + ((eq mlgud-minor-mode 'gdbmi) + (mlgud-call (gdb-gud-context-command "-exec-interrupt"))) + (t + (comint-interrupt-subjob))))) + +(defvar mlgud-tool-bar-map + (let ((map (make-sparse-keymap))) + (dolist (x '((mlgud-break . "gud/break") + (mlgud-remove . "gud/remove") + (mlgud-print . "gud/print") + (mlgud-pstar . "gud/pstar") + (mlgud-pp . "gud/pp") + (mlgud-watch . "gud/watch") + (mlgud-run . "gud/run") + (mlgud-go . "gud/go") + (mlgud-stop-subjob . "gud/stop") + (mlgud-cont . "gud/cont") + (mlgud-until . "gud/until") + (mlgud-next . "gud/next") + (mlgud-step . "gud/step") + (mlgud-finish . "gud/finish") + (mlgud-nexti . "gud/nexti") + (mlgud-stepi . "gud/stepi") + (mlgud-up . "gud/up") + (mlgud-down . "gud/down") + (mlgud-goto-info . "info")) + map) + (tool-bar-local-item-from-menu + (car x) (cdr x) map)))) + +(defun mlgud-file-name (f) + "Transform a relative file name to an absolute file name. +Uses `mlgud--directories' to find the source files." + ;; When `default-directory' is a remote file name, prepend its + ;; remote part to f, which is the local file name. Fortunately, + ;; `file-remote-p' returns exactly this remote file name part (or + ;; nil otherwise). + (setq f (concat (or (file-remote-p default-directory) "") f)) + (if (file-exists-p f) (expand-file-name f) + (let ((directories (mlgud-val 'directories)) + (result nil)) + (while directories + (let ((path (expand-file-name f (car directories)))) + (if (file-exists-p path) + (setq result path + directories nil))) + (setq directories (cdr directories))) + result))) + +(declare-function gdb-create-define-alist "gdb-mi" ()) + +(defun mlgud-find-file (file) + ;; Don't get confused by double slashes in the name that comes from GDB. + (while (string-match "//+" file) + (setq file (replace-match "/" t t file))) + (let ((minor-mode mlgud-minor-mode) + (buf (funcall (or mlgud-find-file 'mlgud-file-name) file))) + (when (stringp buf) + (setq buf (and (file-readable-p buf) (find-file-noselect buf 'nowarn)))) + (when buf + ;; Copy `mlgud-minor-mode' to the found buffer to turn on the menu. + (with-current-buffer buf + (setq-local mlgud-minor-mode minor-mode) + (if (boundp 'tool-bar-map) ; not --without-x + (setq-local tool-bar-map mlgud-tool-bar-map)) + (when (and mlgud-tooltip-mode + (eq mlgud-minor-mode 'gdbmi)) + (make-local-variable 'gdb-define-alist) + (unless gdb-define-alist (gdb-create-define-alist)) + (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) + (make-local-variable 'mlgud-keep-buffer)) + buf))) + +;; ====================================================================== +;; command definition + +;; This macro is used below to define some basic debugger interface commands. +;; Of course you may use `mlgud-def' with any other debugger command, including +;; user defined ones. + +;; A macro call like (mlgud-def FUNC CMD KEY DOC) expands to a form +;; which defines FUNC to send the command CMD to the debugger, gives +;; it the docstring DOC, and binds that function to KEY in the MLGUD +;; major mode. The function is also bound in the global keymap with the +;; MLGUD prefix. + +(defmacro mlgud-def (func cmd &optional doc) + "Define FUNC to be a command sending CMD, with +optional doc string DOC. Certain %-escapes in the string arguments +are interpreted specially if present. These are: + + %f -- Name (without directory) of current source file. + %F -- Name (without directory or extension) of current source file. + %d -- Directory of current source file. + %l -- Number of current source line. + %e -- Text of the C lvalue or function-call expression surrounding point. + %a -- Text of the hexadecimal address surrounding point. + %p -- Prefix argument to the command (if any) as a number. + %c -- Fully qualified class name derived from the expression + surrounding point (jdb only). + + The `current' source file is the file of the current buffer (if +we're in a C file) or the source file current at the last break or +step (if we're in the MLGUD buffer). + The `current' line is that of the current buffer (if we're in a +source file) or the source line number at the last break or step (if +we're in the MLGUD buffer)." + `(progn + (defalias ',func (lambda (arg) + ,@(if doc (list doc)) + (interactive "p") + (if (not mlgud-running) + ,(if (stringp cmd) + `(mlgud-call ,cmd arg) + cmd)))) + )) + +;; Where mlgud-display-frame should put the debugging arrow; a cons of +;; (filename . line-number). This is set by the marker-filter, which scans +;; the debugger's output for indications of the current program counter. +(defvar mlgud-last-frame nil) + +;; Used by mlgud-refresh, which should cause mlgud-display-frame to redisplay +;; the last frame, even if it's been called before and mlgud-last-frame has +;; been set to nil. +(defvar mlgud-last-last-frame nil) + +;; All debugger-specific information is collected here. +;; Here's how it works, in case you ever need to add a debugger to the mode. +;; +;; Each entry must define the following at startup: +;; +;; +;; comint-prompt-regexp +;; mlgud--massage-args +;; mlgud--marker-filter +;; mlgud--find-file +;; +;; The job of the massage-args method is to modify the given list of +;; debugger arguments before running the debugger. +;; +;; The job of the marker-filter method is to detect file/line markers in +;; strings and set the global mlgud-last-frame to indicate what display +;; action (if any) should be triggered by the marker. Note that only +;; whatever the method *returns* is displayed in the buffer; thus, you +;; can filter the debugger's output, interpreting some and passing on +;; the rest. +;; +;; The job of the find-file method is to visit and return the buffer indicated +;; by the car of mlgud-tag-frame. This may be a file name, a tag name, or +;; something else. + +;; ====================================================================== +;; speedbar support functions and variables. +(eval-when-compile (require 'dframe)) ; for dframe-with-attached-buffer + +(defvar mlgud-last-speedbar-stackframe nil + "Description of the currently displayed MLGUD stack. +The value t means that there is no stack, and we are in display-file mode.") + +(defvar mlgud-speedbar-key-map nil + "Keymap used when in the buffers display mode.") + +;; At runtime, will be pulled in as a require of speedbar. +(declare-function dframe-message "dframe" (fmt &rest args)) + +(defun mlgud-speedbar-item-info () + "Display the data type of the watch expression element." + (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) + (if (nth 7 var) + (dframe-message "%s: %s" (nth 7 var) (nth 3 var)) + (dframe-message "%s" (nth 3 var))))) + +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(defvar speedbar-mode-functions-list) + +(defun mlgud-install-speedbar-variables () + "Install those variables used by speedbar to enhance mlgud/gdb." + (unless mlgud-speedbar-key-map + (setq mlgud-speedbar-key-map (speedbar-make-specialized-keymap)) + (define-key mlgud-speedbar-key-map "j" 'speedbar-edit-line) + (define-key mlgud-speedbar-key-map "e" 'speedbar-edit-line) + (define-key mlgud-speedbar-key-map "\C-m" 'speedbar-edit-line) + (define-key mlgud-speedbar-key-map " " 'speedbar-toggle-line-expansion) + (define-key mlgud-speedbar-key-map "D" 'gdb-var-delete) + (define-key mlgud-speedbar-key-map "p" 'mlgud-pp)) + + (speedbar-add-expansion-list '("mlMLGUD" mlgud-speedbar-menu-items + mlgud-speedbar-key-map + mlgud-expansion-speedbar-buttons)) + + (add-to-list + 'speedbar-mode-functions-list + '("mlMLGUD" (speedbar-item-info . mlgud-speedbar-item-info) + (speedbar-line-directory . ignore)))) + +(defvar mlgud-speedbar-menu-items + '(["Jump to stack frame" speedbar-edit-line + :visible (not (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi))] + ["Edit value" speedbar-edit-line + :visible (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi)] + ["Delete expression" gdb-var-delete + :visible (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi)] + ["Auto raise frame" gdb-speedbar-auto-raise + :style toggle :selected gdb-speedbar-auto-raise + :visible (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi)] + ("Output Format" + :visible (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi) + ["Binary" (gdb-var-set-format "binary") t] + ["Natural" (gdb-var-set-format "natural") t] + ["Hexadecimal" (gdb-var-set-format "hexadecimal") t])) + "Additional menu items to add to the speedbar frame.") + +;; Make sure our special speedbar mode is loaded +(if (featurep 'speedbar) + (mlgud-install-speedbar-variables) + (add-hook 'speedbar-load-hook 'mlgud-install-speedbar-variables)) + +(defun mlgud-expansion-speedbar-buttons (_directory _zero) + "Wrapper for call to `speedbar-add-expansion-list'. +DIRECTORY and ZERO are not used, but are required by the caller." + (mlgud-speedbar-buttons mlgud-comint-buffer)) + +(declare-function speedbar-make-tag-line "speedbar" + (type char func data tag tfunc tdata tface depth)) +(declare-function speedbar-remove-localized-speedbar-support "speedbar" + (buffer)) +(declare-function speedbar-insert-button "speedbar" + (text face mouse function &optional token prevline)) + +(defun mlgud-speedbar-buttons (buffer) + "Create a speedbar display based on the current state of MLGUD. +If the MLGUD BUFFER is not running a supported debugger, then turn +off the specialized speedbar mode. BUFFER is not used, but is +required by the caller." + (when (and mlgud-comint-buffer + ;; mlgud-comint-buffer might be killed + (buffer-name mlgud-comint-buffer)) + (let* ((minor-mode (with-current-buffer buffer mlgud-minor-mode)) + (window (get-buffer-window (current-buffer) 0)) + (start (window-start window)) + (p (window-point window))) + (cond + ((eq minor-mode 'gdbmi) + (erase-buffer) + (insert "Watch Expressions:\n") + (let ((var-list gdb-var-list) parent) + (while var-list + (let* (char (depth 0) (start 0) (var (car var-list)) + (varnum (car var)) (expr (nth 1 var)) + (type (if (nth 3 var) (nth 3 var) " ")) + (value (nth 4 var)) (status (nth 5 var)) + (has-more (nth 6 var))) + (put-text-property + 0 (length expr) 'face font-lock-variable-name-face expr) + (put-text-property + 0 (length type) 'face font-lock-type-face type) + (while (string-match "\\." varnum start) + (setq depth (1+ depth) + start (1+ (match-beginning 0)))) + (if (eq depth 0) (setq parent nil)) + (if (and (or (not has-more) (string-equal has-more "0")) + (or (equal (nth 2 var) "0") + (and (equal (nth 2 var) "1") + (string-match "char \\*$" type)) )) + (speedbar-make-tag-line + 'bracket ?? nil nil + (concat expr "\t" value) + (if (or parent (eq status 'out-of-scope)) + nil 'gdb-edit-value) + nil + (if gdb-show-changed-values + (or parent (pcase status + (`changed 'font-lock-warning-face) + (`out-of-scope 'shadow) + (_ t))) + t) + depth) + (if (eq status 'out-of-scope) (setq parent 'shadow)) + (if (and (nth 1 var-list) + (string-match (concat varnum "\\.") + (car (nth 1 var-list)))) + (setq char ?-) + (setq char ?+)) + (if (string-match "\\*$\\|\\*&$" type) + (speedbar-make-tag-line + 'bracket char + 'gdb-speedbar-expand-node varnum + (concat expr "\t" type "\t" value) + (if (or parent (eq status 'out-of-scope)) + nil 'gdb-edit-value) + nil + (if gdb-show-changed-values + (or parent (pcase status + (`changed 'font-lock-warning-face) + (`out-of-scope 'shadow) + (_ t))) + t) + depth) + (speedbar-make-tag-line + 'bracket char + 'gdb-speedbar-expand-node varnum + (concat expr "\t" type) + nil nil + (if (and (or parent status) gdb-show-changed-values) + 'shadow t) + depth)))) + (setq var-list (cdr var-list))))) + (t (unless (and (save-excursion + (goto-char (point-min)) + (looking-at "Current Stack:")) + (equal mlgud-last-last-frame mlgud-last-speedbar-stackframe)) + (let ((mlgud-frame-list + (cond ;; Add more debuggers here! + (t (speedbar-remove-localized-speedbar-support buffer) + nil)))) + (erase-buffer) + (if (not mlgud-frame-list) + (insert "No Stack frames\n") + (insert "Current Stack:\n")) + (dolist (frame mlgud-frame-list) + (insert (nth 1 frame) ":\n") + (if (= (length frame) 2) + (progn + (speedbar-insert-button (car frame) + 'speedbar-directory-face + nil nil nil t)) + (speedbar-insert-button + (car frame) + 'speedbar-file-face + 'speedbar-highlight-face + (cond ((memq minor-mode '(gdbmi gdb)) + 'mlgud-gdb-goto-stackframe) + (t (error "Should never be here"))) + frame t)))) + (setq mlgud-last-speedbar-stackframe mlgud-last-last-frame)))) + (set-window-start window start) + (set-window-point window p)))) + + +;; When we send a command to the debugger via mlgud-call, it's annoying +;; to see the command and the new prompt inserted into the debugger's +;; buffer; we have other ways of knowing the command has completed. +;; +;; If the buffer looks like this: +;; -------------------- +;; (gdb) set args foo bar +;; (gdb) -!- +;; -------------------- +;; (the -!- marks the location of point), and we type `C-x SPC' in a +;; source file to set a breakpoint, we want the buffer to end up like +;; this: +;; -------------------- +;; (gdb) set args foo bar +;; Breakpoint 1 at 0x92: file make-docfile.c, line 49. +;; (gdb) -!- +;; -------------------- +;; Essentially, the old prompt is deleted, and the command's output +;; and the new prompt take its place. +;; +;; Not echoing the command is easy enough; you send it directly using +;; process-send-string, and it never enters the buffer. However, +;; getting rid of the old prompt is trickier; you don't want to do it +;; when you send the command, since that will result in an annoying +;; flicker as the prompt is deleted, redisplay occurs while Emacs +;; waits for a response from the debugger, and the new prompt is +;; inserted. Instead, we'll wait until we actually get some output +;; from the subprocess before we delete the prompt. If the command +;; produced no output other than a new prompt, that prompt will most +;; likely be in the first chunk of output received, so we will delete +;; the prompt and then replace it with an identical one. If the +;; command produces output, the prompt is moving anyway, so the +;; flicker won't be annoying. +;; +;; So - when we want to delete the prompt upon receipt of the next +;; chunk of debugger output, we position mlgud-delete-prompt-marker at +;; the start of the prompt; the process filter will notice this, and +;; delete all text between it and the process output marker. If +;; mlgud-delete-prompt-marker points nowhere, we leave the current +;; prompt alone. +(defvar mlgud-delete-prompt-marker nil) + + +(put 'mlgud-mode 'mode-class 'special) + +(define-derived-mode mlgud-mode comint-mode "Debugger" + "Major mode for interacting with an inferior debugger process. + + You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx, +M-x perldb, M-x xdb, or M-x jdb. Each entry point finishes by executing a +hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook', +`perldb-mode-hook', `xdb-mode-hook', or `jdb-mode-hook' respectively. + +After startup, the following commands are available in both the MLGUD +interaction buffer and any source buffer MLGUD visits due to a breakpoint stop +or step operation: + +\\[mlgud-break] sets a breakpoint at the current file and line. In the +MLGUD buffer, the current file and line are those of the last breakpoint or +step. In a source buffer, they are the buffer's file and current line. + +\\[mlgud-remove] removes breakpoints on the current file and line. + +\\[mlgud-refresh] displays in the source window the last line referred to +in the mlgud buffer. + +\\[mlgud-step], \\[mlgud-next], and \\[mlgud-stepi] do a step-one-line, +step-one-line (not entering function calls), and step-one-instruction +and then update the source window with the current file and position. +\\[mlgud-cont] continues execution. + +\\[mlgud-print] tries to find the largest C lvalue or function-call expression +around point, and sends it to the debugger for value display. + +The above commands are common to all supported debuggers except xdb which +does not support stepping instructions. + +Under gdb, sdb and xdb, \\[mlgud-tbreak] behaves exactly like \\[mlgud-break], +except that the breakpoint is temporary; that is, it is removed when +execution stops on it. + +Under gdb, dbx, and xdb, \\[mlgud-up] pops up through an enclosing stack +frame. \\[mlgud-down] drops back down through one. + +If you are using gdb or xdb, \\[mlgud-finish] runs execution to the return from +the current function and stops. + +All the keystrokes above are accessible in the MLGUD buffer +with the prefix C-c, and in all buffers through the prefix C-x C-a. + +All pre-defined functions for which the concept make sense repeat +themselves the appropriate number of times if you give a prefix +argument. + +You may use the `mlgud-def' macro in the initialization hook to define other +commands. + +Other commands for interacting with the debugger process are inherited from +comint mode, which see." + (setq mode-line-process '(":%s")) + (define-key (current-local-map) "\C-c\C-l" 'mlgud-refresh) + (set (make-local-variable 'mlgud-last-frame) nil) + (if (boundp 'tool-bar-map) ; not --without-x + (setq-local tool-bar-map mlgud-tool-bar-map)) + (make-local-variable 'comint-prompt-regexp) + ;; Don't put repeated commands in command history many times. + (set (make-local-variable 'comint-input-ignoredups) t) + (make-local-variable 'paragraph-start) + (set (make-local-variable 'mlgud-delete-prompt-marker) (make-marker)) + (add-hook 'kill-buffer-hook 'mlgud-kill-buffer-hook nil t)) + +(defun mlgud-set-buffer () + (when (derived-mode-p 'mlgud-mode) + (setq mlgud-comint-buffer (current-buffer)))) + +(defvar mlgud-filter-defer-flag nil + "Non-nil means don't process anything from the debugger right now. +It is saved for when this flag is not set.") + +;; These functions are responsible for inserting output from your debugger +;; into the buffer. The hard work is done by the method that is +;; the value of mlgud-marker-filter. + + +(defvar mlgud-filter-pending-text nil + "Non-nil means this is text that has been saved for later in `mlgud-filter'.") + +(defun mlgud-filter (proc string) + ;; Here's where the actual buffer insertion is done + (let (output process-window) + (if (buffer-name (process-buffer proc)) + (if mlgud-filter-defer-flag + ;; If we can't process any text now, + ;; save it for later. + (setq mlgud-filter-pending-text + (concat (or mlgud-filter-pending-text "") string)) + + ;; If we have to ask a question during the processing, + ;; defer any additional text that comes from the debugger + ;; during that time. + (let ((mlgud-filter-defer-flag t)) + ;; Process now any text we previously saved up. + (if mlgud-filter-pending-text + (setq string (concat mlgud-filter-pending-text string) + mlgud-filter-pending-text nil)) + + (with-current-buffer (process-buffer proc) + ;; If we have been so requested, delete the debugger prompt. + (save-restriction + (widen) + (if (marker-buffer mlgud-delete-prompt-marker) + (let ((inhibit-read-only t)) + (delete-region (process-mark proc) + mlgud-delete-prompt-marker) + (comint-update-fence) + (set-marker mlgud-delete-prompt-marker nil))) + ;; Save the process output, checking for source file markers. + (setq output (mlgud-marker-filter string)) + ;; Check for a filename-and-line number. + ;; Don't display the specified file + ;; unless (1) point is at or after the position where output appears + ;; and (2) this buffer is on the screen. + (setq process-window + (and mlgud-last-frame + (>= (point) (process-mark proc)) + (get-buffer-window (current-buffer))))) + + ;; Let the comint filter do the actual insertion. + ;; That lets us inherit various comint features. + (comint-output-filter proc output)) + + ;; Put the arrow on the source line. + ;; This must be outside of the save-excursion + ;; in case the source file is our current buffer. + (if process-window + (with-selected-window process-window + (mlgud-display-frame)) + ;; We have to be in the proper buffer, (process-buffer proc), + ;; but not in a save-excursion, because that would restore point. + (with-current-buffer (process-buffer proc) + (mlgud-display-frame)))) + + ;; If we deferred text that arrived during this processing, + ;; handle it now. + (if mlgud-filter-pending-text + (mlgud-filter proc "")))))) + +(defvar mlgud-minor-mode-type nil) +(defvar mlgud-overlay-arrow-position nil) +(add-to-list 'overlay-arrow-variable-list 'mlgud-overlay-arrow-position) + +(declare-function gdb-reset "gdb-mi" ()) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new)) +(defvar speedbar-previously-used-expansion-list-name) + +(defun mlgud-sentinel (proc msg) + (cond ((null (buffer-name (process-buffer proc))) + ;; buffer killed + ;; Stop displaying an arrow in a source file. + (setq mlgud-overlay-arrow-position nil) + (set-process-buffer proc nil) + (if (and (boundp 'speedbar-initial-expansion-list-name) + (string-equal speedbar-initial-expansion-list-name "mlMLGUD")) + (speedbar-change-initial-expansion-list + speedbar-previously-used-expansion-list-name)) + (if (eq mlgud-minor-mode-type 'gdbmi) + (gdb-reset) + (mlgud-reset))) + ((memq (process-status proc) '(signal exit)) + ;; Stop displaying an arrow in a source file. + (setq mlgud-overlay-arrow-position nil) + (if (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi) + (gdb-reset) + (mlgud-reset)) + (let* ((obuf (current-buffer))) + ;; save-excursion isn't the right thing if + ;; process-buffer is current-buffer + (unwind-protect + (progn + ;; Write something in the MLGUD buffer and hack its mode line, + (set-buffer (process-buffer proc)) + ;; Fix the mode line. + (setq mode-line-process + (concat ":" + (symbol-name (process-status proc)))) + (force-mode-line-update) + (if (eobp) + (insert ?\n mode-name " " msg) + (save-excursion + (goto-char (point-max)) + (insert ?\n mode-name " " msg))) + ;; If buffer and mode line will show that the process + ;; is dead, we can delete it now. Otherwise it + ;; will stay around until M-x list-processes. + (delete-process proc)) + ;; Restore old buffer, but don't restore old point + ;; if obuf is the mlgud buffer. + (set-buffer obuf)))))) + +(defun mlgud-kill-buffer-hook () + (setq mlgud-minor-mode-type mlgud-minor-mode) + (condition-case nil + (progn + (kill-process (get-buffer-process (current-buffer))) + (delete-process (get-process "gdb-inferior"))) + (error nil))) + +(defun mlgud-reset () + (dolist (buffer (buffer-list)) + (unless (eq buffer mlgud-comint-buffer) + (with-current-buffer buffer + (when mlgud-minor-mode + (setq mlgud-minor-mode nil) + (kill-local-variable 'tool-bar-map)))))) + +(defun mlgud-display-frame () + "Find and obey the last filename-and-line marker from the debugger. +Obeying it means displaying in another window the specified file and line." + (interactive) + (when mlgud-last-frame + (mlgud-set-buffer) + (mlgud-display-line (car mlgud-last-frame) (cdr mlgud-last-frame)) + (setq mlgud-last-last-frame mlgud-last-frame + mlgud-last-frame nil))) + +(declare-function global-hl-line-highlight "hl-line" ()) +(declare-function hl-line-highlight "hl-line" ()) +(declare-function gdb-display-source-buffer "gdb-mi" (buffer)) + +;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen +;; and that its line LINE is visible. +;; Put the overlay-arrow on the line LINE in that buffer. +;; Most of the trickiness in here comes from wanting to preserve the current +;; region-restriction if that's possible. We use an explicit display-buffer +;; to get around the fact that this is called inside a save-excursion. + +(defun mlgud-display-line (true-file line) + (let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions. + (buffer + (with-current-buffer mlgud-comint-buffer + (mlgud-find-file true-file))) + (window (and buffer + (or (get-buffer-window buffer) + (display-buffer buffer)))) + (pos)) + (when buffer + (with-current-buffer buffer + (unless (or (verify-visited-file-modtime buffer) mlgud-keep-buffer) + (if (yes-or-no-p + (format "File %s changed on disk. Reread from disk? " + (buffer-name))) + (revert-buffer t t) + (setq mlgud-keep-buffer t))) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (setq pos (point)) + (or mlgud-overlay-arrow-position + (setq mlgud-overlay-arrow-position (make-marker))) + (set-marker mlgud-overlay-arrow-position (point) (current-buffer)) + ;; If they turned on hl-line, move the hl-line highlight to + ;; the arrow's line. + (when (featurep 'hl-line) + (cond + (global-hl-line-mode + (global-hl-line-highlight)) + ((and hl-line-mode hl-line-sticky-flag) + (hl-line-highlight))))) + (cond ((or (< pos (point-min)) (> pos (point-max))) + (widen) + (goto-char pos)))) + (when window + (set-window-point window mlgud-overlay-arrow-position) + (if (eq mlgud-minor-mode 'gdbmi) + (setq gdb-source-window window)))))) + +;; The mlgud-call function must do the right thing whether its invoking +;; keystroke is from the MLGUD buffer itself (via major-mode binding) +;; or a C buffer. In the former case, we want to supply data from +;; mlgud-last-frame. Here's how we do it: + +(defun mlgud-format-command (str arg) + (let ((insource (not (eq (current-buffer) mlgud-comint-buffer))) + (frame (or mlgud-last-frame mlgud-last-last-frame)) + result) + (while (and str + (let ((case-fold-search nil)) + (string-match "\\([^%]*\\)%\\([adefFlpc]\\)" str))) + (let ((key (string-to-char (match-string 2 str))) + subst) + (cond + ((eq key ?f) + (setq subst (file-name-nondirectory (if insource + (buffer-file-name) + (car frame))))) + ((eq key ?F) + (setq subst (file-name-base (if insource + (buffer-file-name) + (car frame))))) + ((eq key ?d) + (setq subst (file-name-directory (if insource + (buffer-file-name) + (car frame))))) + ((eq key ?l) + (setq subst (int-to-string + (if insource + (save-restriction + (widen) + (+ (count-lines (point-min) (point)) + (if (bolp) 1 0))) + (cdr frame))))) + ((eq key ?e) + (setq subst (mlgud-find-expr))) + ((eq key ?a) + (setq subst (mlgud-read-address))) + + ((eq key ?p) + (setq subst (if arg (int-to-string arg))))) + (setq result (concat result (match-string 1 str) subst))) + (setq str (substring str (match-end 2)))) + ;; There might be text left in STR when the loop ends. + (concat result str))) + +(defun mlgud-read-address () + "Return a string containing the core-address found in the buffer at point." + (save-match-data + (save-excursion + (let ((pt (point)) found begin) + (setq found (if (search-backward "0x" (- pt 7) t) (point))) + (cond + (found (forward-char 2) + (buffer-substring found + (progn (re-search-forward "[^0-9a-f]") + (forward-char -1) + (point)))) + (t (setq begin (progn (re-search-backward "[^0-9]") + (forward-char 1) + (point))) + (forward-char 1) + (re-search-forward "[^0-9]") + (forward-char -1) + (buffer-substring begin (point)))))))) + +(defun mlgud-call (fmt &optional arg) + (let ((msg (mlgud-format-command fmt arg))) + (message "Command: %s" msg) + (sit-for 0) + (mlgud-basic-call msg))) + +(defun mlgud-basic-call (command) + "Invoke the debugger COMMAND displaying source in other window." + (interactive) + (mlgud-set-buffer) + (let ((proc (get-buffer-process mlgud-comint-buffer))) + (or proc (error "Current buffer has no process")) + ;; Arrange for the current prompt to get deleted. + (with-current-buffer mlgud-comint-buffer + (save-excursion + (save-restriction + (widen) + (if (marker-position mlgud-delete-prompt-marker) + ;; We get here when printing an expression. + (goto-char mlgud-delete-prompt-marker) + (goto-char (process-mark proc)) + (forward-line 0)) + (if (looking-at comint-prompt-regexp) + (set-marker mlgud-delete-prompt-marker (point))) + (if (eq mlgud-minor-mode 'gdbmi) + (apply comint-input-sender (list proc command)) + (process-send-string proc (concat command "\n")))))))) + +(defun mlgud-refresh (&optional arg) + "Fix up a possibly garbled display, and redraw the arrow." + (interactive "P") + (or mlgud-last-frame (setq mlgud-last-frame mlgud-last-last-frame)) + (mlgud-display-frame) + (recenter arg)) + +;; Code for parsing expressions out of C or Fortran code. The single entry +;; point is mlgud-find-expr, which tries to return an lvalue expression from +;; around point. + +(defvar mlgud-find-expr-function 'mlgud-find-c-expr) + +(defun mlgud-find-expr (&rest args) + (let ((expr (if (and transient-mark-mode mark-active) + (buffer-substring (region-beginning) (region-end)) + (apply mlgud-find-expr-function args)))) + (save-match-data + (if (string-match "\n" expr) + (error "Expression must not include a newline")) + (with-current-buffer mlgud-comint-buffer + (save-excursion + (goto-char (process-mark (get-buffer-process mlgud-comint-buffer))) + (forward-line 0) + (when (looking-at comint-prompt-regexp) + (set-marker mlgud-delete-prompt-marker (point)) + (set-marker-insertion-type mlgud-delete-prompt-marker t)) + (unless (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'jdb) + (insert (concat expr " = ")))))) + expr)) + +;; The next eight functions are hacked from gdbsrc.el by +;; Debby Ayers , +;; Rich Schaefer Schlumberger, Austin, Tx. + +(defun mlgud-find-c-expr () + "Returns the expr that surrounds point." + (interactive) + (save-excursion + (let ((p (point)) + (expr (mlgud-innermost-expr)) + (test-expr (mlgud-prev-expr))) + (while (and test-expr (mlgud-expr-compound test-expr expr)) + (let ((prev-expr expr)) + (setq expr (cons (car test-expr) (cdr expr))) + (goto-char (car expr)) + (setq test-expr (mlgud-prev-expr)) + ;; If we just pasted on the condition of an if or while, + ;; throw it away again. + (if (member (buffer-substring (car test-expr) (cdr test-expr)) + '("if" "while" "for")) + (setq test-expr nil + expr prev-expr)))) + (goto-char p) + (setq test-expr (mlgud-next-expr)) + (while (mlgud-expr-compound expr test-expr) + (setq expr (cons (car expr) (cdr test-expr))) + (setq test-expr (mlgud-next-expr))) + (buffer-substring (car expr) (cdr expr))))) + +(defun mlgud-innermost-expr () + "Returns the smallest expr that point is in; move point to beginning of it. +The expr is represented as a cons cell, where the car specifies the point in +the current buffer that marks the beginning of the expr and the cdr specifies +the character after the end of the expr." + (let ((p (point)) begin end) + (mlgud-backward-sexp) + (setq begin (point)) + (mlgud-forward-sexp) + (setq end (point)) + (if (>= p end) + (progn + (setq begin p) + (goto-char p) + (mlgud-forward-sexp) + (setq end (point))) + ) + (goto-char begin) + (cons begin end))) + +(defun mlgud-backward-sexp () + "Version of `backward-sexp' that catches errors." + (condition-case nil + (backward-sexp) + (error t))) + +(defun mlgud-forward-sexp () + "Version of `forward-sexp' that catches errors." + (condition-case nil + (forward-sexp) + (error t))) + +(defun mlgud-prev-expr () + "Returns the previous expr, point is set to beginning of that expr. +The expr is represented as a cons cell, where the car specifies the point in +the current buffer that marks the beginning of the expr and the cdr specifies +the character after the end of the expr" + (let ((begin) (end)) + (mlgud-backward-sexp) + (setq begin (point)) + (mlgud-forward-sexp) + (setq end (point)) + (goto-char begin) + (cons begin end))) + +(defun mlgud-next-expr () + "Returns the following expr, point is set to beginning of that expr. +The expr is represented as a cons cell, where the car specifies the point in +the current buffer that marks the beginning of the expr and the cdr specifies +the character after the end of the expr." + (let ((begin) (end)) + (mlgud-forward-sexp) + (mlgud-forward-sexp) + (setq end (point)) + (mlgud-backward-sexp) + (setq begin (point)) + (cons begin end))) + +(defun mlgud-expr-compound-sep (span-start span-end) + "Scan from SPAN-START to SPAN-END for punctuation characters. +If `->' is found, return `?.'. If `.' is found, return `?.'. +If any other punctuation is found, return `??'. +If no punctuation is found, return `? '." + (let ((result ?\s) + (syntax)) + (while (< span-start span-end) + (setq syntax (char-syntax (char-after span-start))) + (cond + ((= syntax ?\s) t) + ((= syntax ?.) (setq syntax (char-after span-start)) + (cond + ((= syntax ?.) (setq result ?.)) + ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>)) + (setq result ?.) + (setq span-start (+ span-start 1))) + (t (setq span-start span-end) + (setq result ??))))) + (setq span-start (+ span-start 1))) + result)) + +(defun mlgud-expr-compound (first second) + "Non-nil if concatenating FIRST and SECOND makes a single C expression. +The two exprs are represented as a cons cells, where the car +specifies the point in the current buffer that marks the beginning of the +expr and the cdr specifies the character after the end of the expr. +Link exprs of the form: + Expr -> Expr + Expr . Expr + Expr (Expr) + Expr [Expr] + (Expr) Expr + [Expr] Expr" + (let ((span-start (cdr first)) + (span-end (car second)) + (syntax)) + (setq syntax (mlgud-expr-compound-sep span-start span-end)) + (cond + ((= (car first) (car second)) nil) + ((= (cdr first) (cdr second)) nil) + ((= syntax ?.) t) + ((= syntax ?\s) + (setq span-start (char-after (- span-start 1))) + (setq span-end (char-after span-end)) + (cond + ((= span-start ?\)) t) + ((= span-start ?\]) t) + ((= span-end ?\() t) + ((= span-end ?\[) t) + (t nil))) + (t nil)))) + + + + +;;; tooltips for MLGUD + +;;; Customizable settings + +(defvar tooltip-mode) + +;;;###autoload +(define-minor-mode mlgud-tooltip-mode + "Toggle the display of MLGUD tooltips. +With a prefix argument ARG, enable the feature if ARG is +positive, and disable it otherwise. If called from Lisp, enable +it if ARG is omitted or nil." + :global t + :group 'mlgud + :group 'tooltip + (require 'tooltip) + (if mlgud-tooltip-mode + (progn + (add-hook 'change-major-mode-hook 'mlgud-tooltip-change-major-mode) + (add-hook 'pre-command-hook 'tooltip-hide) + (add-hook 'tooltip-functions 'mlgud-tooltip-tips) + (define-key global-map [mouse-movement] 'mlgud-tooltip-mouse-motion)) + (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide) + (remove-hook 'change-major-mode-hook 'mlgud-tooltip-change-major-mode) + (remove-hook 'tooltip-functions 'mlgud-tooltip-tips) + (define-key global-map [mouse-movement] 'ignore))) + (mlgud-tooltip-activate-mouse-motions-if-enabled) + (if (and mlgud-comint-buffer + (buffer-name mlgud-comint-buffer); mlgud-comint-buffer might be killed + (eq (buffer-local-value 'mlgud-minor-mode mlgud-comint-buffer) + 'gdbmi)) + (if mlgud-tooltip-mode + (progn + (dolist (buffer (buffer-list)) + (unless (eq buffer mlgud-comint-buffer) + (with-current-buffer buffer + (when (and (eq mlgud-minor-mode 'gdbmi) + (not (string-match "\\`\\*.+\\*\\'" + (buffer-name)))) + (make-local-variable 'gdb-define-alist) + (gdb-create-define-alist) + (add-hook 'after-save-hook + 'gdb-create-define-alist nil t)))))) + (kill-local-variable 'gdb-define-alist) + (remove-hook 'after-save-hook 'gdb-create-define-alist t)))) + +(defcustom mlgud-tooltip-modes '(mlgud-mode c-mode c++-mode fortran-mode + python-mode) + "List of modes for which to enable MLGUD tooltips." + :type 'sexp + :group 'mlgud + :group 'tooltip) + +(defcustom mlgud-tooltip-display + '((eq (tooltip-event-buffer mlgud-tooltip-event) + (marker-buffer mlgud-overlay-arrow-position))) + "List of forms determining where MLGUD tooltips are displayed. + +Forms in the list are combined with AND. The default is to display +only tooltips in the buffer containing the overlay arrow." + :type 'sexp + :group 'mlgud + :group 'tooltip) + +(defcustom mlgud-tooltip-echo-area nil + "Use the echo area instead of frames for MLGUD tooltips." + :type 'boolean + :group 'mlgud + :group 'tooltip) + +(make-obsolete-variable 'mlgud-tooltip-echo-area + "disable Tooltip mode instead" "24.4" 'set) + +;;; Reacting on mouse movements + +(defun mlgud-tooltip-change-major-mode () + "Function added to `change-major-mode-hook' when tooltip mode is on." + (add-hook 'post-command-hook 'mlgud-tooltip-activate-mouse-motions-if-enabled)) + +(defun mlgud-tooltip-activate-mouse-motions-if-enabled () + "Reconsider for all buffers whether mouse motion events are desired." + (remove-hook 'post-command-hook + 'mlgud-tooltip-activate-mouse-motions-if-enabled) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (if (and mlgud-tooltip-mode + (memq major-mode mlgud-tooltip-modes)) + (mlgud-tooltip-activate-mouse-motions t) + (mlgud-tooltip-activate-mouse-motions nil))))) + +(defvar mlgud-tooltip-mouse-motions-active nil + "Locally t in a buffer if tooltip processing of mouse motion is enabled.") + +;; We don't set track-mouse globally because this is a big redisplay +;; problem in buffers having a pre-command-hook or such installed, +;; which does a set-buffer, like the summary buffer of Gnus. Calling +;; set-buffer prevents redisplay optimizations, so every mouse motion +;; would be accompanied by a full redisplay. + +(defun mlgud-tooltip-activate-mouse-motions (activatep) + "Activate/deactivate mouse motion events for the current buffer. +ACTIVATEP non-nil means activate mouse motion events." + (if activatep + (progn + (set (make-local-variable 'mlgud-tooltip-mouse-motions-active) t) + (set (make-local-variable 'track-mouse) t)) + (when mlgud-tooltip-mouse-motions-active + (kill-local-variable 'mlgud-tooltip-mouse-motions-active) + (kill-local-variable 'track-mouse)))) + +(defvar tooltip-last-mouse-motion-event) +(declare-function tooltip-hide "tooltip" (&optional ignored-arg)) +(declare-function tooltip-start-delayed-tip "tooltip" ()) + +(defun mlgud-tooltip-mouse-motion (event) + "Command handler for mouse movement events in `global-map'." + (interactive "e") + (tooltip-hide) + (when (car (mouse-pixel-position)) + (setq tooltip-last-mouse-motion-event (copy-sequence event)) + (tooltip-start-delayed-tip))) + +;;; Tips for `mlgud' + +(defvar mlgud-tooltip-dereference nil + "Non-nil means print expressions with a `*' in front of them. +For C this would dereference a pointer expression.") + +(defvar mlgud-tooltip-event nil + "The mouse movement event that led to a tooltip display. +This event can be examined by forms in `mlgud-tooltip-display'.") + +(defun mlgud-tooltip-dereference (&optional arg) + "Toggle whether tooltips should show `* expr' or `expr'. +With arg, dereference expr if ARG is positive, otherwise do not dereference." + (interactive "P") + (setq mlgud-tooltip-dereference + (if (null arg) + (not mlgud-tooltip-dereference) + (> (prefix-numeric-value arg) 0))) + (message "Dereferencing is now %s." + (if mlgud-tooltip-dereference "on" "off"))) + +(defvar tooltip-use-echo-area) +(declare-function tooltip-show "tooltip" (text &optional use-echo-area)) +(declare-function tooltip-strip-prompt "tooltip" (process output)) + +; This will only display data that comes in one chunk. +; Larger arrays (say 400 elements) are displayed in +; the tooltip incompletely and spill over into the mlgud buffer. +; Switching the process-filter creates timing problems and +; it may be difficult to do better. Using GDB/MI as in +; gdb-mi.el gets around this problem. +(defun mlgud-tooltip-process-output (process output) + "Process debugger output and show it in a tooltip window." + (remove-function (process-filter process) #'mlgud-tooltip-process-output) + (tooltip-show (tooltip-strip-prompt process output) + (or mlgud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode)))) + +(defun mlgud-tooltip-print-command (expr) + "Return a suitable command to print the expression EXPR." + (pcase mlgud-minor-mode + (`gdbmi (concat "-data-evaluate-expression \"" expr "\"")) + (`dbx (concat "print " expr)) + ((or `xdb `pdb) (concat "p " expr)) + (`sdb (concat expr "/")))) + +(declare-function gdb-input "gdb-mi" (command handler &optional trigger)) +(declare-function tooltip-expr-to-print "tooltip" (event)) +(declare-function tooltip-event-buffer "tooltip" (event)) + +(defun mlgud-tooltip-tips (event) + "Show tip for identifier or selection under the mouse. +The mouse must either point at an identifier or inside a selected +region for the tip window to be shown. If `mlgud-tooltip-dereference' is t, +add a `*' in front of the printed expression. In the case of a C program +controlled by GDB, show the associated #define directives when program is +not executing. + +This function must return nil if it doesn't handle EVENT." + (let (process) + (when (and (eventp event) + mlgud-tooltip-mode + mlgud-comint-buffer + (buffer-name mlgud-comint-buffer); might be killed + (setq process (get-buffer-process mlgud-comint-buffer)) + (posn-point (event-end event)) + (or (and (eq mlgud-minor-mode 'gdbmi) (not gdb-active-process)) + (progn (setq mlgud-tooltip-event event) + (eval (cons 'and mlgud-tooltip-display))))) + (let ((expr (tooltip-expr-to-print event))) + (when expr + (if (and (eq mlgud-minor-mode 'gdbmi) + (not gdb-active-process)) + (progn + (with-current-buffer (tooltip-event-buffer event) + (let ((define-elt (assoc expr gdb-define-alist))) + (unless (null define-elt) + (tooltip-show + (cdr define-elt) + (or mlgud-tooltip-echo-area tooltip-use-echo-area + (not tooltip-mode))) + expr)))) + (when mlgud-tooltip-dereference + (setq expr (concat "*" expr))) + (let ((cmd (mlgud-tooltip-print-command expr))) + (when (and mlgud-tooltip-mode (eq mlgud-minor-mode 'gdb)) + (mlgud-tooltip-mode -1) + ;; The blank before the newline is for MS-Windows, + ;; whose emulation of message box removes newlines and + ;; displays a single long line. + (message-box "Using MLGUD tooltips in this mode is unsafe \n\ +so they have been disabled.")) + (unless (null cmd) ; CMD can be nil if unknown debugger + (if (eq mlgud-minor-mode 'gdbmi) + (if gdb-macro-info + (gdb-input + (concat + "server macro expand " expr "\n") + `(lambda () (gdb-tooltip-print-1 ,expr))) + (gdb-input + (concat cmd "\n") + `(lambda () (gdb-tooltip-print ,expr)))) + (add-function :override (process-filter process) + #'mlgud-tooltip-process-output) + (mlgud-basic-call cmd)) + expr)))))))) + +(provide 'mlgud) + +;;; mlgud.el ends here