Mercurial > emacs

comparison lisp/progmodes/gud.el @ 62134:6cd1d39df919

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move code for GUD tooltips from tooltip.el. (require): CL needed to compile case. (gud-tooltip-mode): Use to toggle GUD tooltips unstead of tooltip-gud-tips-p. Make it a minor-mode. (gud-find-file): Only prepare GUD tooltips if gud-tooltip-mode is t. (gud-menu-map): GUD tooltips use gud-tooltip-mode now. (gud-tooltip-modes, gud-tooltip-display, gud-tooltip-echo-area) (gud-tooltip-change-major-mode) (gud-tooltip-activate-mouse-motions-if-enabled) (gud-tooltip-mouse-motions-active, gud-tooltip-activate-mouse-motions) (gud-tooltip-mouse-motion, gud-tooltip-toggle-dereference) (gud-tooltip-original-filter, gud-tooltip-dereference) (gud-tooltip-event, tooltip-toggle-gud-tips) (gud-tooltip-process-output, gud-tooltip-print-command) (gud-tooltip-tips): Moved from tooltip.el.
author Nick Roberts <nickrob@snap.net.nz>
date Fri, 06 May 2005 22:10:50 +0000
parents 471fca8487d3
children 8ea5bf9aeed7
comparison
equal deleted inserted replaced
62133:d9019b7cf44f 62134:6cd1d39df919
36 ;; a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX kluge with 36 ;; a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX kluge with
37 ;; the gud-xdb-directories hack producing gud-dbx-directories. Derek L. Davies 37 ;; the gud-xdb-directories hack producing gud-dbx-directories. Derek L. Davies
38 ;; <ddavies@world.std.com> added support for jdb (Java debugger.) 38 ;; <ddavies@world.std.com> added support for jdb (Java debugger.)
39 39
40 ;;; Code: 40 ;;; Code:
41
42 (eval-when-compile (require 'cl)) ; for case macro
41 43
42 (require 'comint) 44 (require 'comint)
43 (require 'etags) 45 (require 'etags)
44 46
45 ;; ====================================================================== 47 ;; ======================================================================
111 (Info-goto-node "(emacs)GDB Graphical Interface") 113 (Info-goto-node "(emacs)GDB Graphical Interface")
112 (Info-goto-node "(emacs)Debuggers")))) 114 (Info-goto-node "(emacs)Debuggers"))))
113 115
114 (easy-mmode-defmap gud-menu-map 116 (easy-mmode-defmap gud-menu-map
115 '(([help] "Info" . gud-goto-info) 117 '(([help] "Info" . gud-goto-info)
116 ([tooltips] menu-item "Toggle GUD tooltips" tooltip-toggle-gud-tips 118 ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode
117 :enable (and (not emacs-basic-display) 119 :enable (and (not emacs-basic-display)
118 (display-graphic-p) 120 (display-graphic-p)
119 (fboundp 'x-show-tip)) 121 (fboundp 'x-show-tip))
120 :button (:toggle . tooltip-gud-tips-p)) 122 :button (:toggle . gud-tooltip-mode))
121 ([refresh] "Refresh" . gud-refresh) 123 ([refresh] "Refresh" . gud-refresh)
122 ([run] menu-item "Run" gud-run 124 ([run] menu-item "Run" gud-run
123 :enable (and (not gud-running) 125 :enable (and (not gud-running)
124 (memq gud-minor-mode '(gdbmi gdba gdb dbx jdb)))) 126 (memq gud-minor-mode '(gdbmi gdba gdb dbx jdb))))
125 ([until] menu-item "Continue to selection" gud-until 127 ([until] menu-item "Continue to selection" gud-until
226 (when buf 228 (when buf
227 ;; Copy `gud-minor-mode' to the found buffer to turn on the menu. 229 ;; Copy `gud-minor-mode' to the found buffer to turn on the menu.
228 (with-current-buffer buf 230 (with-current-buffer buf
229 (set (make-local-variable 'gud-minor-mode) minor-mode) 231 (set (make-local-variable 'gud-minor-mode) minor-mode)
230 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) 232 (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
231 (when (memq gud-minor-mode '(gdbmi gdba)) 233 (when (and gud-tooltip-mode
234 (memq gud-minor-mode '(gdbmi gdba)))
232 (make-local-variable 'gdb-define-alist) 235 (make-local-variable 'gdb-define-alist)
233 (unless gdb-define-alist (gdb-create-define-alist)) 236 (unless gdb-define-alist (gdb-create-define-alist))
234 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)) 237 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
235 (make-local-variable 'gud-keep-buffer)) 238 (make-local-variable 'gud-keep-buffer))
236 buf))) 239 buf)))
3098 (font-lock-syntactic-keywords 3101 (font-lock-syntactic-keywords
3099 . gdb-script-font-lock-syntactic-keywords) 3102 . gdb-script-font-lock-syntactic-keywords)
3100 (font-lock-syntactic-face-function 3103 (font-lock-syntactic-face-function
3101 . gdb-script-font-lock-syntactic-face)))) 3104 . gdb-script-font-lock-syntactic-face))))
3102 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
3103 (provide 'gud) 3304 (provide 'gud)
3104 3305
3105 ;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4 3306 ;;; arch-tag: 6d990948-df65-461a-be39-1c7fb83ac4c4
3106 ;;; gud.el ends here 3307 ;;; gud.el ends here