/[emacs]/emacs/lisp/progmodes/gdb-ui.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/gdb-ui.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.124 by nickrob, Tue Dec 6 02:31:16 2005 UTC revision 1.125 by nickrob, Tue Dec 6 21:42:54 2005 UTC
# Line 93  Line 93 
93  (require 'gud)  (require 'gud)
94    
95  (defvar tool-bar-map)  (defvar tool-bar-map)
96    (defvar speedbar-initial-expansion-list-name)
97    
98  (defvar gdb-frame-address "main" "Initialization for Assembler buffer.")  (defvar gdb-frame-address "main" "Initialization for Assembler buffer.")
99  (defvar gdb-previous-frame-address nil)  (defvar gdb-previous-frame-address nil)
# Line 156  gdba (gdb-ui.el) uses all five values, g Line 157  gdba (gdb-ui.el) uses all five values, g
157    "A list of trigger functions that have run later than their output    "A list of trigger functions that have run later than their output
158  handlers.")  handlers.")
159    
160  ;; end of gdb variables  (defvar gdb-first-post-prompt nil)
161    (defvar gdb-version nil)
162    (defvar gdb-locals-font-lock-keywords nil)
163    (defconst gdb-error-regexp "\\^error,msg=\"\\(.+\\)\"")
164    
165    (defvar gdb-locals-font-lock-keywords-1
166      '(
167        ;; var = (struct struct_tag) value
168        ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)"
169          (1 font-lock-variable-name-face)
170          (3 font-lock-keyword-face)
171          (4 font-lock-type-face))
172        ;; var = (type) value
173        ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)"
174          (1 font-lock-variable-name-face)
175          (3 font-lock-type-face))
176        ;; var = val
177        ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]"
178          (1 font-lock-variable-name-face))
179        )
180      "Font lock keywords used in `gdb-local-mode'.")
181    
182    (defvar gdb-locals-font-lock-keywords-2
183      '(
184        ;; var = type value
185        ( "\\(^\\(\\sw\\|[_.]\\)+\\)\t+\\(\\(\\sw\\|[_.]\\)+\\)"
186          (1 font-lock-variable-name-face)
187          (3 font-lock-type-face))
188        )
189      "Font lock keywords used in `gdb-local-mode'.")
190    
191    ;; Variables for GDB 6.4+
192    
193    (defvar gdb-source-file-list nil
194      "List of source files for the current executable")
195    (defvar gdb-register-names nil "List of register names.")
196    (defvar gdb-changed-registers nil
197      "List of changed register numbers (strings).")
198    
199  ;;;###autoload  ;;;###autoload
200  (defun gdba (command-line)  (defun gdba (command-line)
# Line 213  detailed description of this mode. Line 251  detailed description of this mode.
251    ;;    ;;
252    ;; Let's start with a basic gud-gdb buffer and then modify it a bit.    ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
253    (gdb command-line)    (gdb command-line)
254    (gdb-ann3))    (gdb-init-1))
255    
256  (defvar gdb-debug-log nil)  (defvar gdb-debug-log nil)
257    
# Line 356  With arg, use separate IO iff arg is pos Line 394  With arg, use separate IO iff arg is pos
394            (setq expr (concat (car var1) "." (match-string 2 varno)))))            (setq expr (concat (car var1) "." (match-string 2 varno)))))
395      expr))      expr))
396    
397  (defun gdb-ann3 ()  (defun gdb-init-1 ()
398    (setq gdb-debug-log nil)    (setq gdb-debug-log nil)
399    (set (make-local-variable 'gud-minor-mode) 'gdba)    (set (make-local-variable 'gud-minor-mode) 'gdba)
400    (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)    (set (make-local-variable 'gud-marker-filter) 'gud-gdba-marker-filter)
# Line 413  With arg, use separate IO iff arg is pos Line 451  With arg, use separate IO iff arg is pos
451      'gdb-mouse-toggle-breakpoint-fringe)      'gdb-mouse-toggle-breakpoint-fringe)
452    
453    (setq comint-input-sender 'gdb-send)    (setq comint-input-sender 'gdb-send)
454    ;;  
455    ;; (re-)initialize    ;; (re-)initialize
456    (setq gdb-frame-address (if gdb-show-main "main" nil))    (setq gdb-frame-address (if gdb-show-main "main" nil))
457    (setq gdb-previous-frame-address nil    (setq gdb-previous-frame-address nil
# Line 424  With arg, use separate IO iff arg is pos Line 462  With arg, use separate IO iff arg is pos
462          gdb-frame-number nil          gdb-frame-number nil
463          gdb-var-list nil          gdb-var-list nil
464          gdb-var-changed nil          gdb-var-changed nil
465          gdb-first-prompt nil          gdb-first-post-prompt t
466          gdb-prompting nil          gdb-prompting nil
467          gdb-input-queue nil          gdb-input-queue nil
468          gdb-current-item nil          gdb-current-item nil
# Line 434  With arg, use separate IO iff arg is pos Line 472  With arg, use separate IO iff arg is pos
472          gdb-flush-pending-output nil          gdb-flush-pending-output nil
473          gdb-location-alist nil          gdb-location-alist nil
474          gdb-find-file-unhook nil          gdb-find-file-unhook nil
475            gdb-source-file-list nil
476          gdb-error nil          gdb-error nil
477          gdb-macro-info nil          gdb-macro-info nil
478          gdb-buffer-fringe-width (car (window-fringes)))          gdb-buffer-fringe-width (car (window-fringes)))
479    ;;  
480    (setq gdb-buffer-type 'gdba)    (setq gdb-buffer-type 'gdba)
481    ;;  
482    (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io))    (if gdb-use-inferior-io-buffer (gdb-clear-inferior-io))
483    ;;  
484      ;; Hack to see test for GDB 6.4+ (-stack-info-frame was implemented in 6.4)
485      (setq gdb-version nil)
486      (gdb-enqueue-input (list "server interpreter mi -stack-info-frame\n"
487                               'gdb-get-version)))
488    
489    (defun gdb-init-2 ()
490    (if (eq window-system 'w32)    (if (eq window-system 'w32)
491        (gdb-enqueue-input (list "set new-console off\n" 'ignore)))        (gdb-enqueue-input (list "set new-console off\n" 'ignore)))
492    (gdb-enqueue-input (list "set height 0\n" 'ignore))    (gdb-enqueue-input (list "set height 0\n" 'ignore))
# Line 450  With arg, use separate IO iff arg is pos Line 495  With arg, use separate IO iff arg is pos
495    (gdb-enqueue-input (list "server list main\n"   'ignore))   ; C program    (gdb-enqueue-input (list "server list main\n"   'ignore))   ; C program
496    (gdb-enqueue-input (list "server list MAIN__\n" 'ignore))   ; Fortran program    (gdb-enqueue-input (list "server list MAIN__\n" 'ignore))   ; Fortran program
497    (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))    (gdb-enqueue-input (list "server info source\n" 'gdb-source-info))
498    ;;  
499    (gdb-set-gud-minor-mode-existing-buffers)    (if (string-equal gdb-version "pre-6.4")
500          (progn
501            (gdb-set-gud-minor-mode-existing-buffers)
502            (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-1))
503        (gdb-enqueue-input
504         (list "server interpreter mi -data-list-register-names\n"
505             'gdb-get-register-names))
506        ; Needs GDB 6.2 onwards.
507        (gdb-enqueue-input
508         (list "server interpreter mi \"-file-list-exec-source-files\"\n"
509               'gdb-set-gud-minor-mode-existing-buffers-1))
510        (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2))
511    
512    (run-hooks 'gdba-mode-hook))    (run-hooks 'gdba-mode-hook))
513    
514    (defun gdb-get-version ()
515      (goto-char (point-min))
516      (if (and (re-search-forward gdb-error-regexp nil t)
517               (string-match ".*(missing implementation)" (match-string 1)))
518          (setq gdb-version "pre-6.4")
519        (setq gdb-version "6.4+"))
520      (gdb-init-2))
521    
522  (defun gdb-mouse-until (event)  (defun gdb-mouse-until (event)
523    "Execute source lines by dragging the overlay arrow (fringe) with the mouse."    "Execute source lines by dragging the overlay arrow (fringe) with the mouse."
524    (interactive "e")    (interactive "e")
# Line 504  With arg, use separate IO iff arg is pos Line 569  With arg, use separate IO iff arg is pos
569    :group 'gud    :group 'gud
570    :version "22.1")    :version "22.1")
571    
572  (defun gud-watch ()  (defun gud-watch (&optional event)
573    "Watch expression at point."    "Watch expression at point."
574    (interactive)    (interactive (list last-input-event))
575      (if event (posn-set-point (event-end event)))
576    (require 'tooltip)    (require 'tooltip)
577    (save-selected-window    (save-selected-window
578      (let ((expr (tooltip-identifier-from-point (point))))      (let ((expr (tooltip-identifier-from-point (point))))
# Line 692  TOKEN is data related to this node. Line 758  TOKEN is data related to this node.
758  INDENT is the current indentation depth."  INDENT is the current indentation depth."
759    (cond ((string-match "+" text)        ;expand this node    (cond ((string-match "+" text)        ;expand this node
760           (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)           (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
761               (gdb-var-list-children token)               (if (string-equal gdb-version "pre-6.4")
762                     (gdb-var-list-children token)
763                   (gdb-var-list-children-1 token))
764             (progn             (progn
765               (gdbmi-var-update)               (gdbmi-var-update)
766               (gdbmi-var-list-children token))))               (gdbmi-var-list-children token))))
# Line 781  The key should be one of the cars in `gd Line 849  The key should be one of the cars in `gd
849  ;; GUD buffers are an exception to the rules  ;; GUD buffers are an exception to the rules
850  (gdb-set-buffer-rules 'gdba 'error)  (gdb-set-buffer-rules 'gdba 'error)
851    
 ;;  
852  ;; Partial-output buffer : This accumulates output from a command executed on  ;; Partial-output buffer : This accumulates output from a command executed on
853  ;; behalf of emacs (rather than the user).  ;; behalf of emacs (rather than the user).
854  ;;  ;;
# Line 877  The key should be one of the cars in `gd Line 944  The key should be one of the cars in `gd
944     (get-buffer-process gud-comint-buffer)))     (get-buffer-process gud-comint-buffer)))
945    
946    
 ;;  
947  ;; gdb communications  ;; gdb communications
948  ;;  ;;
949    
# Line 1031  happens to be in effect." Line 1097  happens to be in effect."
1097  (defun gdb-prompt (ignored)  (defun gdb-prompt (ignored)
1098    "An annotation handler for `prompt'.    "An annotation handler for `prompt'.
1099  This sends the next command (if any) to gdb."  This sends the next command (if any) to gdb."
1100    (when gdb-first-prompt (gdb-ann3))    (when gdb-first-prompt
1101        (gdb-init-1)
1102        (setq gdb-first-prompt nil))
1103    (let ((sink gdb-output-sink))    (let ((sink gdb-output-sink))
1104      (cond      (cond
1105       ((eq sink 'user) t)       ((eq sink 'user) t)
# Line 1128  sink to `user' in `gdb-stopping', that i Line 1196  sink to `user' in `gdb-stopping', that i
1196    "An annotation handler for `post-prompt'.    "An annotation handler for `post-prompt'.
1197  This begins the collection of output from the current command if that  This begins the collection of output from the current command if that
1198  happens to be appropriate."  happens to be appropriate."
1199    (unless gdb-pending-triggers    ;; Don't add to queue if there outstanding items or GDB is not known yet.
1200      (unless (or gdb-pending-triggers gdb-first-post-prompt)
1201      (gdb-get-selected-frame)      (gdb-get-selected-frame)
1202      (gdb-invalidate-frames)      (gdb-invalidate-frames)
1203      (gdb-invalidate-breakpoints)      (gdb-invalidate-breakpoints)
1204      ;; Do this through gdb-get-selected-frame -> gdb-frame-handler      ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1205      ;; so gdb-frame-address is updated.      ;; so gdb-frame-address is updated.
1206      ;; (gdb-invalidate-assembler)      ;; (gdb-invalidate-assembler)
1207      (gdb-invalidate-registers)  
1208        (if (string-equal gdb-version "pre-6.4")
1209            (gdb-invalidate-registers)
1210          (gdb-get-changed-registers)
1211          (gdb-invalidate-registers-1))
1212    
1213      (gdb-invalidate-memory)      (gdb-invalidate-memory)
1214      (gdb-invalidate-locals)      (if (string-equal gdb-version "pre-6.4")
1215            (gdb-invalidate-locals)
1216          (gdb-invalidate-locals-1))
1217    
1218      (gdb-invalidate-threads)      (gdb-invalidate-threads)
1219      (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.      (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
1220        ;; FIXME: with GDB-6 on Darwin, this might very well work.        ;; FIXME: with GDB-6 on Darwin, this might very well work.
# Line 1146  happens to be appropriate." Line 1223  happens to be appropriate."
1223          (setq gdb-var-changed t)    ; force update          (setq gdb-var-changed t)    ; force update
1224          (dolist (var gdb-var-list)          (dolist (var gdb-var-list)
1225            (setcar (nthcdr 5 var) nil))            (setcar (nthcdr 5 var) nil))
1226          (gdb-var-update))))          (if (string-equal gdb-version "pre-6.4")
1227                (gdb-var-update)
1228              (gdb-var-update-1)))))
1229      (setq gdb-first-post-prompt nil)
1230    (let ((sink gdb-output-sink))    (let ((sink gdb-output-sink))
1231      (cond      (cond
1232       ((eq sink 'user) t)       ((eq sink 'user) t)
# Line 1908  static char *magick[] = { Line 1988  static char *magick[] = {
1988  \\{gdb-registers-mode-map}"  \\{gdb-registers-mode-map}"
1989    (kill-all-local-variables)    (kill-all-local-variables)
1990    (setq major-mode 'gdb-registers-mode)    (setq major-mode 'gdb-registers-mode)
1991    (setq mode-name (if gdb-all-registers "Registers:All" "Registers:"))    (setq mode-name "Registers")
1992    (setq buffer-read-only t)    (setq buffer-read-only t)
1993    (use-local-map gdb-registers-mode-map)    (use-local-map gdb-registers-mode-map)
1994    (run-mode-hooks 'gdb-registers-mode-hook)    (run-mode-hooks 'gdb-registers-mode-hook)
1995    (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)    (if (string-equal gdb-version "pre-6.4")
1996        'gdb-invalidate-registers        (progn
1997      'gdbmi-invalidate-registers))          (if gdb-all-registers (setq mode-name "Registers:All"))
1998            'gdb-invalidate-registers)
1999        'gdb-invalidate-registers-1))
2000    
2001  (defun gdb-registers-buffer-name ()  (defun gdb-registers-buffer-name ()
2002    (with-current-buffer gud-comint-buffer    (with-current-buffer gud-comint-buffer
# Line 1934  static char *magick[] = { Line 2016  static char *magick[] = {
2016      (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))))      (display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))))
2017    
2018  (defun gdb-all-registers ()  (defun gdb-all-registers ()
2019    "Toggle the display of floating-point registers."    "Toggle the display of floating-point registers (pre GDB 6.4 only)."
2020    (interactive)    (interactive)
2021    (if gdb-all-registers    (when (string-equal gdb-version "pre-6.4")
2022        (progn      (if gdb-all-registers
2023          (setq gdb-all-registers nil)          (progn
2024          (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer)            (setq gdb-all-registers nil)
2025            (setq mode-name "Registers:")))            (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer)
2026      (setq gdb-all-registers t)              (setq mode-name "Registers")))
2027      (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer)        (setq gdb-all-registers t)
2028        (setq mode-name "Registers:All")))        (with-current-buffer (gdb-get-create-buffer 'gdb-registers-buffer)
2029    (message (format "Display of floating-point registers %sabled"          (setq mode-name "Registers:All")))
2030                     (if gdb-all-registers "en" "dis")))      (message (format "Display of floating-point registers %sabled"
2031    (gdb-invalidate-registers))                       (if gdb-all-registers "en" "dis")))
2032        (gdb-invalidate-registers)))
2033    
2034    
2035  ;; Memory buffer.  ;; Memory buffer.
# Line 2050  static char *magick[] = { Line 2133  static char *magick[] = {
2133    (customize-set-variable 'gdb-memory-format "x")    (customize-set-variable 'gdb-memory-format "x")
2134    (gdb-invalidate-memory))    (gdb-invalidate-memory))
2135    
2136  (defvar gdb-memory-format-keymap  (defvar gdb-memory-format-map
2137    (let ((map (make-sparse-keymap)))    (let ((map (make-sparse-keymap)))
2138      (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)      (define-key map [header-line down-mouse-3] 'gdb-memory-format-menu-1)
2139      map)      map)
# Line 2112  static char *magick[] = { Line 2195  static char *magick[] = {
2195    (customize-set-variable 'gdb-memory-unit "b")    (customize-set-variable 'gdb-memory-unit "b")
2196    (gdb-invalidate-memory))    (gdb-invalidate-memory))
2197    
2198  (defvar gdb-memory-unit-keymap  (defvar gdb-memory-unit-map
2199    (let ((map (make-sparse-keymap)))    (let ((map (make-sparse-keymap)))
2200      (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)      (define-key map [header-line down-mouse-3] 'gdb-memory-unit-menu-1)
2201      map)      map)
# Line 2227  corresponding to the mode line clicked." Line 2310  corresponding to the mode line clicked."
2310                         'face font-lock-warning-face                         'face font-lock-warning-face
2311                         'help-echo "mouse-3: Select display format"                         'help-echo "mouse-3: Select display format"
2312                         'mouse-face 'mode-line-highlight                         'mouse-face 'mode-line-highlight
2313                         'local-map gdb-memory-format-keymap)                         'local-map gdb-memory-format-map)
2314             "  Unit Size: "             "  Unit Size: "
2315             (propertize gdb-memory-unit             (propertize gdb-memory-unit
2316                         'face font-lock-warning-face                         'face font-lock-warning-face
2317                         'help-echo "mouse-3: Select unit size"                         'help-echo "mouse-3: Select unit size"
2318                         'mouse-face 'mode-line-highlight                         'mouse-face 'mode-line-highlight
2319                         'local-map gdb-memory-unit-keymap))))                         'local-map gdb-memory-unit-map))))
2320    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
2321         '(gdb-memory-font-lock-keywords))         '(gdb-memory-font-lock-keywords))
2322    (run-mode-hooks 'gdb-memory-mode-hook)    (run-mode-hooks 'gdb-memory-mode-hook)
# Line 2268  corresponding to the mode line clicked." Line 2351  corresponding to the mode line clicked."
2351    "server info locals\n"    "server info locals\n"
2352    gdb-info-locals-handler)    gdb-info-locals-handler)
2353    
2354  (defvar gdb-locals-watch-keymap  (defvar gdb-locals-watch-map
2355    (let ((map (make-sparse-keymap)))    (let ((map (make-sparse-keymap)))
2356      (define-key map "\r" '(lambda () (interactive)      (define-key map "\r" '(lambda () (interactive)
2357                              (beginning-of-line)                              (beginning-of-line)
# Line 2284  corresponding to the mode line clicked." Line 2367  corresponding to the mode line clicked."
2367    (concat (propertize "[struct/union]"    (concat (propertize "[struct/union]"
2368                        'mouse-face 'highlight                        'mouse-face 'highlight
2369                        'help-echo "mouse-2: create watch expression"                        'help-echo "mouse-2: create watch expression"
2370                        'local-map gdb-locals-watch-keymap) "\n"))                        'local-map gdb-locals-watch-map) "\n"))
2371    
2372  (defconst gdb-array-string  (defconst gdb-array-string
2373    (concat " " (propertize "[array]"    (concat " " (propertize "[array]"
2374                            'mouse-face 'highlight                            'mouse-face 'highlight
2375                            'help-echo "mouse-2: create watch expression"                            'help-echo "mouse-2: create watch expression"
2376                            'local-map gdb-locals-watch-keymap) "\n"))                            'local-map gdb-locals-watch-map) "\n"))
2377    
2378  ;; Abbreviate for arrays and structures.  ;; Abbreviate for arrays and structures.
2379  ;; These can be expanded using gud-display.  ;; These can be expanded using gud-display.
# Line 2326  corresponding to the mode line clicked." Line 2409  corresponding to the mode line clicked."
2409      (define-key map "q" 'kill-this-buffer)      (define-key map "q" 'kill-this-buffer)
2410       map))       map))
2411    
 (defvar gdb-locals-font-lock-keywords  
   '(  
     ;; var = (struct struct_tag) value  
     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(struct\\) \\(\\(\\sw\\|[_.]\\)+\\)"  
       (1 font-lock-variable-name-face)  
       (3 font-lock-keyword-face)  
       (4 font-lock-type-face))  
     ;; var = (type) value  
     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +(\\(\\(\\sw\\|[_.]\\)+\\)"  
       (1 font-lock-variable-name-face)  
       (3 font-lock-type-face))  
     ;; var = val  
     ( "\\(^\\(\\sw\\|[_.]\\)+\\) += +[^(]"  
       (1 font-lock-variable-name-face))  
     )  
   "Font lock keywords used in `gdb-local-mode'.")  
   
2412  (defun gdb-locals-mode ()  (defun gdb-locals-mode ()
2413    "Major mode for gdb locals.    "Major mode for gdb locals.
2414    
# Line 2356  corresponding to the mode line clicked." Line 2422  corresponding to the mode line clicked."
2422         '(gdb-locals-font-lock-keywords))         '(gdb-locals-font-lock-keywords))
2423    (run-mode-hooks 'gdb-locals-mode-hook)    (run-mode-hooks 'gdb-locals-mode-hook)
2424    (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)    (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
2425        'gdb-invalidate-locals        (if (string-equal gdb-version "pre-6.4")
2426              'gdb-invalidate-locals
2427            'gdb-invalidate-locals-1)
2428      'gdbmi-invalidate-locals))      'gdbmi-invalidate-locals))
2429    
2430  (defun gdb-locals-buffer-name ()  (defun gdb-locals-buffer-name ()
# Line 2614  Add directory to search path for source Line 2682  Add directory to search path for source
2682  (add-hook 'find-file-hook 'gdb-find-file-hook)  (add-hook 'find-file-hook 'gdb-find-file-hook)
2683    
2684  (defun gdb-find-file-hook ()  (defun gdb-find-file-hook ()
2685  "Set up buffer for debugging if file is part of the source code    "Set up buffer for debugging if file is part of the source code
2686  of the current session."  of the current session."
2687    (if (and (not gdb-find-file-unhook)    (if (and (buffer-name gud-comint-buffer)
2688             ;; in case gud or gdb-ui is just loaded             ;; in case gud or gdb-ui is just loaded
2689             gud-comint-buffer             gud-comint-buffer
            (buffer-name gud-comint-buffer)  
2690             (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)             (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
2691                 'gdba))                 'gdba))
2692        (condition-case nil        (if (string-equal gdb-version "pre-6.4")
2693          (gdb-enqueue-input            (condition-case nil
2694           (list (concat gdb-server-prefix "list "                (gdb-enqueue-input
2695                         (file-name-nondirectory buffer-file-name)                 (list (concat gdb-server-prefix "list "
2696                         ":1\n")                               (file-name-nondirectory buffer-file-name)
2697                 `(lambda () (gdb-set-gud-minor-mode ,(current-buffer)))))                               ":1\n")
2698          (error (setq gdb-find-file-unhook t)))))                       `(lambda () (gdb-set-gud-minor-mode ,(current-buffer)))))
2699              (error (setq gdb-find-file-unhook t)))
2700            (if (member buffer-file-name gdb-source-file-list)
2701                (with-current-buffer (find-buffer-visiting buffer-file-name)
2702                  (set (make-local-variable 'gud-minor-mode) 'gdba)
2703                  (set (make-local-variable 'tool-bar-map) gud-tool-bar-map))))))
2704    
2705  ;;from put-image  ;;from put-image
2706  (defun gdb-put-string (putstring pos &optional dprop &rest sprops)  (defun gdb-put-string (putstring pos &optional dprop &rest sprops)
# Line 2907  BUFFER nil or omitted means use the curr Line 2979  BUFFER nil or omitted means use the curr
2979        (setq gdb-current-language (match-string 1)))        (setq gdb-current-language (match-string 1)))
2980    (gdb-invalidate-assembler))    (gdb-invalidate-assembler))
2981    
2982    ;; Code specific to GDB 6.4
2983    
2984    (defconst gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
2985    
2986    (defun gdb-set-gud-minor-mode-existing-buffers-1 ()
2987      "Create list of source files for current GDB session."
2988      (goto-char (point-min))
2989      (while (re-search-forward gdb-source-file-regexp nil t)
2990        (push (match-string 1) gdb-source-file-list))
2991      (dolist (buffer (buffer-list))
2992        (with-current-buffer buffer
2993          (when (member buffer-file-name gdb-source-file-list)
2994            (set (make-local-variable 'gud-minor-mode) 'gdba)
2995            (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
2996            (when gud-tooltip-mode
2997              (make-local-variable 'gdb-define-alist)
2998              (gdb-create-define-alist)
2999              (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))
3000    
3001    ; Uses "-var-list-children --all-values".  Needs GDB 6.1 onwards.
3002    (defun gdb-var-list-children-1 (varnum)
3003      (gdb-enqueue-input
3004       (list (concat "server interpreter mi \"-var-update " varnum "\"\n")
3005             'ignore))
3006      (gdb-enqueue-input
3007       (list (concat "server interpreter mi \"-var-list-children --all-values "  
3008                     varnum "\"\n")
3009                 `(lambda () (gdb-var-list-children-handler-1 ,varnum)))))
3010    
3011    (defconst gdb-var-list-children-regexp-1
3012      "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\
3013    value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")
3014    
3015    (defun gdb-var-list-children-handler-1 (varnum)
3016      (goto-char (point-min))
3017      (let ((var-list nil))
3018        (catch 'child-already-watched
3019          (dolist (var gdb-var-list)
3020            (if (string-equal varnum (cadr var))
3021                (progn
3022                  (push var var-list)
3023                  (while (re-search-forward gdb-var-list-children-regexp-1 nil t)
3024                    (let ((varchild (list (match-string 2)
3025                                          (match-string 1)
3026                                          (match-string 3)
3027                                          (match-string 5)
3028                                          (read (match-string 4))
3029                                          nil)))
3030                      (dolist (var1 gdb-var-list)
3031                        (if (string-equal (cadr var1) (cadr varchild))
3032                            (throw 'child-already-watched nil)))
3033                      (push varchild var-list))))
3034              (push var var-list)))
3035          (setq gdb-var-changed t)
3036          (setq gdb-var-list (nreverse var-list)))))
3037    
3038    ; Uses "-var-update --all-values".  Needs GDB 6.4 onwards.
3039    (defun gdb-var-update-1 ()
3040      (if (not (member 'gdb-var-update gdb-pending-triggers))
3041          (progn
3042            (gdb-enqueue-input
3043             (list
3044              (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
3045                  "server interpreter mi \"-var-update --all-values *\"\n"
3046                "-var-update --all-values *\n")
3047                                     'gdb-var-update-handler-1))
3048            (push 'gdb-var-update gdb-pending-triggers))))
3049    
3050    (defconst gdb-var-update-regexp-1 "name=\"\\(.*?\\)\",value=\\(\".*?\"\\),")
3051    
3052    (defun gdb-var-update-handler-1 ()
3053      (goto-char (point-min))
3054      (while (re-search-forward gdb-var-update-regexp-1 nil t)
3055        (let ((varnum (match-string 1)))
3056          (catch 'var-found1
3057            (let ((num 0))
3058              (dolist (var gdb-var-list)
3059                (if (string-equal varnum (cadr var))
3060                    (progn
3061                      (setcar (nthcdr 5 var) t)
3062                      (setcar (nthcdr 4 var) (read (match-string 2)))
3063                      (setcar (nthcdr num gdb-var-list) var)
3064                      (throw 'var-found1 nil)))
3065                (setq num (+ num 1))))))
3066        (setq gdb-var-changed t))
3067      (setq gdb-pending-triggers
3068       (delq 'gdb-var-update gdb-pending-triggers))
3069      (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
3070        ;; dummy command to update speedbar at right time
3071        (gdb-enqueue-input (list "server pwd\n" 'gdb-speedbar-timer-fn))
3072        ;; keep gdb-pending-triggers non-nil till end
3073        (push 'gdb-speedbar-timer gdb-pending-triggers)))
3074    
3075    ;; Registers buffer.
3076    ;;
3077    (gdb-set-buffer-rules 'gdb-registers-buffer
3078                          'gdb-registers-buffer-name
3079                          'gdb-registers-mode)
3080    
3081    (def-gdb-auto-update-trigger gdb-invalidate-registers-1
3082      (gdb-get-buffer 'gdb-registers-buffer)
3083      (if (eq gud-minor-mode 'gdba)
3084          "server interpreter mi \"-data-list-register-values x\"\n"
3085        "-data-list-register-values x\n")
3086        gdb-data-list-register-values-handler)
3087    
3088    (defconst gdb-data-list-register-values-regexp
3089      "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"")
3090    
3091    (defun gdb-data-list-register-values-handler ()
3092      (setq gdb-pending-triggers (delq 'gdb-invalidate-registers
3093                                       gdb-pending-triggers))
3094      (goto-char (point-min))
3095      (if (re-search-forward gdb-error-regexp nil t)
3096          (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3097            (let ((buffer-read-only nil))
3098              (erase-buffer)
3099              (insert (match-string 1))
3100              (goto-char (point-min))))
3101        (let ((register-list (reverse gdb-register-names))
3102              (register nil) (register-string nil) (register-values nil))
3103          (goto-char (point-min))
3104          (while (re-search-forward gdb-data-list-register-values-regexp nil t)
3105            (setq register (pop register-list))
3106            (setq register-string (concat register "\t" (match-string 2) "\n"))
3107            (if (member (match-string 1) gdb-changed-registers)
3108                (put-text-property 0 (length register-string)
3109                                   'face 'font-lock-warning-face
3110                                   register-string))
3111            (setq register-values
3112                  (concat register-values register-string)))
3113          (let ((buf (gdb-get-buffer 'gdb-registers-buffer)))
3114            (with-current-buffer buf
3115              (let ((p (window-point (get-buffer-window buf 0)))
3116                    (buffer-read-only nil))
3117                (erase-buffer)
3118                (insert register-values)
3119                (set-window-point (get-buffer-window buf 0) p))))))
3120      (gdb-data-list-register-values-custom))
3121    
3122    (defun gdb-data-list-register-values-custom ()
3123      (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
3124        (save-excursion
3125          (let ((buffer-read-only nil)
3126                start end)
3127            (goto-char (point-min))
3128            (while (< (point) (point-max))
3129              (setq start (line-beginning-position))
3130              (setq end (line-end-position))
3131              (when (looking-at "^[^\t]+")
3132                (unless (string-equal (match-string 0) "No registers.")
3133                  (put-text-property start (match-end 0)
3134                                     'face font-lock-variable-name-face)
3135                  (add-text-properties start end
3136                                       '(help-echo "mouse-2: edit value"
3137                                         mouse-face highlight))))
3138              (forward-line 1))))))
3139    
3140    ;; Needs GDB 6.4 onwards (used to fail with no stack).
3141    (defun gdb-get-changed-registers ()
3142      (if (not (member 'gdb-get-changed-registers gdb-pending-triggers))
3143          (progn
3144            (gdb-enqueue-input
3145             (list
3146              (if (eq gud-minor-mode 'gdba)
3147                  "server interpreter mi -data-list-changed-registers\n"
3148                "-data-list-changed-registers\n")
3149                   'gdb-get-changed-registers-handler))
3150            (push 'gdb-get-changed-registers gdb-pending-triggers))))
3151    
3152    (defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")
3153    
3154    (defun gdb-get-changed-registers-handler ()
3155      (setq gdb-pending-triggers
3156            (delq 'gdb-get-changed-registers gdb-pending-triggers))
3157      (setq gdb-changed-registers nil)
3158      (goto-char (point-min))
3159      (while (re-search-forward gdb-data-list-register-names-regexp nil t)
3160        (push (match-string 1) gdb-changed-registers)))
3161    
3162    
3163    ;; Locals buffer.
3164    ;;
3165    ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
3166    (gdb-set-buffer-rules 'gdb-locals-buffer
3167                          'gdb-locals-buffer-name
3168                          'gdb-locals-mode)
3169    
3170    (def-gdb-auto-update-trigger gdb-invalidate-locals-1
3171      (gdb-get-buffer 'gdb-locals-buffer)
3172      "server interpreter mi -\"stack-list-locals --simple-values\"\n"
3173      gdb-stack-list-locals-handler)
3174    
3175    (defconst gdb-stack-list-locals-regexp
3176      "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")
3177    
3178    (defvar gdb-locals-watch-map-1
3179      (let ((map (make-sparse-keymap)))
3180        (define-key map [mouse-2] 'gud-watch)
3181        map)
3182     "Keymap to create watch expression of a complex data type local variable.")
3183    
3184    ;; Dont display values of arrays or structures.
3185    ;; These can be expanded using gud-watch.
3186    (defun gdb-stack-list-locals-handler ()
3187      (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1
3188                                      gdb-pending-triggers))
3189      (let (local locals-list)
3190        (goto-char (point-min))
3191        (while (re-search-forward gdb-stack-list-locals-regexp nil t)
3192          (let ((local (list (match-string 1)
3193                             (match-string 2)
3194                             nil)))
3195            (if (looking-at ",value=\\(\".*\"\\)}")
3196                (setcar (nthcdr 2 local) (read (match-string 1))))
3197            (push local locals-list)))
3198        (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
3199          (and buf (with-current-buffer buf
3200                     (let* ((window (get-buffer-window buf 0))
3201                            (p (window-point window))
3202                            (buffer-read-only nil))
3203                       (erase-buffer)
3204                       (dolist (local locals-list)
3205                         (setq name (car local))
3206                         (if (or (not (nth 2 local))
3207                                 (string-match "\\*$" (nth 1 local)))
3208                           (add-text-properties 0 (length name)
3209                                `(mouse-face highlight
3210                                  help-echo "mouse-2: create watch expression"
3211                                  local-map ,gdb-locals-watch-map-1)
3212                                name))
3213                           (insert
3214                            (concat name "\t" (nth 1 local)
3215                                    "\t" (nth 2 local) "\n")))
3216                       (set-window-point window p)))))))
3217    
3218    (defun gdb-get-register-names ()
3219      "Create a list of register names."
3220      (goto-char (point-min))
3221      (setq gdb-register-names nil)
3222      (while (re-search-forward gdb-data-list-register-names-regexp nil t)
3223        (push (match-string 1) gdb-register-names)))
3224    
3225  (provide 'gdb-ui)  (provide 'gdb-ui)
3226    
3227  ;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352  ;; arch-tag: e9fb00c5-74ef-469f-a088-37384caae352

Legend:
Removed from v.1.124  
changed lines
  Added in v.1.125

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26