[Emacs-diffs] Changes to emacs/lisp/progmodes/gud.el

[Nick Roberts]

Index: emacs/lisp/progmodes/gud.el
diff -c emacs/lisp/progmodes/gud.el:1.35 emacs/lisp/progmodes/gud.el:1.36
*** emacs/lisp/progmodes/gud.el:1.35    Tue May  3 06:47:18 2005
--- emacs/lisp/progmodes/gud.el Fri May  6 22:10:50 2005
***************
*** 39,44 ****
--- 39,46 ----
  
  ;;; Code:
  
+ (eval-when-compile (require 'cl)) ; for case macro
+ 
  (require 'comint)
  (require 'etags)
  
***************
*** 113,123 ****
  
  (easy-mmode-defmap gud-menu-map
    '(([help]     "Info" . gud-goto-info)
!     ([tooltips] menu-item "Toggle GUD tooltips" tooltip-toggle-gud-tips
                    :enable  (and (not emacs-basic-display)
                                (display-graphic-p)
                                (fboundp 'x-show-tip))
!                 :button (:toggle . tooltip-gud-tips-p))
      ([refresh]        "Refresh" . gud-refresh)
      ([run]    menu-item "Run" gud-run
                    :enable (and (not gud-running)
--- 115,125 ----
  
  (easy-mmode-defmap gud-menu-map
    '(([help]     "Info" . gud-goto-info)
!     ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode
                    :enable  (and (not emacs-basic-display)
                                (display-graphic-p)
                                (fboundp 'x-show-tip))
!                 :button (:toggle . gud-tooltip-mode))
      ([refresh]        "Refresh" . gud-refresh)
      ([run]    menu-item "Run" gud-run
                    :enable (and (not gud-running)
***************
*** 228,234 ****
        (with-current-buffer buf
        (set (make-local-variable 'gud-minor-mode) minor-mode)
        (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
!       (when (memq gud-minor-mode '(gdbmi gdba))
          (make-local-variable 'gdb-define-alist)
          (unless  gdb-define-alist (gdb-create-define-alist))
          (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
--- 230,237 ----
        (with-current-buffer buf
        (set (make-local-variable 'gud-minor-mode) minor-mode)
        (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
!       (when (and gud-tooltip-mode
!                  (memq gud-minor-mode '(gdbmi gdba)))
          (make-local-variable 'gdb-define-alist)
          (unless  gdb-define-alist (gdb-create-define-alist))
          (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
***************
*** 3100,3105 ****
--- 3103,3306 ----
         (font-lock-syntactic-face-function
          . gdb-script-font-lock-syntactic-face))))
  
+ 
+ ;;; tooltips for GUD
+ 
+ ;;; Customizable settings
+ (defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode)
+   "List of modes for which to enable GUD tips."
+   :type 'sexp
+   :tag "GUD modes"
+   :group 'tooltip)
+ 
+ (defcustom gud-tooltip-display
+   '((eq (tooltip-event-buffer gud-tooltip-event)
+       (marker-buffer gud-overlay-arrow-position)))
+   "List of forms determining where GUD tooltips are displayed.
+ 
+ Forms in the list are combined with AND.  The default is to display
+ only tooltips in the buffer containing the overlay arrow."
+   :type 'sexp
+   :tag "GUD buffers predicate"
+   :group 'tooltip)
+ 
+ (defcustom gud-tooltip-echo-area nil
+   "Use the echo area instead of frames for GUD tooltips."
+   :type 'boolean
+   :tag "Use echo area"
+   :group 'tooltip)
+ 
+ (define-obsolete-variable-alias 'tooltip-gud-modes
+                                 'gud-tooltip-modes "22.1")
+ (define-obsolete-variable-alias 'tooltip-gud-display
+                                 'gud-tooltip-display "22.1")
+ (define-obsolete-variable-alias 'tooltip-use-echo-area
+                                 'gud-tooltip-echo-area "22.1")
+ 
+ ;;; Reacting on mouse movements
+ 
+ (defun gud-tooltip-change-major-mode ()
+   "Function added to `change-major-mode-hook' when tooltip mode is on."
+   (add-hook 'post-command-hook 
'gud-tooltip-activate-mouse-motions-if-enabled))
+ 
+ (defun gud-tooltip-activate-mouse-motions-if-enabled ()
+   "Reconsider for all buffers whether mouse motion events are desired."
+   (remove-hook 'post-command-hook
+              'gud-tooltip-activate-mouse-motions-if-enabled)
+   (dolist (buffer (buffer-list))
+     (save-excursion
+       (set-buffer buffer)
+       (if (and gud-tooltip-mode
+              (memq major-mode gud-tooltip-modes))
+         (gud-tooltip-activate-mouse-motions t)
+       (gud-tooltip-activate-mouse-motions nil)))))
+ 
+ (defvar gud-tooltip-mouse-motions-active nil
+   "Locally t in a buffer if tooltip processing of mouse motion is enabled.")
+ 
+ (defun gud-tooltip-activate-mouse-motions (activatep)
+   "Activate/deactivate mouse motion events for the current buffer.
+ ACTIVATEP non-nil means activate mouse motion events."
+   (if activatep
+       (progn
+       (make-local-variable 'gud-tooltip-mouse-motions-active)
+       (setq gud-tooltip-mouse-motions-active t)
+       (make-local-variable 'track-mouse)
+       (setq track-mouse t))
+     (when gud-tooltip-mouse-motions-active
+       (kill-local-variable 'gud-tooltip-mouse-motions-active)
+       (kill-local-variable 'track-mouse))))
+ 
+ (defun gud-tooltip-mouse-motion (event)
+   "Command handler for mouse movement events in `global-map'."
+   (interactive "e")
+   (tooltip-hide)
+   (when (car (mouse-pixel-position))
+     (setq tooltip-last-mouse-motion-event (copy-sequence event))
+     (tooltip-start-delayed-tip)))
+ 
+ ;;; Tips for `gud'
+ 
+ (defvar gud-tooltip-original-filter nil
+   "Process filter to restore after GUD output has been received.")
+ 
+ (defvar gud-tooltip-dereference nil
+   "Non-nil means print expressions with a `*' in front of them.
+ For C this would dereference a pointer expression.")
+ 
+ (defvar gud-tooltip-event nil
+   "The mouse movement event that led to a tooltip display.
+ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
+ 
+ (defun gud-tooltip-toggle-dereference ()
+   "Toggle whether tooltips should show `* expr' or `expr'."
+   (interactive)
+   (setq gud-tooltip-dereference (not gud-tooltip-dereference))
+   (when (interactive-p)
+     (message "Dereferencing is now %s."
+            (if gud-tooltip-dereference "on" "off"))))
+ 
+ (define-obsolete-function-alias 'tooltip-gud-toggle-dereference
+                                 'gud-tooltip-toggle-dereference "22.1")
+ 
+ (define-minor-mode gud-tooltip-mode
+   "Toggle the display of GUD tooltips."
+   :global t
+   :group 'gud
+   (if gud-tooltip-mode
+       (progn
+       (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
+       (add-hook 'pre-command-hook 'tooltip-hide)
+       (add-hook 'tooltip-hook 'gud-tooltip-tips)
+       (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion))
+     (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide)
+     (remove-hook 'change-major-mode-hook 'tooltip-change-major-mode)
+     (remove-hook 'tooltip-hook 'gud-tooltip-tips)
+     (define-key global-map [mouse-movement] 'ignore)))
+   (gud-tooltip-activate-mouse-motions-if-enabled)
+   (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
+       (if gud-tooltip-mode
+         (progn
+           (dolist (buffer (buffer-list))
+             (unless (eq buffer gud-comint-buffer)
+               (with-current-buffer buffer
+                 (when (and (memq gud-minor-mode '(gdbmi gdba))
+                            (not (string-match "\\`\\*.+\\*\\'"
+                                               (buffer-name))))
+                   (make-local-variable 'gdb-define-alist)
+                   (gdb-create-define-alist)
+                   (add-hook 'after-save-hook
+                             'gdb-create-define-alist nil t))))))
+       (kill-local-variable 'gdb-define-alist)
+       (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
+ 
+ ; This will only display data that comes in one chunk.
+ ; Larger arrays (say 400 elements) are displayed in
+ ; the tootip incompletely and spill over into the gud buffer.
+ ; Switching the process-filter creates timing problems and
+ ; it may be difficult to do better. Using annotations as in
+ ; gdb-ui.el gets round this problem.
+ (defun gud-tooltip-process-output (process output)
+   "Process debugger output and show it in a tooltip window."
+   (set-process-filter process gud-tooltip-original-filter)
+   (tooltip-show (tooltip-strip-prompt process output)
+               gud-tooltip-echo-area))
+ 
+ (defun gud-tooltip-print-command (expr)
+   "Return a suitable command to print the expression EXPR.
+ If GUD-TOOLTIP-DEREFERENCE is t, also prepend a `*' to EXPR."
+   (when gud-tooltip-dereference
+     (setq expr (concat "*" expr)))
+   (case gud-minor-mode
+     ((gdb gdba) (concat "server print " expr))
+     (dbx (concat "print " expr))
+     (xdb (concat "p " expr))
+     (sdb (concat expr "/"))
+     (perldb expr)))
+ 
+ (defun gud-tooltip-tips (event)
+   "Show tip for identifier or selection under the mouse.
+ The mouse must either point at an identifier or inside a selected
+ region for the tip window to be shown.  If gud-tooltip-dereference is t,
+ add a `*' in front of the printed expression. In the case of a C program
+ controlled by GDB, show the associated #define directives when program is
+ not executing.
+ 
+ This function must return nil if it doesn't handle EVENT."
+   (let (process)
+     (when (and (eventp event)
+              gud-tooltip-mode
+              (boundp 'gud-comint-buffer)
+              gud-comint-buffer
+              (buffer-name gud-comint-buffer); gud-comint-buffer might be 
killed
+              (setq process (get-buffer-process gud-comint-buffer))
+              (posn-point (event-end event))
+              (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
+                  (progn (setq gud-tooltip-event event)
+                         (eval (cons 'and gud-tooltip-display)))))
+       (let ((expr (tooltip-expr-to-print event)))
+       (when expr
+         (if (and (eq gud-minor-mode 'gdba)
+                  (not gdb-active-process))
+             (progn
+               (with-current-buffer
+                   (window-buffer (let ((mouse (mouse-position)))
+                                    (window-at (cadr mouse)
+                                               (cddr mouse))))
+                 (let ((define-elt (assoc expr gdb-define-alist)))
+                   (unless (null define-elt)
+                     (tooltip-show (cdr define-elt))
+                     expr))))
+           (let ((cmd (gud-tooltip-print-command expr)))
+             (unless (null cmd) ; CMD can be nil if unknown debugger
+               (if (eq gud-minor-mode 'gdba)
+                   (gdb-enqueue-input
+                    (list  (concat cmd "\n") 'gdb-tooltip-print))
+                 (setq gud-tooltip-original-filter (process-filter process))
+                 (set-process-filter process 'gud-tooltip-process-output)
+                 (gud-basic-call cmd))
+               expr))))))))
+ 
  (provide 'gud)
  
  ;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4