/[emacs]/emacs/lisp/progmodes/gud.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/gud.el

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

revision 1.35 by nickrob, Tue May 3 06:47:18 2005 UTC revision 1.36 by nickrob, Fri May 6 22:10:50 2005 UTC
# Line 39  Line 39 
39    
40  ;;; Code:  ;;; Code:
41    
42    (eval-when-compile (require 'cl)) ; for case macro
43    
44  (require 'comint)  (require 'comint)
45  (require 'etags)  (require 'etags)
46    
# Line 113  Used to grey out relevant togolbar icons Line 115  Used to grey out relevant togolbar icons
115    
116  (easy-mmode-defmap gud-menu-map  (easy-mmode-defmap gud-menu-map
117    '(([help]     "Info" . gud-goto-info)    '(([help]     "Info" . gud-goto-info)
118      ([tooltips] menu-item "Toggle GUD tooltips" tooltip-toggle-gud-tips      ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode
119                    :enable  (and (not emacs-basic-display)                    :enable  (and (not emacs-basic-display)
120                                  (display-graphic-p)                                  (display-graphic-p)
121                                  (fboundp 'x-show-tip))                                  (fboundp 'x-show-tip))
122                    :button (:toggle . tooltip-gud-tips-p))                    :button (:toggle . gud-tooltip-mode))
123      ([refresh]  "Refresh" . gud-refresh)      ([refresh]  "Refresh" . gud-refresh)
124      ([run]      menu-item "Run" gud-run      ([run]      menu-item "Run" gud-run
125                    :enable (and (not gud-running)                    :enable (and (not gud-running)
# Line 228  Uses `gud-<MINOR-MODE>-directories' to f Line 230  Uses `gud-<MINOR-MODE>-directories' to f
230        (with-current-buffer buf        (with-current-buffer buf
231          (set (make-local-variable 'gud-minor-mode) minor-mode)          (set (make-local-variable 'gud-minor-mode) minor-mode)
232          (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)          (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
233          (when (memq gud-minor-mode '(gdbmi gdba))          (when (and gud-tooltip-mode
234                       (memq gud-minor-mode '(gdbmi gdba)))
235            (make-local-variable 'gdb-define-alist)            (make-local-variable 'gdb-define-alist)
236            (unless  gdb-define-alist (gdb-create-define-alist))            (unless  gdb-define-alist (gdb-create-define-alist))
237            (add-hook 'after-save-hook 'gdb-create-define-alist nil t))            (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
# Line 3100  Treats actions as defuns." Line 3103  Treats actions as defuns."
3103           (font-lock-syntactic-face-function           (font-lock-syntactic-face-function
3104            . gdb-script-font-lock-syntactic-face))))            . gdb-script-font-lock-syntactic-face))))
3105    
3106    
3107    ;;; tooltips for GUD
3108    
3109    ;;; Customizable settings
3110    (defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode)
3111      "List of modes for which to enable GUD tips."
3112      :type 'sexp
3113      :tag "GUD modes"
3114      :group 'tooltip)
3115    
3116    (defcustom gud-tooltip-display
3117      '((eq (tooltip-event-buffer gud-tooltip-event)
3118            (marker-buffer gud-overlay-arrow-position)))
3119      "List of forms determining where GUD tooltips are displayed.
3120    
3121    Forms in the list are combined with AND.  The default is to display
3122    only tooltips in the buffer containing the overlay arrow."
3123      :type 'sexp
3124      :tag "GUD buffers predicate"
3125      :group 'tooltip)
3126    
3127    (defcustom gud-tooltip-echo-area nil
3128      "Use the echo area instead of frames for GUD tooltips."
3129      :type 'boolean
3130      :tag "Use echo area"
3131      :group 'tooltip)
3132    
3133    (define-obsolete-variable-alias 'tooltip-gud-modes
3134                                    'gud-tooltip-modes "22.1")
3135    (define-obsolete-variable-alias 'tooltip-gud-display
3136                                    'gud-tooltip-display "22.1")
3137    (define-obsolete-variable-alias 'tooltip-use-echo-area
3138                                    'gud-tooltip-echo-area "22.1")
3139    
3140    ;;; Reacting on mouse movements
3141    
3142    (defun gud-tooltip-change-major-mode ()
3143      "Function added to `change-major-mode-hook' when tooltip mode is on."
3144      (add-hook 'post-command-hook 'gud-tooltip-activate-mouse-motions-if-enabled))
3145    
3146    (defun gud-tooltip-activate-mouse-motions-if-enabled ()
3147      "Reconsider for all buffers whether mouse motion events are desired."
3148      (remove-hook 'post-command-hook
3149                   'gud-tooltip-activate-mouse-motions-if-enabled)
3150      (dolist (buffer (buffer-list))
3151        (save-excursion
3152          (set-buffer buffer)
3153          (if (and gud-tooltip-mode
3154                   (memq major-mode gud-tooltip-modes))
3155              (gud-tooltip-activate-mouse-motions t)
3156            (gud-tooltip-activate-mouse-motions nil)))))
3157    
3158    (defvar gud-tooltip-mouse-motions-active nil
3159      "Locally t in a buffer if tooltip processing of mouse motion is enabled.")
3160    
3161    (defun gud-tooltip-activate-mouse-motions (activatep)
3162      "Activate/deactivate mouse motion events for the current buffer.
3163    ACTIVATEP non-nil means activate mouse motion events."
3164      (if activatep
3165          (progn
3166            (make-local-variable 'gud-tooltip-mouse-motions-active)
3167            (setq gud-tooltip-mouse-motions-active t)
3168            (make-local-variable 'track-mouse)
3169            (setq track-mouse t))
3170        (when gud-tooltip-mouse-motions-active
3171          (kill-local-variable 'gud-tooltip-mouse-motions-active)
3172          (kill-local-variable 'track-mouse))))
3173    
3174    (defun gud-tooltip-mouse-motion (event)
3175      "Command handler for mouse movement events in `global-map'."
3176      (interactive "e")
3177      (tooltip-hide)
3178      (when (car (mouse-pixel-position))
3179        (setq tooltip-last-mouse-motion-event (copy-sequence event))
3180        (tooltip-start-delayed-tip)))
3181    
3182    ;;; Tips for `gud'
3183    
3184    (defvar gud-tooltip-original-filter nil
3185      "Process filter to restore after GUD output has been received.")
3186    
3187    (defvar gud-tooltip-dereference nil
3188      "Non-nil means print expressions with a `*' in front of them.
3189    For C this would dereference a pointer expression.")
3190    
3191    (defvar gud-tooltip-event nil
3192      "The mouse movement event that led to a tooltip display.
3193    This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
3194    
3195    (defun gud-tooltip-toggle-dereference ()
3196      "Toggle whether tooltips should show `* expr' or `expr'."
3197      (interactive)
3198      (setq gud-tooltip-dereference (not gud-tooltip-dereference))
3199      (when (interactive-p)
3200        (message "Dereferencing is now %s."
3201                 (if gud-tooltip-dereference "on" "off"))))
3202    
3203    (define-obsolete-function-alias 'tooltip-gud-toggle-dereference
3204                                    'gud-tooltip-toggle-dereference "22.1")
3205    
3206    (define-minor-mode gud-tooltip-mode
3207      "Toggle the display of GUD tooltips."
3208      :global t
3209      :group 'gud
3210      (if gud-tooltip-mode
3211          (progn
3212            (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
3213            (add-hook 'pre-command-hook 'tooltip-hide)
3214            (add-hook 'tooltip-hook 'gud-tooltip-tips)
3215            (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion))
3216        (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide)
3217        (remove-hook 'change-major-mode-hook 'tooltip-change-major-mode)
3218        (remove-hook 'tooltip-hook 'gud-tooltip-tips)
3219        (define-key global-map [mouse-movement] 'ignore)))
3220      (gud-tooltip-activate-mouse-motions-if-enabled)
3221      (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
3222          (if gud-tooltip-mode
3223              (progn
3224                (dolist (buffer (buffer-list))
3225                  (unless (eq buffer gud-comint-buffer)
3226                    (with-current-buffer buffer
3227                      (when (and (memq gud-minor-mode '(gdbmi gdba))
3228                                 (not (string-match "\\`\\*.+\\*\\'"
3229                                                    (buffer-name))))
3230                        (make-local-variable 'gdb-define-alist)
3231                        (gdb-create-define-alist)
3232                        (add-hook 'after-save-hook
3233                                  'gdb-create-define-alist nil t))))))
3234            (kill-local-variable 'gdb-define-alist)
3235            (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
3236    
3237    ; This will only display data that comes in one chunk.
3238    ; Larger arrays (say 400 elements) are displayed in
3239    ; the tootip incompletely and spill over into the gud buffer.
3240    ; Switching the process-filter creates timing problems and
3241    ; it may be difficult to do better. Using annotations as in
3242    ; gdb-ui.el gets round this problem.
3243    (defun gud-tooltip-process-output (process output)
3244      "Process debugger output and show it in a tooltip window."
3245      (set-process-filter process gud-tooltip-original-filter)
3246      (tooltip-show (tooltip-strip-prompt process output)
3247                    gud-tooltip-echo-area))
3248    
3249    (defun gud-tooltip-print-command (expr)
3250      "Return a suitable command to print the expression EXPR.
3251    If GUD-TOOLTIP-DEREFERENCE is t, also prepend a `*' to EXPR."
3252      (when gud-tooltip-dereference
3253        (setq expr (concat "*" expr)))
3254      (case gud-minor-mode
3255        ((gdb gdba) (concat "server print " expr))
3256        (dbx (concat "print " expr))
3257        (xdb (concat "p " expr))
3258        (sdb (concat expr "/"))
3259        (perldb expr)))
3260    
3261    (defun gud-tooltip-tips (event)
3262      "Show tip for identifier or selection under the mouse.
3263    The mouse must either point at an identifier or inside a selected
3264    region for the tip window to be shown.  If gud-tooltip-dereference is t,
3265    add a `*' in front of the printed expression. In the case of a C program
3266    controlled by GDB, show the associated #define directives when program is
3267    not executing.
3268    
3269    This function must return nil if it doesn't handle EVENT."
3270      (let (process)
3271        (when (and (eventp event)
3272                   gud-tooltip-mode
3273                   (boundp 'gud-comint-buffer)
3274                   gud-comint-buffer
3275                   (buffer-name gud-comint-buffer); gud-comint-buffer might be killed
3276                   (setq process (get-buffer-process gud-comint-buffer))
3277                   (posn-point (event-end event))
3278                   (or (and (eq gud-minor-mode 'gdba) (not gdb-active-process))
3279                       (progn (setq gud-tooltip-event event)
3280                              (eval (cons 'and gud-tooltip-display)))))
3281          (let ((expr (tooltip-expr-to-print event)))
3282            (when expr
3283              (if (and (eq gud-minor-mode 'gdba)
3284                       (not gdb-active-process))
3285                  (progn
3286                    (with-current-buffer
3287                        (window-buffer (let ((mouse (mouse-position)))
3288                                         (window-at (cadr mouse)
3289                                                    (cddr mouse))))
3290                      (let ((define-elt (assoc expr gdb-define-alist)))
3291                        (unless (null define-elt)
3292                          (tooltip-show (cdr define-elt))
3293                          expr))))
3294                (let ((cmd (gud-tooltip-print-command expr)))
3295                  (unless (null cmd) ; CMD can be nil if unknown debugger
3296                    (if (eq gud-minor-mode 'gdba)
3297                        (gdb-enqueue-input
3298                         (list  (concat cmd "\n") 'gdb-tooltip-print))
3299                      (setq gud-tooltip-original-filter (process-filter process))
3300                      (set-process-filter process 'gud-tooltip-process-output)
3301                      (gud-basic-call cmd))
3302                    expr))))))))
3303    
3304  (provide 'gud)  (provide 'gud)
3305    
3306  ;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4  ;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4

Legend:
Removed from v.1.35  
changed lines
  Added in v.1.36

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