(gud-def): Add %c case.

[gnu-emacs] / lisp / progmodes / gud.el

diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 667b0462a366e2425ea65865f7319cb5ead1c229..11259aa396541215f47be085877ee51822abf6cd 100644 (file)
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -83,6 +83,8 @@ Supported debuggers include gdb, sdb, dbx, xdb, perldb, pdb (Python), jdb, and b
 (defvar gud-minor-mode nil)
 (put 'gud-minor-mode 'permanent-local t)
 
 (defvar gud-minor-mode nil)
 (put 'gud-minor-mode 'permanent-local t)
 

+(defvar gud-comint-buffer nil)
+

 (defvar gud-keep-buffer nil)
 
 (defun gud-symbol (sym &optional soft minor-mode)
 (defvar gud-keep-buffer nil)
 
 (defun gud-symbol (sym &optional soft minor-mode)


@@ -174,7 +176,7 @@ Used to grey out relevant togolbar icons.")
                  :enable (and (not gud-running)
                               (memq gud-minor-mode
                                     '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
                  :enable (and (not gud-running)
                               (memq gud-minor-mode
                                     '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))

-    ([pp]      menu-item "Print the emacs s-expression" gud-pp
+    ([pp]      menu-item "Print S-expression" gud-pp

                   :enable (and (not gud-running)
                                  gdb-active-process)
                  :visible (and (string-equal
                   :enable (and (not gud-running)
                                  gdb-active-process)
                  :visible (and (string-equal


@@ -234,9 +236,6 @@ Used to grey out relevant togolbar icons.")
                     (gud-run . "gud/run")
                     (gud-go . "gud/go")
                     (gud-stop-subjob . "gud/stop")
                     (gud-run . "gud/run")
                     (gud-go . "gud/go")
                     (gud-stop-subjob . "gud/stop")

-                    ;; gud-s, gud-si etc. instead of gud-step,
-                    ;; gud-stepi, to avoid file-name clashes on DOS
-                    ;; 8+3 filesystems.

                     (gud-cont . "gud/cont")
                     (gud-until . "gud/until")
                     (gud-next . "gud/next")
                     (gud-cont . "gud/cont")
                     (gud-until . "gud/until")
                     (gud-next . "gud/next")


@@ -304,13 +303,15 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
 optional doc string DOC.  Certain %-escapes in the string arguments
 are interpreted specially if present.  These are:
 
 optional doc string DOC.  Certain %-escapes in the string arguments
 are interpreted specially if present.  These are:
 

-  %f    name (without directory) of current source file.
-  %F    name (without directory or extension) of current source file.
-  %d    directory of current source file.
-  %l    number of current source line
-  %e    text of the C lvalue or function-call expression surrounding point.
-  %a    text of the hexadecimal address surrounding point
-  %p    prefix argument to the command (if any) as a number
+  %f -- Name (without directory) of current source file.
+  %F -- Name (without directory or extension) of current source file.
+  %d -- Directory of current source file.
+  %l -- Number of current source line.
+  %e -- Text of the C lvalue or function-call expression surrounding point.
+  %a -- Text of the hexadecimal address surrounding point.
+  %p -- Prefix argument to the command (if any) as a number.
+  %c -- Fully qualified class name derived from the expression
+        surrounding point (jdb only).

 
   The `current' source file is the file of the current buffer (if
 we're in a C file) or the source file current at the last break or
 
   The `current' source file is the file of the current buffer (if
 we're in a C file) or the source file current at the last break or


@@ -377,8 +378,9 @@ t means that there is no stack, and we are in display-file mode.")
 (defun gud-speedbar-item-info ()
   "Display the data type of the watch expression element."
   (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)))
 (defun gud-speedbar-item-info ()
   "Display the data type of the watch expression element."
   (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)))

-    (if (nth 4 var)
-       (speedbar-message "%s" (nth 3 var)))))
+    (if (nth 6 var)
+       (speedbar-message "%s: %s" (nth 6 var) (nth 3 var))
+      (speedbar-message "%s" (nth 3 var)))))

 
 (defun gud-install-speedbar-variables ()
   "Install those variables used by speedbar to enhance gud/gdb."
 
 (defun gud-install-speedbar-variables ()
   "Install those variables used by speedbar to enhance gud/gdb."


@@ -446,8 +448,7 @@ required by the caller."
        (when (or gdb-force-update
                  (not (save-excursion
                         (goto-char (point-min))
        (when (or gdb-force-update
                  (not (save-excursion
                         (goto-char (point-min))

-                        (let ((case-fold-search t))
-                          (looking-at "Watch Expressions:")))))
+                        (looking-at "Watch Expressions:"))))

          (erase-buffer)
          (insert "Watch Expressions:\n")
          (if gdb-speedbar-auto-raise
          (erase-buffer)
          (insert "Watch Expressions:\n")
          (if gdb-speedbar-auto-raise


@@ -455,7 +456,7 @@ required by the caller."
          (let ((var-list gdb-var-list) parent)
            (while var-list
              (let* (char (depth 0) (start 0) (var (car var-list))
          (let ((var-list gdb-var-list) parent)
            (while var-list
              (let* (char (depth 0) (start 0) (var (car var-list))

-                         (expr (car var)) (varnum (nth 1 var))
+                         (varnum (car var)) (expr (nth 1 var))

                          (type (nth 3 var)) (value (nth 4 var))
                          (status (nth 5 var)))
                (put-text-property
                          (type (nth 3 var)) (value (nth 4 var))
                          (status (nth 5 var)))
                (put-text-property


@@ -483,9 +484,9 @@ required by the caller."
                       t)
                     depth)
                  (if (eq status 'out-of-scope) (setq parent 'shadow))
                       t)
                     depth)
                  (if (eq status 'out-of-scope) (setq parent 'shadow))

-                 (if (and (cadr var-list)
+                 (if (and (nth 1 var-list)

                           (string-match (concat varnum "\\.")
                           (string-match (concat varnum "\\.")

-                                        (cadr (cadr var-list))))
+                                        (car (nth 1 var-list))))

                      (setq char ?-)
                    (setq char ?+))
                  (if (string-match "\\*$" type)
                      (setq char ?-)
                    (setq char ?+))
                  (if (string-match "\\*$" type)


@@ -493,11 +494,15 @@ required by the caller."
                       'bracket char
                       'gdb-speedbar-expand-node varnum
                       (concat expr "\t" type "\t" value)
                       'bracket char
                       'gdb-speedbar-expand-node varnum
                       (concat expr "\t" type "\t" value)

-                      (if (or parent status)
+                      (if (or parent (eq status 'out-of-scope))

                         nil 'gdb-edit-value)
                       nil
                         nil 'gdb-edit-value)
                       nil

-                      (if (and (or parent (eq status 'out-of-scope))
-                               gdb-show-changed-values) 'shadow t)
+                      (if gdb-show-changed-values
+                          (or parent (case status
+                                           (changed 'font-lock-warning-face)
+                                           (out-of-scope 'shadow)
+                                           (t t)))
+                        t)

                       depth)
                    (speedbar-make-tag-line
                     'bracket char
                       depth)
                    (speedbar-make-tag-line
                     'bracket char


@@ -682,6 +687,7 @@ To run GDB in text command mode, set `gud-gdb-command-name' to
 
   (if (and gud-comint-buffer
           (buffer-name gud-comint-buffer)
 
   (if (and gud-comint-buffer
           (buffer-name gud-comint-buffer)

+          (get-buffer-process gud-comint-buffer)

           (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
       (error "Multiple debugging is only supported with \"gdb --fullname\""))
 
           (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)))
       (error "Multiple debugging is only supported with \"gdb --fullname\""))
 


@@ -737,16 +743,18 @@ To run GDB in text command mode, set `gud-gdb-command-name' to
 ;; The completion list is constructed by the process filter.
 (defvar gud-gdb-fetched-lines)
 
 ;; The completion list is constructed by the process filter.
 (defvar gud-gdb-fetched-lines)
 

-(defvar gud-comint-buffer nil)
-
-(defun gud-gdb-complete-command ()
+(defun gud-gdb-complete-command (&optional command a b)

   "Perform completion on the GDB command preceding point.
 This is implemented using the GDB `complete' command which isn't
 available with older versions of GDB."
   (interactive)
   "Perform completion on the GDB command preceding point.
 This is implemented using the GDB `complete' command which isn't
 available with older versions of GDB."
   (interactive)

-  (let* ((end (point))
-        (command (buffer-substring (comint-line-beginning-position) end))
-        (command-word
+  (if command
+      ;; Used by gud-watch in mini-buffer.
+      (setq command (concat "p " command))
+    ;; Used in GUD buffer.
+    (let ((end (point)))
+      (setq command (buffer-substring (comint-line-beginning-position) end))))
+  (let* ((command-word

          ;; Find the word break.  This match will always succeed.
          (and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
               (substring command (match-beginning 2))))
          ;; Find the word break.  This match will always succeed.
          (and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
               (substring command (match-beginning 2))))


@@ -865,13 +873,14 @@ It is passed through FILTER before we look at it."
 
 (defun gud-gdb-run-command-fetch-lines (command buffer &optional skip)
   "Run COMMAND, and return the list of lines it outputs.
 
 (defun gud-gdb-run-command-fetch-lines (command buffer &optional skip)
   "Run COMMAND, and return the list of lines it outputs.

-BUFFER is the GUD buffer in which to run the command.
+BUFFER is the current buffer which may be the GUD buffer in which to run.

 SKIP is the number of chars to skip on each lines, it defaults to 0."
 SKIP is the number of chars to skip on each lines, it defaults to 0."

-  (with-current-buffer buffer
-    (if (save-excursion
-         (goto-char (point-max))
-         (forward-line 0)
-         (not (looking-at comint-prompt-regexp)))
+  (with-current-buffer gud-comint-buffer
+    (if (and (eq gud-comint-buffer buffer)
+            (save-excursion
+              (goto-char (point-max))
+              (forward-line 0)
+              (not (looking-at comint-prompt-regexp))))

        nil
       ;; Much of this copied from GDB complete, but I'm grabbing the stack
       ;; frame instead.
        nil
       ;; Much of this copied from GDB complete, but I'm grabbing the stack
       ;; frame instead.


@@ -880,12 +889,13 @@ SKIP is the number of chars to skip on each lines, it defaults to 0."
            (gud-gdb-fetch-lines-string nil)
            (gud-gdb-fetch-lines-break (or skip 0))
            (gud-marker-filter
            (gud-gdb-fetch-lines-string nil)
            (gud-gdb-fetch-lines-break (or skip 0))
            (gud-marker-filter

-            `(lambda (string) (gud-gdb-fetch-lines-filter string ',gud-marker-filter))))
+            `(lambda (string)
+               (gud-gdb-fetch-lines-filter string ',gud-marker-filter))))

        ;; Issue the command to GDB.
        (gud-basic-call command)
        ;; Slurp the output.
        (while gud-gdb-fetch-lines-in-progress
        ;; Issue the command to GDB.
        (gud-basic-call command)
        ;; Slurp the output.
        (while gud-gdb-fetch-lines-in-progress

-         (accept-process-output (get-buffer-process buffer)))
+         (accept-process-output (get-buffer-process gud-comint-buffer)))

        (nreverse gud-gdb-fetched-lines)))))
 
 \f
        (nreverse gud-gdb-fetched-lines)))))
 
 \f


@@ -2795,7 +2805,9 @@ Obeying it means displaying in another window the specified file and line."
   (let ((insource (not (eq (current-buffer) gud-comint-buffer)))
        (frame (or gud-last-frame gud-last-last-frame))
        result)
   (let ((insource (not (eq (current-buffer) gud-comint-buffer)))
        (frame (or gud-last-frame gud-last-last-frame))
        result)

-    (while (and str (string-match "\\([^%]*\\)%\\([adeflpc]\\)" str))
+    (while (and str
+               (let ((case-fold-search nil))
+                 (string-match "\\([^%]*\\)%\\([adefFlpc]\\)" str)))

       (let ((key (string-to-char (match-string 2 str)))
            subst)
        (cond
       (let ((key (string-to-char (match-string 2 str)))
            subst)
        (cond


@@ -2880,8 +2892,11 @@ Obeying it means displaying in another window the specified file and line."
       (set-buffer gud-comint-buffer)
       (save-restriction
        (widen)
       (set-buffer gud-comint-buffer)
       (save-restriction
        (widen)

-       (goto-char (process-mark proc))
-       (forward-line 0)
+       (if (marker-position gud-delete-prompt-marker)
+           ;; We get here when printing an expression.
+           (goto-char gud-delete-prompt-marker)
+         (goto-char (process-mark proc))
+         (forward-line 0))

        (if (looking-at comint-prompt-regexp)
            (set-marker gud-delete-prompt-marker (point)))
        (if (memq gud-minor-mode '(gdbmi gdba))
        (if (looking-at comint-prompt-regexp)
            (set-marker gud-delete-prompt-marker (point)))
        (if (memq gud-minor-mode '(gdbmi gdba))


@@ -2902,7 +2917,21 @@ Obeying it means displaying in another window the specified file and line."
 (defvar gud-find-expr-function 'gud-find-c-expr)
 
 (defun gud-find-expr (&rest args)
 (defvar gud-find-expr-function 'gud-find-c-expr)
 
 (defun gud-find-expr (&rest args)

-  (apply gud-find-expr-function args))
+  (let ((expr (if (and transient-mark-mode mark-active)
+                 (buffer-substring (region-beginning) (region-end))
+               (apply gud-find-expr-function args))))
+    (save-match-data
+      (if (string-match "\n" expr)
+         (error "Expression must not include a newline"))
+      (with-current-buffer gud-comint-buffer
+       (save-excursion
+         (goto-char (process-mark (get-buffer-process gud-comint-buffer)))
+         (forward-line 0)
+         (when (looking-at comint-prompt-regexp)
+           (set-marker gud-delete-prompt-marker (point))
+           (set-marker-insertion-type gud-delete-prompt-marker t))
+         (insert (concat  expr " = ")))))
+    expr))

 
 ;; The next eight functions are hacked from gdbsrc.el by
 ;; Debby Ayers <ayers@asc.slb.com>,
 
 ;; The next eight functions are hacked from gdbsrc.el by
 ;; Debby Ayers <ayers@asc.slb.com>,


@@ -3269,11 +3298,10 @@ Treats actions as defuns."
     (remove-hook 'tooltip-hook 'gud-tooltip-tips)
     (define-key global-map [mouse-movement] 'ignore)))
   (gud-tooltip-activate-mouse-motions-if-enabled)
     (remove-hook 'tooltip-hook 'gud-tooltip-tips)
     (define-key global-map [mouse-movement] 'ignore)))
   (gud-tooltip-activate-mouse-motions-if-enabled)

-  (if (and
-       gud-comint-buffer
-       (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
-       (with-current-buffer gud-comint-buffer
-       (memq gud-minor-mode '(gdbmi gdba))))
+  (if (and gud-comint-buffer
+          (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
+          (memq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
+                '(gdbmi gdba)))

       (if gud-tooltip-mode
          (progn
            (dolist (buffer (buffer-list))
       (if gud-tooltip-mode
          (progn
            (dolist (buffer (buffer-list))


@@ -3372,7 +3400,7 @@ For C this would dereference a pointer expression.")
   "The mouse movement event that led to a tooltip display.
 This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
 
   "The mouse movement event that led to a tooltip display.
 This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
 

-(defun gud-tooltip-dereference ()
+(defun gud-tooltip-dereference (&optional arg)

   "Toggle whether tooltips should show `* expr' or `expr'.
 With arg, dereference expr iff arg is positive."
  (interactive "P")
   "Toggle whether tooltips should show `* expr' or `expr'.
 With arg, dereference expr iff arg is positive."
  (interactive "P")