• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.10/emacs-93/emacs/lisp/progmodes/

Lines Matching +defs:gud +defs:gdb +defs:command +defs:name

0 ;;; gdb-ui.el --- User Interface for running GDB
37 ;; By default, M-x gdb will start the debugger. However, if you have customised
38 ;; gud-gdb-command-name, then start it with M-x gdba.
48 ;; it. Some GDB/MI commands are used in this file through the CLI command
49 ;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included with
76 ;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead.
77 ;; 4) M-x gdb doesn't work if the corefile is specified in the command in the
81 ;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed.
83 ;; (gud-go) sends "continue" to GDB (should be "run").
94 ;; 1) Use MI command -data-read-memory for memory window.
100 (require 'gud)
103 (defvar speedbar-initial-expansion-list-name)
105 (defvar gdb-pc-address nil "Initialization for Assembler buffer.
106 Set to \"main\" at start if gdb-show-main is t.")
107 (defvar gdb-frame-address nil "Identity of frame for watch expression.")
108 (defvar gdb-previous-frame-address nil)
109 (defvar gdb-memory-address "main")
110 (defvar gdb-previous-frame nil)
111 (defvar gdb-selected-frame nil)
112 (defvar gdb-frame-number nil)
113 (defvar gdb-current-language nil)
114 (defvar gdb-var-list nil
119 (defvar gdb-main-file nil "Source file from which program execution begins.")
120 (defvar gud-old-arrow nil)
121 (defvar gdb-overlay-arrow-position nil)
122 (defvar gdb-stack-position nil)
123 (defvar gdb-server-prefix nil)
124 (defvar gdb-flush-pending-output nil)
125 (defvar gdb-location-alist nil
128 (defvar gdb-active-process nil
130 (defvar gdb-error "Non-nil when GDB is reporting an error.")
131 (defvar gdb-macro-info nil
133 (defvar gdb-buffer-fringe-width nil)
134 (defvar gdb-signalled nil)
135 (defvar gdb-source-window nil)
136 (defvar gdb-inferior-status nil)
137 (defvar gdb-continuation nil)
138 (defvar gdb-look-up-stack nil)
139 (defvar gdb-frame-begin nil
141 (defvar gdb-printing t)
143 (defvar gdb-buffer-type nil
144 "One of the symbols bound in `gdb-buffer-rules'.")
145 (make-variable-buffer-local 'gdb-buffer-type)
147 (defvar gdb-input-queue ()
148 "A list of gdb command objects.")
150 (defvar gdb-prompting nil
151 "True when gdb is idle with no pending input.")
153 (defvar gdb-output-sink 'user
154 "The disposition of the output of the current gdb command.
157 `user' -- gdb output should be copied to the GUD buffer
160 `inferior' -- gdb output should be copied to the inferior-io buffer.
166 for subsequent processing by a command. This is the
168 gdb mode sends to gdb on its own behalf.
172 gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
175 (defvar gdb-current-item nil
176 "The most recent command item sent to gdb.")
178 (defvar gdb-pending-triggers '()
182 (defvar gdb-first-post-prompt nil)
183 (defvar gdb-version nil)
184 (defvar gdb-locals-font-lock-keywords nil)
185 (defvar gdb-source-file-list nil
187 (defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"")
189 (defvar gdb-locals-font-lock-keywords-1
193 (1 font-lock-variable-name-face)
198 (1 font-lock-variable-name-face)
202 (1 font-lock-variable-name-face))
204 "Font lock keywords used in `gdb-local-mode'.")
206 (defvar gdb-locals-font-lock-keywords-2
210 (1 font-lock-variable-name-face)
213 "Font lock keywords used in `gdb-local-mode'.")
216 (defvar gdb-register-names nil "List of register names.")
217 (defvar gdb-changed-registers nil
221 (defun gdba (command-line)
222 "Run gdb on program FILE in buffer *gud-FILE*.
226 If `gdb-many-windows' is nil (the default value) then gdb just
227 pops up the GUD buffer unless `gdb-show-main' is t. In this case
231 If `gdb-many-windows' is t, regardless of the value of
232 `gdb-show-main', the layout below will appear unless
233 `gdb-use-separate-io-buffer' is nil when the source buffer
241 `gdb-many-windows' - Toggle the number of windows gdb uses.
242 `gdb-restore-windows' - To restore the window layout.
266 | RET gdb-frames-select | SPC gdb-toggle-breakpoint |
267 | | RET gdb-goto-breakpoint |
268 | | D gdb-delete-breakpoint |
271 (interactive (list (gud-query-cmdline 'gdba)))
273 ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
274 (gdb command-line)
275 (gdb-init-1))
277 (defcustom gdb-debug-log-max 128
278 "Maximum size of `gdb-debug-log'. If nil, size is unlimited."
279 :group 'gud
284 (defvar gdb-debug-log nil
287 'gdb-debug-log-max' values. This variable is used to debug
291 (defcustom gdb-enable-debug nil
292 "Non-nil means record the process input and output in `gdb-debug-log'."
294 :group 'gud
297 (defcustom gdb-cpp-define-alist-program "gcc -E -dM -"
298 "Shell command for generating a list of defined macros in a source file.
301 GDB, when gud-tooltip-mode is t.
303 Set `gdb-cpp-define-alist-flags' for any include paths or
306 :group 'gud
309 (defcustom gdb-cpp-define-alist-flags ""
310 "Preprocessor flags for `gdb-cpp-define-alist-program'."
312 :group 'gud
315 (defcustom gdb-show-main nil
319 :group 'gud
322 (defcustom gdb-many-windows nil
323 "If nil, just pop up the GUD buffer unless `gdb-show-main' is t.
329 :group 'gud
332 (defcustom gdb-use-separate-io-buffer nil
335 :group 'gud
338 (defun gdb-force-mode-line-update (status)
339 (let ((buffer gud-comint-buffer))
340 (if (and buffer (buffer-name buffer))
348 (defun gdb-many-windows (arg)
352 (setq gdb-many-windows
354 (not gdb-many-windows)
357 (if gdb-many-windows "en" "dis")))
358 (if (and gud-comint-buffer
359 (buffer-name gud-comint-buffer))
361 (gdb-restore-windows)
364 (defun gdb-use-separate-io-buffer (arg)
368 (setq gdb-use-separate-io-buffer
370 (not gdb-use-separate-io-buffer)
373 (if gdb-use-separate-io-buffer "en" "dis")))
374 (if (and gud-comint-buffer
375 (buffer-name gud-comint-buffer))
377 (if gdb-use-separate-io-buffer
378 (if gdb-many-windows (gdb-restore-windows))
379 (kill-buffer (gdb-inferior-io-name)))
382 (defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
384 (defun gdb-create-define-alist ()
386 (let* ((file (buffer-file-name))
390 (call-process shell-file-name
393 (concat gdb-cpp-define-alist-program " "
394 gdb-cpp-define-alist-flags)))))
395 (define-list (split-string output "\n" t)) (name))
396 (setq gdb-define-alist nil)
398 (setq name (nth 1 (split-string define "[( ]")))
399 (push (cons name define) gdb-define-alist))))
401 (defun gdb-tooltip-print (expr)
403 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
409 ;; remove newline for gud-tooltip-echo-area
411 (or gud-tooltip-echo-area tooltip-use-echo-area)))
416 (defun gdb-tooltip-print-1 (expr)
417 (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
421 (gdb-enqueue-input
422 (list (concat gdb-server-prefix "print " expr "\n")
423 `(lambda () (gdb-tooltip-print ,expr))))))))
425 (defconst gdb-source-file-regexp "\\(.+?\\), \\|\\([^, \n].*$\\)")
427 (defun gdb-set-gud-minor-mode-existing-buffers ()
431 (while (re-search-forward gdb-source-file-regexp nil t)
432 (push (file-name-nondirectory (or (match-string 1) (match-string 2)))
433 gdb-source-file-list))
436 (when (and buffer-file-name
437 (member (file-name-nondirectory buffer-file-name)
438 gdb-source-file-list))
439 (set (make-local-variable 'gud-minor-mode) 'gdba)
440 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
441 (when gud-tooltip-mode
442 (make-local-variable 'gdb-define-alist)
443 (gdb-create-define-alist)
444 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))
445 (gdb-force-mode-line-update
446 (propertize "ready" 'face font-lock-variable-name-face)))
448 (defun gdb-find-watch-expression ()
449 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
452 (let ((var1 (assoc (match-string 1 varnum) gdb-var-list)) var2 varnumlet
457 (setq var2 (assoc varnumlet gdb-var-list))
465 (defun gdb-init-1 ()
466 (set (make-local-variable 'gud-minor-mode) 'gdba)
467 (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
469 (gud-def gud-break (if (not (string-match "Machine" mode-name))
470 (gud-call "break %f:%l" arg)
474 (gud-call "break *%a" arg)))
477 (gud-def gud-remove (if (not (string-match "Machine" mode-name))
478 (gud-call "clear %f:%l" arg)
482 (gud-call "clear *%a" arg)))
485 (gud-def gud-until (if (not (string-match "Machine" mode-name))
486 (gud-call "until %f:%l" arg)
490 (gud-call "until *%a" arg)))
493 (gud-def gud-go (gud-call (if gdb-active-process "continue" "run") arg)
497 (gud-def gud-pp
498 (gud-call
502 (gdb-find-watch-expression) "%e")) arg)
505 (define-key gud-minor-mode-map [left-margin mouse-1]
506 'gdb-mouse-set-clear-breakpoint)
507 (define-key gud-minor-mode-map [left-fringe mouse-1]
508 'gdb-mouse-set-clear-breakpoint)
509 (define-key gud-minor-mode-map [left-margin C-mouse-1]
510 'gdb-mouse-toggle-breakpoint-margin)
511 (define-key gud-minor-mode-map [left-fringe C-mouse-1]
512 'gdb-mouse-toggle-breakpoint-fringe)
514 (define-key gud-minor-mode-map [left-margin drag-mouse-1]
515 'gdb-mouse-until)
516 (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
517 'gdb-mouse-until)
518 (define-key gud-minor-mode-map [left-margin mouse-3]
519 'gdb-mouse-until)
520 (define-key gud-minor-mode-map [left-fringe mouse-3]
521 'gdb-mouse-until)
523 (define-key gud-minor-mode-map [left-margin C-drag-mouse-1]
524 'gdb-mouse-jump)
525 (define-key gud-minor-mode-map [left-fringe C-drag-mouse-1]
526 'gdb-mouse-jump)
527 (define-key gud-minor-mode-map [left-fringe C-mouse-3]
528 'gdb-mouse-jump)
529 (define-key gud-minor-mode-map [left-margin C-mouse-3]
530 'gdb-mouse-jump)
532 (setq comint-input-sender 'gdb-send)
535 (setq gdb-pc-address (if gdb-show-main "main" nil))
536 (setq gdb-previous-frame-address nil
537 gdb-memory-address "main"
538 gdb-previous-frame nil
539 gdb-selected-frame nil
540 gdb-current-language nil
541 gdb-frame-number nil
542 gdb-var-list nil
543 gdb-main-file nil
544 gdb-first-post-prompt t
545 gdb-prompting nil
546 gdb-input-queue nil
547 gdb-current-item nil
548 gdb-pending-triggers nil
549 gdb-output-sink 'user
550 gdb-server-prefix "server "
551 gdb-flush-pending-output nil
552 gdb-location-alist nil
553 gdb-source-file-list nil
554 gdb-error nil
555 gdb-macro-info nil
556 gdb-buffer-fringe-width (car (window-fringes))
557 gdb-debug-log nil
558 gdb-signalled nil
559 gdb-source-window nil
560 gdb-inferior-status nil
561 gdb-continuation nil
562 gdb-look-up-stack nil
563 gdb-frame-begin nil
564 gdb-printing t
565 gud-old-arrow nil)
567 (setq gdb-buffer-type 'gdba)
569 (if gdb-use-separate-io-buffer (gdb-clear-inferior-io))
572 (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n"
573 'gdb-get-version)))
575 (defun gdb-init-2 ()
577 (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
578 (gdb-enqueue-input (list "set height 0\n" 'ignore))
579 (gdb-enqueue-input (list "set width 0\n" 'ignore))
581 (if (string-equal gdb-version "pre-6.4")
583 (gdb-enqueue-input (list (concat gdb-server-prefix "info sources\n")
584 'gdb-set-gud-minor-mode-existing-buffers))
585 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1))
586 (gdb-enqueue-input
588 'gdb-get-register-names))
590 (gdb-enqueue-input
592 'gdb-set-gud-minor-mode-existing-buffers-1))
593 (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2))
597 (gdb-enqueue-input (list "server list\n" 'ignore))
598 (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))
602 (defun gdb-get-version ()
604 (if (re-search-forward "Undefined\\( mi\\)* command:" nil t)
605 (setq gdb-version "pre-6.4")
606 (setq gdb-version "6.4+"))
607 (gdb-init-2))
609 (defmacro gdb-if-arrow (arrow-position &rest body)
619 (defun gdb-mouse-until (event)
627 (gdb-if-arrow gud-overlay-arrow-position
629 (gud-call (concat "until " (number-to-string line))))
630 (gdb-if-arrow gdb-overlay-arrow-position
634 (gud-call (concat "until *%a"))))))
636 (defun gdb-mouse-jump (event)
640 Unlike gdb-mouse-until the destination address can be before the current
645 (gdb-if-arrow gud-overlay-arrow-position
648 (gud-call (concat "tbreak " (number-to-string line)))
649 (gud-call (concat "jump " (number-to-string line)))))
650 (gdb-if-arrow gdb-overlay-arrow-position
655 (gud-call (concat "tbreak *%a"))
656 (gud-call (concat "jump *%a")))))))
658 (defcustom gdb-speedbar-auto-raise nil
662 :group 'gud
665 (defun gdb-speedbar-auto-raise (arg)
669 (setq gdb-speedbar-auto-raise
671 (not gdb-speedbar-auto-raise)
674 (if gdb-speedbar-auto-raise "en" "dis"))))
676 (defcustom gdb-use-colon-colon-notation nil
679 :group 'gud
682 (define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
683 (define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
685 (defun gud-watch (&optional arg event)
687 With arg, enter name of variable to be watched in the minibuffer."
689 (let ((minor-mode (buffer-local-value 'gud-minor-mode gud-comint-buffer)))
698 'gud-gdb-complete-command)
704 (gdb-enqueue-input
710 `(lambda () (gdb-var-create-handler ,expr)))))))
711 (message "gud-watch is a no-op in this mode."))))
713 (defconst gdb-var-create-regexp
714 "name=\"\\(.*?\\)\",.*numchild=\"\\(.*?\\)\",\\(?:.*value=\\(\".*\"\\),\\)?.*type=\"\\(.*?\\)\"")
716 (defun gdb-var-create-handler (expr)
718 (if (re-search-forward gdb-var-create-regexp nil t)
721 (if (and (string-equal gdb-current-language "c")
722 gdb-use-colon-colon-notation gdb-selected-frame)
723 (setq expr (concat gdb-selected-frame "::" expr))
728 nil gdb-frame-address)))
729 (push var gdb-var-list)
731 speedbar-initial-expansion-list-name "GUD")
734 (gdb-enqueue-input
736 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
741 `(lambda () (gdb-var-evaluate-expression-handler
743 (if (search-forward "Undefined command" nil t)
747 (defun gdb-speedbar-update ()
749 (not (member 'gdb-speedbar-timer gdb-pending-triggers)))
750 ;; Dummy command to update speedbar even when idle.
751 (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
752 ;; Keep gdb-pending-triggers non-nil till end.
753 (push 'gdb-speedbar-timer gdb-pending-triggers)))
755 (defun gdb-speedbar-timer-fn ()
756 (setq gdb-pending-triggers
757 (delq 'gdb-speedbar-timer gdb-pending-triggers))
760 (defun gdb-var-evaluate-expression-handler (varnum changed)
763 (setq gdb-pending-triggers
764 (delq (string-to-number (match-string 1)) gdb-pending-triggers))
765 (let ((var (assoc varnum gdb-var-list)))
769 (gdb-speedbar-update))
771 (defun gdb-var-list-children (varnum)
772 (gdb-enqueue-input
774 `(lambda () (gdb-var-list-children-handler ,varnum)))))
776 (defconst gdb-var-list-children-regexp
777 "child={.*?name=\"\\(.*?\\)\",.*?exp=\"\\(.*?\\)\",.*?\
780 (defun gdb-var-list-children-handler (varnum)
784 (dolist (var gdb-var-list)
788 (while (re-search-forward gdb-var-list-children-regexp nil t)
794 (if (assoc (car varchild) gdb-var-list)
797 (gdb-enqueue-input
802 `(lambda () (gdb-var-evaluate-expression-handler
805 (setq gdb-var-list (nreverse var-list)))))
807 (defun gdb-var-update ()
808 (when (not (member 'gdb-var-update gdb-pending-triggers))
809 (gdb-enqueue-input
811 'gdb-var-update-handler))
812 (push 'gdb-var-update gdb-pending-triggers)))
814 (defconst gdb-var-update-regexp
815 "{.*?name=\"\\(.*?\\)\",.*?in_scope=\"\\(.*?\\)\",.*?\
818 (defun gdb-var-update-handler ()
819 (dolist (var gdb-var-list)
823 (while (re-search-forward gdb-var-update-regexp nil t)
826 (let ((var (assoc varnum gdb-var-list)))
829 (push n gdb-pending-triggers)
830 (gdb-enqueue-input
834 `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))))
835 (setq gdb-pending-triggers
836 (delq 'gdb-var-update gdb-pending-triggers)))
838 (defun gdb-var-delete-1 (varnum)
839 (gdb-enqueue-input
841 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
846 (setq gdb-var-list (delq var gdb-var-list))
847 (dolist (varchild gdb-var-list)
849 (setq gdb-var-list (delq varchild gdb-var-list)))))
851 (defun gdb-var-delete ()
854 (if (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
856 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
860 (gdb-var-delete-1 varnum)))))
862 (defun gdb-var-delete-children (varnum)
864 (gdb-enqueue-input
866 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
870 (defun gdb-edit-value (text token indent)
872 (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
875 (gdb-enqueue-input
877 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
881 `(lambda () (gdb-edit-value-handler ,value))))))
883 (defun gdb-edit-value-handler (value)
885 (if (re-search-forward gdb-error-regexp nil t)
888 (defcustom gdb-show-changed-values t
893 :group 'gud
896 (defcustom gdb-max-children 40
899 :group 'gud
902 (defun gdb-speedbar-expand-node (text token indent)
907 (if (and gud-comint-buffer (buffer-name gud-comint-buffer))
910 (let* ((var (assoc token gdb-var-list))
912 (if (or (<= (string-to-number children) gdb-max-children)
917 'gud-minor-mode gud-comint-buffer) 'gdba)
918 (string-equal gdb-version "pre-6.4"))
919 (gdb-var-list-children token)
920 (gdb-var-list-children-1 token)))))
922 (dolist (var gdb-var-list)
924 (setq gdb-var-list (delq var gdb-var-list))))
925 (gdb-var-delete-children token)
932 (defun gdb-get-target-string ()
933 (with-current-buffer gud-comint-buffer
934 gud-target-name))
939 ;; gdb buffers.
944 ;; The usual gdb interaction buffer is given the type `gdba' and
947 ;; Others are constructed by gdb-get-buffer-create and
948 ;; named according to the rules set forth in the gdb-buffer-rules-assoc
950 (defvar gdb-buffer-rules-assoc '())
952 (defun gdb-get-buffer (key)
953 "Return the gdb buffer tagged with type KEY.
954 The key should be one of the cars in `gdb-buffer-rules-assoc'."
956 (gdb-look-for-tagged-buffer key (buffer-list))))
958 (defun gdb-get-buffer-create (key)
959 "Create a new gdb buffer of the type specified by KEY.
960 The key should be one of the cars in `gdb-buffer-rules-assoc'."
961 (or (gdb-get-buffer key)
962 (let* ((rules (assoc key gdb-buffer-rules-assoc))
963 (name (funcall (gdb-rules-name-maker rules)))
964 (new (get-buffer-create name)))
969 (setq gdb-buffer-type key)
970 (set (make-local-variable 'gud-minor-mode)
971 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
972 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
976 (defun gdb-rules-name-maker (rules) (car (cdr rules)))
978 (defun gdb-look-for-tagged-buffer (key bufs)
982 (if (eq gdb-buffer-type key)
992 ;; NAME - Return a name for this buffer type.
1000 (defun gdb-set-buffer-rules (buffer-type &rest rules)
1001 (let ((binding (assoc buffer-type gdb-buffer-rules-assoc)))
1005 gdb-buffer-rules-assoc))))
1008 (gdb-set-buffer-rules 'gdba 'error)
1010 ;; Partial-output buffer : This accumulates output from a command executed on
1013 (gdb-set-buffer-rules 'gdb-partial-output-buffer
1014 'gdb-partial-output-name)
1016 (defun gdb-partial-output-name ()
1018 (gdb-get-target-string)
1023 (gdb-set-buffer-rules 'gdb-inferior-io
1024 'gdb-inferior-io-name
1025 'gdb-inferior-io-mode)
1027 (defun gdb-inferior-io-name ()
1029 (gdb-get-target-string)
1032 (defun gdb-display-separate-io-buffer ()
1035 (if gdb-use-separate-io-buffer
1036 (gdb-display-buffer
1037 (gdb-get-buffer-create 'gdb-inferior-io) t)))
1039 (defconst gdb-frame-parameters
1046 (defun gdb-frame-separate-io-buffer ()
1049 (if gdb-use-separate-io-buffer
1051 (special-display-frame-alist gdb-frame-parameters))
1052 (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))))
1054 (defvar gdb-inferior-io-mode-map
1056 (define-key map "\C-c\C-c" 'gdb-separate-io-interrupt)
1057 (define-key map "\C-c\C-z" 'gdb-separate-io-stop)
1058 (define-key map "\C-c\C-\\" 'gdb-separate-io-quit)
1059 (define-key map "\C-c\C-d" 'gdb-separate-io-eof)
1060 (define-key map "\C-d" 'gdb-separate-io-eof)
1063 (define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
1064 "Major mode for gdb inferior-io."
1070 (substring (buffer-name) 1 (- (length (buffer-name)) 1))
1072 (setq comint-input-sender 'gdb-inferior-io-sender))
1074 (defun gdb-inferior-io-sender (proc string)
1077 (setq proc (get-buffer-process gud-comint-buffer))
1081 (defun gdb-separate-io-interrupt ()
1085 (get-buffer-process gud-comint-buffer) comint-ptyp))
1087 (defun gdb-separate-io-quit ()
1091 (get-buffer-process gud-comint-buffer) comint-ptyp))
1093 (defun gdb-separate-io-stop ()
1097 (get-buffer-process gud-comint-buffer) comint-ptyp))
1099 (defun gdb-separate-io-eof ()
1103 (get-buffer-process gud-comint-buffer)))
1107 ;; gdb communications
1110 ;; INPUT: things sent to gdb
1118 ;; command completes. This is the way to write commands which invoke gdb
1124 (defun gdb-send (proc string)
1125 "A comint send filter for gdb.
1127 (with-current-buffer gud-comint-buffer
1130 (if gud-running
1133 (if gdb-enable-debug (push (cons 'send item) gdb-debug-log))
1137 (setq gdb-continuation (concat gdb-continuation string "\n"))
1138 (let ((item (concat gdb-continuation string "\n")))
1139 (gdb-enqueue-input item)
1140 (setq gdb-continuation nil)))))
1145 (defun gdb-enqueue-input (item)
1146 (if (not gud-running)
1147 (if gdb-prompting
1149 (gdb-send-item item)
1150 (setq gdb-prompting nil))
1151 (push item gdb-input-queue))))
1153 (defun gdb-dequeue-input ()
1154 (let ((queue gdb-input-queue))
1157 (unless (nbutlast queue) (setq gdb-input-queue '()))
1160 (defun gdb-send-item (item)
1161 (setq gdb-flush-pending-output nil)
1162 (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log))
1163 (setq gdb-current-item item)
1164 (let ((process (get-buffer-process gud-comint-buffer)))
1165 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1168 (setq gdb-output-sink 'user)
1171 (gdb-clear-partial-output)
1172 (setq gdb-output-sink 'pre-emacs)
1175 ;; case: eq gud-minor-mode 'gdbmi
1176 (gdb-clear-partial-output)
1177 (setq gdb-output-sink 'emacs)
1182 ;; output -- things gdb prints to emacs
1197 (defcustom gud-gdba-command-name "gdb -annotate=3"
1198 "Default command to execute an executable under the GDB-UI debugger."
1200 :group 'gud
1203 (defvar gdb-annotation-rules
1204 '(("pre-prompt" gdb-pre-prompt)
1205 ("prompt" gdb-prompt)
1206 ("commands" gdb-subprompt)
1207 ("overload-choice" gdb-subprompt)
1208 ("query" gdb-subprompt)
1210 ("nquery" gdb-subprompt)
1211 ("prompt-for-continue" gdb-subprompt)
1212 ("post-prompt" gdb-post-prompt)
1213 ("source" gdb-source)
1214 ("starting" gdb-starting)
1215 ("exited" gdb-exited)
1216 ("signalled" gdb-signalled)
1217 ("signal" gdb-signal)
1218 ("breakpoint" gdb-stopping)
1219 ("watchpoint" gdb-stopping)
1220 ("frame-begin" gdb-frame-begin)
1221 ("stopped" gdb-stopped)
1222 ("error-begin" gdb-error)
1223 ("error" gdb-error)
1226 (defun gdb-resync()
1227 (setq gdb-flush-pending-output t)
1228 (setq gud-running nil)
1229 (gdb-force-mode-line-update
1231 (setq gdb-output-sink 'user)
1232 (setq gdb-input-queue nil)
1233 (setq gdb-pending-triggers nil)
1234 (setq gdb-prompting t))
1236 (defconst gdb-source-spec-regexp
1240 (defun gdb-source (args)
1241 (string-match gdb-source-spec-regexp args)
1243 (setq gud-last-frame
1247 (setq gdb-pc-address (match-string 3 args))
1250 (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user)))
1252 (defun gdb-pre-prompt (ignored)
1254 This terminates the collection of output from a previous command if that
1256 (setq gdb-error nil)
1257 (let ((sink gdb-output-sink))
1261 (setq gdb-output-sink 'post-emacs))
1263 (gdb-resync)
1264 (error "Phase error in gdb-pre-prompt (got %s)" sink)))))
1266 (defun gdb-prompt (ignored)
1268 This sends the next command (if any) to gdb."
1269 (when gdb-first-prompt
1270 (gdb-force-mode-line-update
1271 (propertize "initializing..." 'face font-lock-variable-name-face))
1272 (gdb-init-1)
1273 (setq gdb-first-prompt nil))
1274 (let ((sink gdb-output-sink))
1278 (setq gdb-output-sink 'user)
1280 (car (cdr gdb-current-item))))
1281 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1284 (gdb-resync)
1285 (error "Phase error in gdb-prompt (got %s)" sink))))
1286 (let ((input (gdb-dequeue-input)))
1288 (gdb-send-item input)
1290 (setq gdb-prompting t)
1291 (gud-display-frame)))))
1293 (defun gdb-subprompt (ignored)
1295 (setq gdb-prompting t))
1297 (defun gdb-starting (ignored)
1301 (setq gdb-active-process t)
1302 (setq gdb-printing t)
1303 (let ((sink gdb-output-sink))
1307 (setq gud-running t)
1308 (setq gdb-inferior-status "running")
1309 (setq gdb-signalled nil)
1310 (gdb-force-mode-line-update
1311 (propertize gdb-inferior-status 'face font-lock-type-face))
1312 (gdb-remove-text-properties)
1313 (setq gud-old-arrow gud-overlay-arrow-position)
1314 (setq gud-overlay-arrow-position nil)
1315 (setq gdb-overlay-arrow-position nil)
1316 (setq gdb-stack-position nil)
1317 (if gdb-use-separate-io-buffer
1318 (setq gdb-output-sink 'inferior))))
1320 (gdb-resync)
1323 (defun gdb-signal (ignored)
1324 (setq gdb-inferior-status "signal")
1325 (gdb-force-mode-line-update
1326 (propertize gdb-inferior-status 'face font-lock-warning-face))
1327 (gdb-stopping ignored))
1329 (defun gdb-stopping (ignored)
1333 (if gdb-use-separate-io-buffer
1334 (let ((sink gdb-output-sink))
1337 (setq gdb-output-sink 'user))
1339 (gdb-resync)
1342 (defun gdb-exited (ignored)
1348 (setq gdb-active-process nil)
1349 (setq gud-overlay-arrow-position nil)
1350 (setq gdb-overlay-arrow-position nil)
1351 (setq gdb-stack-position nil)
1352 (setq gud-old-arrow nil)
1353 (setq gdb-inferior-status "exited")
1354 (gdb-force-mode-line-update
1355 (propertize gdb-inferior-status 'face font-lock-warning-face))
1356 (gdb-stopping ignored))
1358 (defun gdb-signalled (ignored)
1359 (setq gdb-signalled t))
1361 (defun gdb-frame-begin (ignored)
1362 (setq gdb-frame-begin t)
1363 (setq gdb-printing nil)
1364 (let ((sink gdb-output-sink))
1367 (setq gdb-output-sink 'user))
1371 (gdb-resync)
1374 (defcustom gdb-same-frame focus-follows-mouse
1376 :group 'gud
1380 (defcustom gdb-find-source-frame nil
1382 :group 'gud
1386 (defun gdb-find-source-frame (arg)
1390 (setq gdb-find-source-frame
1392 (not gdb-find-source-frame)
1395 (if gdb-find-source-frame "en" "dis"))))
1397 (defun gdb-stopped (ignored)
1399 It is just like `gdb-stopping', except that if we already set the output
1400 sink to `user' in `gdb-stopping', that is fine."
1401 (setq gud-running nil)
1402 (unless (or gud-overlay-arrow-position gud-last-frame)
1403 (if (and gdb-frame-begin gdb-printing)
1404 (setq gud-overlay-arrow-position gud-old-arrow)
1407 (if gdb-same-frame
1408 (gdb-display-gdb-buffer)
1409 (gdb-frame-gdb-buffer))
1410 (if gdb-find-source-frame
1412 (setq gdb-look-up-stack
1413 (if (gdb-get-buffer 'gdb-stack-buffer)
1416 (gdb-get-buffer-create 'gdb-stack-buffer)
1417 (gdb-invalidate-frames)
1419 (unless (member gdb-inferior-status '("exited" "signal"))
1420 (setq gdb-active-process t) ;Just for attaching case.
1421 (setq gdb-inferior-status "stopped")
1422 (gdb-force-mode-line-update
1423 (propertize gdb-inferior-status 'face font-lock-warning-face)))
1424 (let ((sink gdb-output-sink))
1427 (setq gdb-output-sink 'user))
1430 (gdb-resync)
1432 (if gdb-signalled (gdb-exited ignored)))
1434 (defun gdb-error (ignored)
1435 (setq gdb-error (not gdb-error)))
1437 (defun gdb-post-prompt (ignored)
1439 This begins the collection of output from the current command if that
1441 ;; Don't add to queue if there outstanding items or gdb-version is not known
1443 (unless (or gdb-pending-triggers gdb-first-post-prompt)
1444 (gdb-get-selected-frame)
1445 (gdb-invalidate-frames)
1447 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
1448 (gdb-invalidate-breakpoints)
1449 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1450 ;; so gdb-pc-address is updated.
1451 ;; (gdb-invalidate-assembler)
1453 (if (string-equal gdb-version "pre-6.4")
1454 (gdb-invalidate-registers)
1455 (gdb-get-changed-registers)
1456 (gdb-invalidate-registers-1))
1458 (gdb-invalidate-memory)
1459 (if (string-equal gdb-version "pre-6.4")
1460 (gdb-invalidate-locals)
1461 (gdb-invalidate-locals-1))
1463 (gdb-invalidate-threads)
1468 (if (string-equal gdb-version "pre-6.4")
1469 (gdb-var-update)
1470 (gdb-var-update-1)))))
1471 (setq gdb-first-post-prompt nil)
1472 (let ((sink gdb-output-sink))
1476 (setq gdb-output-sink 'emacs))
1478 (gdb-resync)
1479 (error "Phase error in gdb-post-prompt (got %s)" sink)))))
1481 (defconst gdb-buffer-list
1482 '(gdb-stack-buffer gdb-locals-buffer gdb-registers-buffer gdb-threads-buffer))
1484 (defun gdb-remove-text-properties ()
1485 (dolist (buffertype gdb-buffer-list)
1486 (let ((buffer (gdb-get-buffer buffertype)))
1496 (defun gdb-display-source-buffer (buffer)
1497 (let* ((last-window (if gud-last-last-frame
1499 (gud-find-file (car gud-last-last-frame)))))
1501 (if (and gdb-source-window
1502 (window-live-p gdb-source-window))
1503 gdb-source-window))))
1505 (setq gdb-source-window source-window)
1509 (defun gud-gdba-marker-filter (string)
1510 "A gud marker filter for gdb. Handle a burst of output from GDB."
1511 (if gdb-flush-pending-output
1513 (when gdb-enable-debug
1514 (push (cons 'recv string) gdb-debug-log)
1515 (if (and gdb-debug-log-max
1516 (> (length gdb-debug-log) gdb-debug-log-max))
1517 (setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
1518 ;; Recall the left over gud-marker-acc from last time.
1519 (setq gud-marker-acc (concat gud-marker-acc string))
1524 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
1525 (let ((annotation (match-string 1 gud-marker-acc)))
1531 (gdb-concat-output
1533 (substring gud-marker-acc 0 (match-beginning 0))))
1535 ;; Take that stuff off the gud-marker-acc.
1536 (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
1543 gdb-annotation-rules)))
1554 ;; If it does, then keep part of the gud-marker-acc until we get more.
1556 gud-marker-acc)
1560 (gdb-concat-output output
1561 (substring gud-marker-acc 0
1565 (setq gud-marker-acc (substring gud-marker-acc
1568 ;; In case we know the gud-marker-acc contains no partial annotations:
1570 (setq output (gdb-concat-output output gud-marker-acc))
1571 (setq gud-marker-acc "")))
1574 (defun gdb-concat-output (so-far new)
1575 (if gdb-error
1577 (let ((sink gdb-output-sink))
1582 (gdb-append-to-partial-output new)
1585 (gdb-append-to-inferior-io new)
1588 (gdb-resync)
1591 (defun gdb-append-to-partial-output (string)
1592 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1596 (defun gdb-clear-partial-output ()
1597 (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
1600 (defun gdb-append-to-inferior-io (string)
1601 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1605 (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t)))
1607 (defun gdb-clear-inferior-io ()
1608 (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
1613 ;; One trick is to have a command who's output is always available in a buffer
1617 ;; There are two aspects to this: gdb has to tell us when the output for that
1618 ;; command might have changed, and we have to be able to run the command
1621 ;; The output phasing associated with the variable gdb-output-sink
1625 ;; command.
1629 ;; It adds an input for the command we are tracking. It should be the
1630 ;; annotation rule binding of whatever gdb sends to tell us this command
1633 ;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed.
1635 ;; input in the input queue (see comment about ``gdb communications'' above).
1637 (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command
1639 `(defun ,name (&optional ignored)
1641 (not (member ',name
1642 gdb-pending-triggers)))
1644 (gdb-enqueue-input
1645 (list ,gdb-command ',output-handler))
1646 (push ',name gdb-pending-triggers)))))
1648 (defmacro def-gdb-auto-update-handler (name trigger buf-key custom-defun)
1649 `(defun ,name ()
1650 (setq gdb-pending-triggers
1652 gdb-pending-triggers))
1653 (let ((buf (gdb-get-buffer ',buf-key)))
1661 (insert-buffer-substring (gdb-get-buffer-create
1662 'gdb-partial-output-buffer))
1668 (defmacro def-gdb-auto-updated-buffer (buffer-key
1669 trigger-name gdb-command
1670 output-handler-name custom-defun)
1672 (def-gdb-auto-update-trigger ,trigger-name
1674 (gdb-get-buffer ',buffer-key)
1675 ,gdb-command
1676 ,output-handler-name)
1677 (def-gdb-auto-update-handler ,output-handler-name
1678 ,trigger-name ,buffer-key ,custom-defun)))
1685 (gdb-set-buffer-rules 'gdb-breakpoints-buffer
1686 'gdb-breakpoints-buffer-name
1687 'gdb-breakpoints-mode)
1689 (def-gdb-auto-updated-buffer gdb-breakpoints-buffer
1691 ;; `gdb-breakpoints-buffer'.
1695 gdb-invalidate-breakpoints
1697 ;; To update the buffer, this command is sent to gdb.
1701 ;; from the command above. That function will copy the output into
1703 gdb-info-breakpoints-handler
1705 gdb-info-breakpoints-custom)
1768 ;; Bitmap for gud-overlay-arrow in fringe
1777 :group 'gud)
1790 :group 'gud)
1792 (defconst gdb-breakpoint-regexp
1796 (defun gdb-info-breakpoints-custom ()
1801 (if (and (memq gud-minor-mode '(gdba gdbmi))
1802 (not (string-match "\\` ?\\*.+\\*\\'" (buffer-name))))
1803 (gdb-remove-breakpoint-icons (point-min) (point-max)))))
1804 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
1810 (if (looking-at gdb-breakpoint-regexp)
1825 '(face font-lock-function-name-face))
1833 (setq file (cdr (assoc bptno gdb-location-alist))))
1838 (set (make-local-variable 'gud-minor-mode)
1841 gud-tool-bar-map)
1846 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
1847 (gdb-enqueue-input
1849 (concat gdb-server-prefix "list "
1852 (gdb-enqueue-input
1853 (list (concat gdb-server-prefix "info source\n")
1854 `(lambda () (gdb-get-location
1861 '(face font-lock-function-name-face))
1867 '(face font-lock-variable-name-face)))))))
1869 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
1871 (defun gdb-mouse-set-clear-breakpoint (event)
1883 (gud-remove nil)
1884 (gud-break nil)))))))
1886 (defun gdb-mouse-toggle-breakpoint-margin (event)
1896 (gdb-enqueue-input
1899 0 'gdb-bptno (car (posn-string posn)))))
1900 (concat gdb-server-prefix
1902 0 'gdb-enabled (car (posn-string posn)))
1908 (defun gdb-mouse-toggle-breakpoint-fringe (event)
1924 (gdb-enqueue-input
1926 (concat gdb-server-prefix
1927 (if (get-text-property 0 'gdb-enabled obj)
1930 (get-text-property 0 'gdb-bptno obj) "\n")
1933 (defun gdb-breakpoints-buffer-name ()
1934 (with-current-buffer gud-comint-buffer
1935 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1937 (defun gdb-display-breakpoints-buffer ()
1940 (gdb-display-buffer
1941 (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))
1943 (defun gdb-frame-breakpoints-buffer ()
1947 (special-display-frame-alist gdb-frame-parameters))
1948 (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer))))
1950 (defvar gdb-breakpoints-mode-map
1953 (define-key menu [quit] '("Quit" . gdb-delete-frame-or-window))
1954 (define-key menu [goto] '("Goto" . gdb-goto-breakpoint))
1955 (define-key menu [delete] '("Delete" . gdb-delete-breakpoint))
1956 (define-key menu [toggle] '("Toggle" . gdb-toggle-breakpoint))
1959 (define-key map " " 'gdb-toggle-breakpoint)
1960 (define-key map "D" 'gdb-delete-breakpoint)
1962 (define-key map "q" 'gdb-delete-frame-or-window)
1963 (define-key map "\r" 'gdb-goto-breakpoint)
1964 (define-key map [mouse-2] 'gdb-goto-breakpoint)
1968 (defun gdb-delete-frame-or-window ()
1974 (defun gdb-breakpoints-mode ()
1975 "Major mode for gdb breakpoints.
1977 \\{gdb-breakpoints-mode-map}"
1979 (setq major-mode 'gdb-breakpoints-mode)
1980 (setq mode-name "Breakpoints")
1981 (use-local-map gdb-breakpoints-mode-map)
1983 (run-mode-hooks 'gdb-breakpoints-mode-hook)
1984 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
1985 'gdb-invalidate-breakpoints
1988 (defun gdb-toggle-breakpoint ()
1993 (if (looking-at gdb-breakpoint-regexp)
1994 (gdb-enqueue-input
1996 (concat gdb-server-prefix
2003 (defun gdb-delete-breakpoint ()
2007 (if (looking-at gdb-breakpoint-regexp)
2008 (gdb-enqueue-input
2010 (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))
2013 (defun gdb-goto-breakpoint (&optional event)
2026 (cdr (assoc bptno gdb-location-alist)))))
2027 (window (or (gdb-display-source-buffer buffer)
2029 (setq gdb-source-window window)
2038 ;; (from the command `where').
2042 (defcustom gdb-max-frames 40
2045 :group 'gud
2048 (gdb-set-buffer-rules 'gdb-stack-buffer
2049 'gdb-stack-buffer-name
2050 'gdb-frames-mode)
2052 (def-gdb-auto-updated-buffer gdb-stack-buffer
2053 gdb-invalidate-frames
2054 (concat "server info stack " (number-to-string gdb-max-frames) "\n")
2055 gdb-info-stack-handler
2056 gdb-info-stack-custom)
2058 (defun gdb-info-stack-custom ()
2059 (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
2061 (unless (eq gdb-look-up-stack 'delete)
2074 (when (string-equal (match-string 1) gdb-frame-number)
2077 (or gdb-stack-position
2078 (setq gdb-stack-position (make-marker)))
2079 (set-marker gdb-stack-position (point)))
2087 'face font-lock-function-name-face)
2091 'face font-lock-function-name-face))
2095 'face font-lock-variable-name-face))))
2101 gdb-max-frames t
2103 "mouse-2, RET: customize gdb-max-frames to see more frames")))))
2104 (when gdb-look-up-stack
2111 (gdb-enqueue-input
2112 (list (concat gdb-server-prefix "frame "
2113 (match-string 1) "\n") 'gdb-set-hollow))
2114 (gdb-enqueue-input
2115 (list (concat gdb-server-prefix "frame 0\n") 'ignore)))))))
2116 (if (eq gdb-look-up-stack 'delete)
2117 (kill-buffer (gdb-get-buffer 'gdb-stack-buffer)))
2118 (setq gdb-look-up-stack nil))
2120 (defun gdb-set-hollow ()
2121 (if gud-last-last-frame
2122 (with-current-buffer (gud-find-file (car gud-last-last-frame))
2126 (defun gdb-stack-buffer-name ()
2127 (with-current-buffer gud-comint-buffer
2128 (concat "*stack frames of " (gdb-get-target-string) "*")))
2130 (defun gdb-display-stack-buffer ()
2133 (gdb-display-buffer
2134 (gdb-get-buffer-create 'gdb-stack-buffer) t))
2136 (defun gdb-frame-stack-buffer ()
2140 (special-display-frame-alist gdb-frame-parameters))
2141 (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer))))
2143 (defvar gdb-frames-mode-map
2147 (define-key map "\r" 'gdb-frames-select)
2148 (define-key map [mouse-2] 'gdb-frames-select)
2152 (defun gdb-frames-mode ()
2153 "Major mode for gdb call stack.
2155 \\{gdb-frames-mode-map}"
2157 (setq major-mode 'gdb-frames-mode)
2158 (setq mode-name "Frames")
2159 (setq gdb-stack-position nil)
2160 (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position)
2163 (use-local-map gdb-frames-mode-map)
2164 (run-mode-hooks 'gdb-frames-mode-hook)
2165 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2166 'gdb-invalidate-frames
2169 (defun gdb-get-frame-number ()
2177 (defun gdb-frames-select (&optional event)
2181 (if (get-text-property (point) 'gdb-max-frames)
2183 (message-box "After setting gdb-max-frames, you need to enter\n\
2184 another GDB command e.g pwd, to see new frames")
2185 (customize-variable-other-window 'gdb-max-frames))
2186 (gdb-enqueue-input
2187 (list (concat gdb-server-prefix "frame "
2188 (gdb-get-frame-number) "\n") 'ignore))))
2194 (gdb-set-buffer-rules 'gdb-threads-buffer
2195 'gdb-threads-buffer-name
2196 'gdb-threads-mode)
2198 (def-gdb-auto-updated-buffer gdb-threads-buffer
2199 gdb-invalidate-threads
2200 (concat gdb-server-prefix "info threads\n")
2201 gdb-info-threads-handler
2202 gdb-info-threads-custom)
2204 (defun gdb-info-threads-custom ()
2205 (with-current-buffer (gdb-get-buffer 'gdb-threads-buffer)
2216 (defun gdb-threads-buffer-name ()
2217 (with-current-buffer gud-comint-buffer
2218 (concat "*threads of " (gdb-get-target-string) "*")))
2220 (defun gdb-display-threads-buffer ()
2223 (gdb-display-buffer
2224 (gdb-get-buffer-create 'gdb-threads-buffer) t))
2226 (defun gdb-frame-threads-buffer ()
2230 (special-display-frame-alist gdb-frame-parameters))
2231 (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer))))
2233 (defvar gdb-threads-mode-map
2237 (define-key map "\r" 'gdb-threads-select)
2238 (define-key map [mouse-2] 'gdb-threads-select)
2242 (defvar gdb-threads-font-lock-keywords
2243 '((") +\\([^ ]+\\) (" (1 font-lock-function-name-face))
2244 ("in \\([^ ]+\\) (" (1 font-lock-function-name-face))
2245 ("\\(\\(\\sw\\|[_.]\\)+\\)=" (1 font-lock-variable-name-face)))
2246 "Font lock keywords used in `gdb-threads-mode'.")
2248 (defun gdb-threads-mode ()
2249 "Major mode for gdb threads.
2251 \\{gdb-threads-mode-map}"
2253 (setq major-mode 'gdb-threads-mode)
2254 (setq mode-name "Threads")
2256 (use-local-map gdb-threads-mode-map)
2258 '(gdb-threads-font-lock-keywords))
2259 (run-mode-hooks 'gdb-threads-mode-hook)
2260 'gdb-invalidate-threads)
2262 (defun gdb-get-thread-number ()
2267 (defun gdb-threads-select (&optional event)
2271 (gdb-enqueue-input
2272 (list (concat gdb-server-prefix "thread "
2273 (gdb-get-thread-number) "\n") 'ignore))
2274 (gud-display-frame))
2280 (defcustom gdb-all-registers nil
2283 :group 'gud
2286 (gdb-set-buffer-rules 'gdb-registers-buffer
2287 'gdb-registers-buffer-name
2288 'gdb-registers-mode)
2290 (def-gdb-auto-updated-buffer gdb-registers-buffer
2291 gdb-invalidate-registers
2293 gdb-server-prefix "info " (if gdb-all-registers "all-") "registers\n")
2294 gdb-info-registers-handler
2295 gdb-info-registers-custom)
2297 (defun gdb-info-registers-custom ()
2298 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
2309 'face font-lock-variable-name-face)
2315 (defun gdb-edit-register-value (&optional event)
2322 (gdb-enqueue-input
2323 (list (concat gdb-server-prefix "set $" register "=" value "\n")
2326 (defvar gdb-registers-mode-map
2329 (define-key map "\r" 'gdb-edit-register-value)
2330 (define-key map [mouse-2] 'gdb-edit-register-value)
2331 (define-key map " " 'gdb-all-registers)
2335 (defun gdb-registers-mode ()
2336 "Major mode for gdb registers.
2338 \\{gdb-registers-mode-map}"
2340 (setq major-mode 'gdb-registers-mode)
2341 (setq mode-name "Registers")
2343 (use-local-map gdb-registers-mode-map)
2344 (run-mode-hooks 'gdb-registers-mode-hook)
2345 (if (string-equal gdb-version "pre-6.4")
2347 (if gdb-all-registers (setq mode-name "Registers:All"))
2348 'gdb-invalidate-registers)
2349 'gdb-invalidate-registers-1))
2351 (defun gdb-registers-buffer-name ()
2352 (with-current-buffer gud-comint-buffer
2353 (concat "*registers of " (gdb-get-target-string) "*")))
2355 (defun gdb-display-registers-buffer ()
2358 (gdb-display-buffer
2359 (gdb-get-buffer-create 'gdb-registers-buffer) t))
2361 (defun gdb-frame-registers-buffer ()
2365 (special-display-frame-alist gdb-frame-parameters))
2366 (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer))))
2368 (defun gdb-all-registers ()
2371 (when (string-equal gdb-version "pre-6.4")
2372 (if gdb-all-registers
2374 (setq gdb-all-registers nil)
2375 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer)
2376 (setq mode-name "Registers")))
2377 (setq gdb-all-registers t)
2378 (with-current-buffer (gdb-get-buffer-create 'gdb-registers-buffer)
2379 (setq mode-name "Registers:All")))
2381 (if gdb-all-registers "en" "dis")))
2382 (gdb-invalidate-registers)))
2388 (defcustom gdb-memory-repeat-count 32
2391 :group 'gud
2394 (defcustom gdb-memory-format "x"
2401 :group 'gud
2404 (defcustom gdb-memory-unit "w"
2410 :group 'gud
2413 (gdb-set-buffer-rules 'gdb-memory-buffer
2414 'gdb-memory-buffer-name
2415 'gdb-memory-mode)
2417 (def-gdb-auto-updated-buffer gdb-memory-buffer
2418 gdb-invalidate-memory
2419 (concat gdb-server-prefix "x/" (number-to-string gdb-memory-repeat-count)
2420 gdb-memory-format gdb-memory-unit " " gdb-memory-address "\n")
2421 gdb-read-memory-handler
2422 gdb-read-memory-custom)
2424 (defun gdb-read-memory-custom ()
2428 (setq gdb-memory-address (match-string 0)))))
2430 (defvar gdb-memory-mode-map
2436 (defun gdb-memory-set-address (event)
2442 (setq gdb-memory-address arg))
2443 (gdb-invalidate-memory)))
2445 (defun gdb-memory-set-repeat-count (event)
2454 (customize-set-variable 'gdb-memory-repeat-count count)
2455 (gdb-invalidate-memory)))))
2457 (defun gdb-memory-format-binary ()
2460 (customize-set-variable 'gdb-memory-format "t")
2461 (gdb-invalidate-memory))
2463 (defun gdb-memory-format-octal ()
2466 (customize-set-variable 'gdb-memory-format "o")
2467 (gdb-invalidate-memory))
2469 (defun gdb-memory-format-unsigned ()
2472 (customize-set-variable 'gdb-memory-format "u")
2473 (gdb-invalidate-memory))
2475 (defun gdb-memory-format-signed ()
2478 (customize-set-variable 'gdb-memory-format "d")
2479 (gdb-invalidate-memory))
2481 (defun gdb-memory-format-hexadecimal ()
2484 (customize-set-variable 'gdb-memory-format "x")
2485 (gdb-invalidate-memory))
2487 (defvar gdb-memory-format-map
2489 (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
2493 (defvar gdb-memory-format-menu (make-sparse-keymap "Format")
2496 (define-key gdb-memory-format-menu [binary]
2497 '(menu-item "Binary" gdb-memory-format-binary
2498 :button (:radio . (equal gdb-memory-format "t"))))
2499 (define-key gdb-memory-format-menu [octal]
2500 '(menu-item "Octal" gdb-memory-format-octal
2501 :button (:radio . (equal gdb-memory-format "o"))))
2502 (define-key gdb-memory-format-menu [unsigned]
2503 '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned
2504 :button (:radio . (equal gdb-memory-format "u"))))
2505 (define-key gdb-memory-format-menu [signed]
2506 '(menu-item "Signed Decimal" gdb-memory-format-signed
2507 :button (:radio . (equal gdb-memory-format "d"))))
2508 (define-key gdb-memory-format-menu [hexadecimal]
2509 '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal
2510 :button (:radio . (equal gdb-memory-format "x"))))
2512 (defun gdb-memory-format-menu (event)
2514 (x-popup-menu event gdb-memory-format-menu))
2516 (defun gdb-memory-format-menu-1 (event)
2520 (let* ((selection (gdb-memory-format-menu event))
2521 (binding (and selection (lookup-key gdb-memory-format-menu
2525 (defun gdb-memory-unit-giant ()
2528 (customize-set-variable 'gdb-memory-unit "g")
2529 (gdb-invalidate-memory))
2531 (defun gdb-memory-unit-word ()
2534 (customize-set-variable 'gdb-memory-unit "w")
2535 (gdb-invalidate-memory))
2537 (defun gdb-memory-unit-halfword ()
2540 (customize-set-variable 'gdb-memory-unit "h")
2541 (gdb-invalidate-memory))
2543 (defun gdb-memory-unit-byte ()
2546 (customize-set-variable 'gdb-memory-unit "b")
2547 (gdb-invalidate-memory))
2549 (defvar gdb-memory-unit-map
2551 (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
2555 (defvar gdb-memory-unit-menu (make-sparse-keymap "Unit")
2558 (define-key gdb-memory-unit-menu [giantwords]
2559 '(menu-item "Giant words" gdb-memory-unit-giant
2560 :button (:radio . (equal gdb-memory-unit "g"))))
2561 (define-key gdb-memory-unit-menu [words]
2562 '(menu-item "Words" gdb-memory-unit-word
2563 :button (:radio . (equal gdb-memory-unit "w"))))
2564 (define-key gdb-memory-unit-menu [halfwords]
2565 '(menu-item "Halfwords" gdb-memory-unit-halfword
2566 :button (:radio . (equal gdb-memory-unit "h"))))
2567 (define-key gdb-memory-unit-menu [bytes]
2568 '(menu-item "Bytes" gdb-memory-unit-byte
2569 :button (:radio . (equal gdb-memory-unit "b"))))
2571 (defun gdb-memory-unit-menu (event)
2573 (x-popup-menu event gdb-memory-unit-menu))
2575 (defun gdb-memory-unit-menu-1 (event)
2579 (let* ((selection (gdb-memory-unit-menu event))
2580 (binding (and selection (lookup-key gdb-memory-unit-menu
2585 (defun gdb-make-header-line-mouse-map (mouse function) "\
2594 (defvar gdb-memory-font-lock-keywords
2595 '(;; <__function.name+n>
2596 ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face))
2598 "Font lock keywords used in `gdb-memory-mode'.")
2600 (defun gdb-memory-mode ()
2603 \\{gdb-memory-mode-map}"
2605 (setq major-mode 'gdb-memory-mode)
2606 (setq mode-name "Memory")
2608 (use-local-map gdb-memory-mode-map)
2619 (gdb-make-header-line-mouse-map
2622 (let ((gdb-memory-address
2625 gdb-memory-address " - "
2627 (* gdb-memory-repeat-count
2628 (cond ((string= gdb-memory-unit "b") 1)
2629 ((string= gdb-memory-unit "h") 2)
2630 ((string= gdb-memory-unit "w") 4)
2631 ((string= gdb-memory-unit "g") 8)))))))
2632 (gdb-invalidate-memory)))))
2638 'local-map (gdb-make-header-line-mouse-map
2641 (let ((gdb-memory-address nil))
2642 (gdb-invalidate-memory)))))
2644 (propertize gdb-memory-address
2648 'local-map (gdb-make-header-line-mouse-map
2650 #'gdb-memory-set-address))
2652 (propertize (number-to-string gdb-memory-repeat-count)
2656 'local-map (gdb-make-header-line-mouse-map
2658 #'gdb-memory-set-repeat-count))
2660 (propertize gdb-memory-format
2664 'local-map gdb-memory-format-map)
2666 (propertize gdb-memory-unit
2670 'local-map gdb-memory-unit-map))))
2672 '(gdb-memory-font-lock-keywords))
2673 (run-mode-hooks 'gdb-memory-mode-hook)
2674 'gdb-invalidate-memory)
2676 (defun gdb-memory-buffer-name ()
2677 (with-current-buffer gud-comint-buffer
2678 (concat "*memory of " (gdb-get-target-string) "*")))
2680 (defun gdb-display-memory-buffer ()
2683 (gdb-display-buffer
2684 (gdb-get-buffer-create 'gdb-memory-buffer) t))
2686 (defun gdb-frame-memory-buffer ()
2693 (cons '(width . 83) gdb-frame-parameters)))))
2694 (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
2700 (gdb-set-buffer-rules 'gdb-locals-buffer
2701 'gdb-locals-buffer-name
2702 'gdb-locals-mode)
2704 (def-gdb-auto-update-trigger gdb-invalidate-locals
2705 (gdb-get-buffer 'gdb-locals-buffer)
2707 gdb-info-locals-handler)
2709 (defvar gdb-locals-watch-map
2714 (gud-watch)))
2718 (gud-watch)))
2722 (defconst gdb-struct-string
2726 'local-map gdb-locals-watch-map) "\n"))
2728 (defconst gdb-array-string
2732 'local-map gdb-locals-watch-map) "\n"))
2735 ;; These can be expanded using gud-display.
2736 (defun gdb-info-locals-handler ()
2737 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals
2738 gdb-pending-triggers))
2739 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
2746 (replace-match gdb-struct-string nil nil))
2749 (replace-match gdb-array-string nil nil))))
2750 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
2758 (insert-buffer-substring (gdb-get-buffer-create
2759 'gdb-partial-output-buffer))
2763 (run-hooks 'gdb-info-locals-hook))
2765 (defvar gdb-locals-mode-map
2771 (defun gdb-locals-mode ()
2772 "Major mode for gdb locals.
2774 \\{gdb-locals-mode-map}"
2776 (setq major-mode 'gdb-locals-mode)
2777 (setq mode-name (concat "Locals:" gdb-selected-frame))
2779 (use-local-map gdb-locals-mode-map)
2781 '(gdb-locals-font-lock-keywords))
2782 (run-mode-hooks 'gdb-locals-mode-hook)
2783 (if (and (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2784 (string-equal gdb-version "pre-6.4"))
2785 'gdb-invalidate-locals
2786 'gdb-invalidate-locals-1))
2788 (defun gdb-locals-buffer-name ()
2789 (with-current-buffer gud-comint-buffer
2790 (concat "*locals of " (gdb-get-target-string) "*")))
2792 (defun gdb-display-locals-buffer ()
2795 (gdb-display-buffer
2796 (gdb-get-buffer-create 'gdb-locals-buffer) t))
2798 (defun gdb-frame-locals-buffer ()
2802 (special-display-frame-alist gdb-frame-parameters))
2803 (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer))))
2808 (defun gdb-display-buffer (buf dedicated &optional size)
2814 (pop-to-buffer gud-comint-buffer) ;Select the right frame.
2817 (not (memq window `(,(get-buffer-window gud-comint-buffer)
2818 ,gdb-source-window))))
2837 (define-key gud-menu-map [displays]
2839 :visible (memq gud-minor-mode '(gdbmi gdba))))
2840 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
2841 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
2843 '(menu-item "Separate IO" gdb-display-separate-io-buffer
2844 :enable gdb-use-separate-io-buffer))
2845 (define-key menu [memory] '("Memory" . gdb-display-memory-buffer))
2846 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
2848 '("Disassembly" . gdb-display-assembler-buffer))
2850 '("Breakpoints" . gdb-display-breakpoints-buffer))
2851 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
2852 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)))
2855 (define-key gud-menu-map [frames]
2857 :visible (memq gud-minor-mode '(gdbmi gdba))))
2858 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
2859 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
2860 (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer))
2862 '(menu-item "Separate IO" gdb-frame-separate-io-buffer
2863 :enable gdb-use-separate-io-buffer))
2864 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
2865 (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer))
2867 '("Breakpoints" . gdb-frame-breakpoints-buffer))
2868 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
2869 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)))
2872 (define-key gud-menu-map [ui]
2873 `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI")
2874 ,menu :visible (memq gud-minor-mode '(gdbmi gdba))))
2875 (define-key menu [gdb-find-source-frame]
2876 '(menu-item "Look For Source Frame" gdb-find-source-frame
2877 :visible (eq gud-minor-mode 'gdba)
2879 :button (:toggle . gdb-find-source-frame)))
2880 (define-key menu [gdb-use-separate-io]
2881 '(menu-item "Separate IO" gdb-use-separate-io-buffer
2882 :visible (eq gud-minor-mode 'gdba)
2884 :button (:toggle . gdb-use-separate-io-buffer)))
2885 (define-key menu [gdb-many-windows]
2886 '(menu-item "Display Other Windows" gdb-many-windows
2888 :button (:toggle . gdb-many-windows)))
2889 (define-key menu [gdb-restore-windows]
2890 '(menu-item "Restore Window Layout" gdb-restore-windows
2893 (defun gdb-frame-gdb-buffer ()
2899 gdb-frame-parameters)))
2901 (display-buffer gud-comint-buffer)))
2903 (defun gdb-display-gdb-buffer ()
2907 (pop-to-buffer gud-comint-buffer)))
2909 (defun gdb-set-window-buffer (name)
2910 (set-window-buffer (selected-window) (get-buffer name))
2913 (defun gdb-setup-windows ()
2914 "Layout the window pattern for `gdb-many-windows'."
2915 (gdb-display-locals-buffer)
2916 (gdb-display-stack-buffer)
2918 (gdb-display-breakpoints-buffer)
2921 (pop-to-buffer gud-comint-buffer)
2926 (gdb-set-window-buffer (gdb-locals-buffer-name))
2929 (if gud-last-last-frame
2930 (gud-find-file (car gud-last-last-frame))
2931 (if gdb-main-file
2932 (gud-find-file gdb-main-file)
2936 (setq gdb-source-window (selected-window))
2937 (when gdb-use-separate-io-buffer
2940 (gdb-set-window-buffer
2941 (gdb-get-buffer-create 'gdb-inferior-io)))
2943 (gdb-set-window-buffer (gdb-stack-buffer-name))
2946 (gdb-set-window-buffer (gdb-breakpoints-buffer-name))
2949 (defun gdb-restore-windows ()
2951 This arrangement depends on the value of `gdb-many-windows'."
2953 (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
2955 (if gdb-many-windows
2956 (gdb-setup-windows)
2957 (when (or gud-last-last-frame gdb-show-main)
2961 (if gud-last-last-frame
2962 (gud-find-file (car gud-last-last-frame))
2963 (gud-find-file gdb-main-file)))
2964 (setq gdb-source-window (selected-window))
2967 (defun gdb-reset ()
2969 Kills the gdb buffers, and resets variables and the source buffers."
2971 (unless (eq buffer gud-comint-buffer)
2973 (if (memq gud-minor-mode '(gdbmi gdba))
2974 (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name))
2976 (gdb-remove-breakpoint-icons (point-min) (point-max) t)
2977 (setq gud-minor-mode nil)
2979 (kill-local-variable 'gdb-define-alist))))))
2980 (setq gdb-overlay-arrow-position nil)
2982 (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list))
2984 (setq gdb-stack-position nil)
2986 (delq 'gdb-stack-position overlay-arrow-variable-list))
2988 (setq gud-running nil)
2989 (setq gdb-active-process nil)
2990 (setq gdb-var-list nil)
2991 (remove-hook 'after-save-hook 'gdb-create-define-alist t))
2993 (defun gdb-source-info ()
2999 (setq gdb-main-file (match-string 0)))
3002 (setq gdb-macro-info t))
3003 (if gdb-many-windows
3004 (gdb-setup-windows)
3005 (gdb-get-buffer-create 'gdb-breakpoints-buffer)
3006 (if gdb-show-main
3008 (display-buffer (gud-find-file gdb-main-file))))))
3010 (defun gdb-get-location (bptno line flag)
3017 (delete (cons bptno "File not found") gdb-location-alist)
3018 (push (cons bptno (match-string 0)) gdb-location-alist))
3019 (gdb-resync)
3020 (unless (assoc bptno gdb-location-alist)
3021 (push (cons bptno "File not found") gdb-location-alist)
3023 Add directory to search path for source files using the GDB command, dir."))
3028 (set (make-local-variable 'gud-minor-mode) 'gdba)
3029 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
3033 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
3035 (add-hook 'find-file-hook 'gdb-find-file-hook)
3037 (defun gdb-find-file-hook ()
3040 (if (and (buffer-name gud-comint-buffer)
3041 ;; in case gud or gdb-ui is just loaded
3042 gud-comint-buffer
3043 (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
3045 ;;Pre GDB 6.3 "info sources" doesn't give absolute file name.
3046 (if (member (if (string-equal gdb-version "pre-6.4")
3047 (file-name-nondirectory buffer-file-name)
3048 buffer-file-name)
3049 gdb-source-file-list)
3050 (with-current-buffer (find-buffer-visiting buffer-file-name)
3051 (set (make-local-variable 'gud-minor-mode)
3052 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
3053 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)))))
3056 (defun gdb-put-string (putstring pos &optional dprop &rest sprops)
3074 (defun gdb-remove-strings (start end &optional buffer)
3076 Remove only strings that were put in BUFFER with calls to `gdb-put-string'.
3084 (defun gdb-put-breakpoint-icon (enabled bptno)
3094 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring)
3096 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring))
3097 (gdb-remove-breakpoint-icons start end)
3101 gdb-buffer-fringe-width) 8)
3102 (gdb-put-string
3108 'gdb-bptno bptno
3109 'gdb-enabled enabled)
3146 (gdb-put-string
3151 (defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
3152 (gdb-remove-strings start end)
3167 (gdb-set-buffer-rules 'gdb-assembler-buffer
3168 'gdb-assembler-buffer-name
3169 'gdb-assembler-mode)
3171 ;; We can't use def-gdb-auto-update-handler because we don't want to use
3173 (defun gdb-assembler-handler ()
3174 (setq gdb-pending-triggers
3175 (delq 'gdb-invalidate-assembler
3176 gdb-pending-triggers))
3177 (let ((buf (gdb-get-buffer 'gdb-assembler-buffer)))
3184 (insert-buffer-substring (gdb-get-buffer-create
3185 'gdb-partial-output-buffer))
3188 (gdb-assembler-custom))
3190 (defun gdb-assembler-custom ()
3191 (let ((buffer (gdb-get-buffer 'gdb-assembler-buffer))
3195 (if (not (equal gdb-pc-address "main"))
3198 (if (and gdb-pc-address
3199 (search-forward gdb-pc-address nil t))
3204 (if (string-equal gdb-frame-number "0")
3207 (or gdb-overlay-arrow-position
3208 (setq gdb-overlay-arrow-position (make-marker)))
3209 (set-marker gdb-overlay-arrow-position (point))))))
3211 (gdb-remove-breakpoint-icons (point-min) (point-max))))
3212 (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
3227 (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
3228 (if (not (equal gdb-pc-address "main"))
3232 (defvar gdb-assembler-mode-map
3238 (defvar gdb-assembler-font-lock-keywords
3239 '(;; <__function.name+n>
3241 (1 font-lock-function-name-face))
3242 ;; 0xNNNNNNNN <__function.name+n>: opcode
3246 ("%\\sw+" . font-lock-variable-name-face)
3249 (2 font-lock-function-name-face))
3251 "Font lock keywords used in `gdb-assembler-mode'.")
3253 (defun gdb-assembler-mode ()
3256 \\{gdb-assembler-mode-map}"
3258 (setq major-mode 'gdb-assembler-mode)
3259 (setq mode-name (concat "Machine:" gdb-selected-frame))
3260 (setq gdb-overlay-arrow-position nil)
3261 (add-to-list 'overlay-arrow-variable-list 'gdb-overlay-arrow-position)
3264 (use-local-map gdb-assembler-mode-map)
3265 (gdb-invalidate-assembler)
3267 '(gdb-assembler-font-lock-keywords))
3268 (run-mode-hooks 'gdb-assembler-mode-hook)
3269 'gdb-invalidate-assembler)
3271 (defun gdb-assembler-buffer-name ()
3272 (with-current-buffer gud-comint-buffer
3273 (concat "*disassembly of " (gdb-get-target-string) "*")))
3275 (defun gdb-display-assembler-buffer ()
3278 (setq gdb-previous-frame nil)
3279 (gdb-display-buffer
3280 (gdb-get-buffer-create 'gdb-assembler-buffer) t))
3282 (defun gdb-frame-assembler-buffer ()
3285 (setq gdb-previous-frame nil)
3287 (special-display-frame-alist gdb-frame-parameters))
3288 (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer))))
3290 ;; modified because if gdb-pc-address has changed value a new command
3292 (defun gdb-invalidate-assembler (&optional ignored)
3293 (if (gdb-get-buffer 'gdb-assembler-buffer)
3295 (unless (and gdb-selected-frame
3296 (string-equal gdb-selected-frame gdb-previous-frame))
3297 (if (or (not (member 'gdb-invalidate-assembler
3298 gdb-pending-triggers))
3299 (not (string-equal gdb-pc-address
3300 gdb-previous-frame-address)))
3302 ;; take previous disassemble command, if any, off the queue
3303 (with-current-buffer gud-comint-buffer
3304 (let ((queue gdb-input-queue))
3306 (if (equal (cdr item) '(gdb-assembler-handler))
3307 (setq gdb-input-queue
3308 (delete item gdb-input-queue))))))
3309 (gdb-enqueue-input
3311 (concat gdb-server-prefix "disassemble "
3312 (if (member gdb-pc-address '(nil "main")) nil "0x")
3313 gdb-pc-address "\n")
3314 'gdb-assembler-handler))
3315 (push 'gdb-invalidate-assembler gdb-pending-triggers)
3316 (setq gdb-previous-frame-address gdb-pc-address)
3317 (setq gdb-previous-frame gdb-selected-frame)))))))
3319 (defun gdb-get-selected-frame ()
3320 (if (not (member 'gdb-get-selected-frame gdb-pending-triggers))
3322 (gdb-enqueue-input
3323 (list (concat gdb-server-prefix "info frame\n") 'gdb-frame-handler))
3324 (push 'gdb-get-selected-frame
3325 gdb-pending-triggers))))
3327 (defun gdb-frame-handler ()
3328 (setq gdb-pending-triggers
3329 (delq 'gdb-get-selected-frame gdb-pending-triggers))
3333 (setq gdb-frame-number (match-string 1))
3334 (setq gdb-frame-address (match-string 2)))
3339 (setq gdb-selected-frame (match-string 2))
3340 (if (gdb-get-buffer 'gdb-locals-buffer)
3341 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3342 (setq mode-name (concat "Locals:" gdb-selected-frame))))
3343 (if (gdb-get-buffer 'gdb-assembler-buffer)
3344 (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
3345 (setq mode-name (concat "Machine:" gdb-selected-frame))))
3346 (setq gdb-pc-address (match-string 1))
3347 (if (and (match-string 3) gud-overlay-arrow-position)
3348 (let ((buffer (marker-buffer gud-overlay-arrow-position))
3349 (position (marker-position gud-overlay-arrow-position)))
3351 (string-equal (buffer-name buffer)
3352 (file-name-nondirectory (match-string 3))))
3355 (if (string-equal gdb-frame-number "0")
3358 (set-marker gud-overlay-arrow-position position))))))
3361 (setq gdb-current-language (match-string 1)))
3362 (gdb-invalidate-assembler))
3367 (defconst gdb-source-file-regexp-1 "fullname=\"\\(.*?\\)\"")
3369 (defun gdb-set-gud-minor-mode-existing-buffers-1 ()
3371 If buffers already exist for any of these files, gud-minor-mode
3374 (while (re-search-forward gdb-source-file-regexp-1 nil t)
3375 (push (match-string 1) gdb-source-file-list))
3378 (when (member buffer-file-name gdb-source-file-list)
3379 (set (make-local-variable 'gud-minor-mode)
3380 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
3381 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
3382 (when gud-tooltip-mode
3383 (make-local-variable 'gdb-define-alist)
3384 (gdb-create-define-alist)
3385 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))
3386 (gdb-force-mode-line-update
3387 (propertize "ready" 'face font-lock-variable-name-face)))
3390 (defun gdb-var-list-children-1 (varnum)
3391 (gdb-enqueue-input
3393 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3397 `(lambda () (gdb-var-list-children-handler-1 ,varnum)))))
3399 (defconst gdb-var-list-children-regexp-1
3400 "child={.*?name=\"\\(.+?\\)\",.*?exp=\"\\(.+?\\)\",.*?\
3404 (defun gdb-var-list-children-handler-1 (varnum)
3408 (dolist (var gdb-var-list)
3412 (while (re-search-forward gdb-var-list-children-regexp-1 nil t)
3419 (if (assoc (car varchild) gdb-var-list)
3423 (setq gdb-var-list (nreverse var-list))))
3424 (gdb-speedbar-update))
3427 (defun gdb-var-update-1 ()
3428 (if (not (member 'gdb-var-update gdb-pending-triggers))
3430 (gdb-enqueue-input
3432 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3435 'gdb-var-update-handler-1))
3436 (push 'gdb-var-update gdb-pending-triggers))))
3438 (defconst gdb-var-update-regexp-1
3439 "{.*?name=\"\\(.*?\\)\",.*?\\(?:value=\\(\".*?\"\\),\\)?.*?\
3442 (defun gdb-var-update-handler-1 ()
3443 (dolist (var gdb-var-list)
3446 (while (re-search-forward gdb-var-update-regexp-1 nil t)
3448 (var (assoc varnum gdb-var-list)))
3458 (gdb-var-delete-1 varnum)))))))
3459 (setq gdb-pending-triggers
3460 (delq 'gdb-var-update gdb-pending-triggers))
3461 (gdb-speedbar-update))
3465 (gdb-set-buffer-rules 'gdb-registers-buffer
3466 'gdb-registers-buffer-name
3467 'gdb-registers-mode)
3469 (def-gdb-auto-update-trigger gdb-invalidate-registers-1
3470 (gdb-get-buffer 'gdb-registers-buffer)
3471 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3474 gdb-data-list-register-values-handler)
3476 (defconst gdb-data-list-register-values-regexp
3479 (defun gdb-data-list-register-values-handler ()
3480 (setq gdb-pending-triggers (delq 'gdb-invalidate-registers-1
3481 gdb-pending-triggers))
3483 (if (re-search-forward gdb-error-regexp nil t)
3485 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3491 (let ((register-list (reverse gdb-register-names))
3494 (while (re-search-forward gdb-data-list-register-values-regexp nil t)
3497 (if (member (match-string 1) gdb-changed-registers)
3503 (let ((buf (gdb-get-buffer 'gdb-registers-buffer)))
3513 (gdb-data-list-register-values-custom))
3515 (defun gdb-data-list-register-values-custom ()
3516 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3527 'face font-lock-variable-name-face)
3534 (defun gdb-get-changed-registers ()
3535 (if (and (gdb-get-buffer 'gdb-registers-buffer)
3536 (not (member 'gdb-get-changed-registers gdb-pending-triggers)))
3538 (gdb-enqueue-input
3540 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3543 'gdb-get-changed-registers-handler))
3544 (push 'gdb-get-changed-registers gdb-pending-triggers))))
3546 (defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")
3548 (defun gdb-get-changed-registers-handler ()
3549 (setq gdb-pending-triggers
3550 (delq 'gdb-get-changed-registers gdb-pending-triggers))
3551 (setq gdb-changed-registers nil)
3553 (while (re-search-forward gdb-data-list-register-names-regexp nil t)
3554 (push (match-string 1) gdb-changed-registers)))
3561 (gdb-set-buffer-rules 'gdb-locals-buffer
3562 'gdb-locals-buffer-name
3563 'gdb-locals-mode)
3565 (def-gdb-auto-update-trigger gdb-invalidate-locals-1
3566 (gdb-get-buffer 'gdb-locals-buffer)
3567 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
3570 gdb-stack-list-locals-handler)
3572 (defconst gdb-stack-list-locals-regexp
3573 "{.*?name=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\"")
3575 (defvar gdb-locals-watch-map-1
3578 (define-key map "\r" 'gud-watch)
3579 (define-key map [mouse-2] 'gud-watch)
3583 (defvar gdb-edit-locals-map-1
3586 (define-key map "\r" 'gdb-edit-locals-value)
3587 (define-key map [mouse-2] 'gdb-edit-locals-value)
3591 (defun gdb-edit-locals-value (&optional event)
3599 (gdb-enqueue-input
3600 (list (concat gdb-server-prefix"set variable " var " = " value "\n")
3604 ;; These can be expanded using gud-watch.
3605 (defun gdb-stack-list-locals-handler ()
3606 (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1
3607 gdb-pending-triggers))
3609 (if (re-search-forward gdb-error-regexp nil t)
3611 (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
3618 (while (re-search-forward gdb-stack-list-locals-regexp nil t)
3625 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
3630 (buffer-read-only nil) (name) (value))
3633 (setq name (car local))
3637 (add-text-properties 0 (length name)
3640 local-map ,gdb-locals-watch-map-1)
3641 name)
3645 local-map ,gdb-edit-locals-map-1)
3648 (concat name "\t" (nth 1 local)
3653 (defun gdb-get-register-names ()
3656 (setq gdb-register-names nil)
3657 (while (re-search-forward gdb-data-list-register-names-regexp nil t)
3658 (push (match-string 1) gdb-register-names)))
3660 (provide 'gdb-ui)
3663 ;;; gdb-ui.el ends here