Mercurial > hg > xemacs-beta

comparison lisp/comint/gdbsrc.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 441bb1e64a06
children cf808b4c4290
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
292 ;; this can be used as a hook for gdb-mode.... 292 ;; this can be used as a hook for gdb-mode....
293 (or current-gdb-buffer 293 (or current-gdb-buffer
294 (and (eq major-mode 'gdb-mode) ; doesn't work w/ energize yet 294 (and (eq major-mode 'gdb-mode) ; doesn't work w/ energize yet
295 (setq current-gdb-buffer (current-buffer)) 295 (setq current-gdb-buffer (current-buffer))
296 ;; XEmacs change: 296 ;; XEmacs change:
297 (progn 297 (make-local-hook 'kill-buffer-hook)
298 (make-local-hook 'kill-buffer-hook) 298 (add-hook 'kill-buffer-hook 'gdbsrc-reset nil t))
299 (add-hook 'kill-buffer-hook 'gdbsrc-reset nil t)))
300 (error "Cannot determine current-gdb-buffer")) 299 (error "Cannot determine current-gdb-buffer"))
301 ;;; (set-process-filter 300 ;;; (set-process-filter
302 ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-filter) 301 ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-filter)
303 ;;; (set-process-sentinel 302 ;;; (set-process-sentinel
304 ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-sentinel) 303 ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-sentinel)
371 ;; Sends commands to gdb process. 370 ;; Sends commands to gdb process.
372 371
373 (defun gdb-call-from-src (command) 372 (defun gdb-call-from-src (command)
374 "Send associated gdb process COMMAND displaying source in this window." 373 "Send associated gdb process COMMAND displaying source in this window."
375 (setq gdbsrc-call-p t) 374 (setq gdbsrc-call-p t)
376 (let ((src-win (selected-window)) 375 (let ((buf (or gdbsrc-associated-buffer current-gdb-buffer)))
377 (buf (or gdbsrc-associated-buffer current-gdb-buffer))) 376 (or (buffer-name buf)
378 (or (buffer-name buf) 377 (error "GDB buffer deleted"))
379 (error "GDB buffer deleted")) 378 (pop-to-buffer buf))
380 (pop-to-buffer buf) 379 (goto-char (point-max))
381 (goto-char (point-max)) 380 (beginning-of-line)
382 (beginning-of-line) 381 ;; Go past gdb prompt
383 ;; Go past gdb prompt 382 (re-search-forward
384 (re-search-forward 383 gdb-prompt-pattern (save-excursion (end-of-line) (point)) t)
385 gdb-prompt-pattern (save-excursion (end-of-line) (point)) t) 384 ;; Delete any not-supposed-to-be-there text
386 ;; Delete any not-supposed-to-be-there text 385 (delete-region (point) (point-max))
387 (delete-region (point) (point-max)) 386 (insert command)
388 (insert command) 387 (comint-send-input))
389 (comint-send-input)
390 (select-window src-win)
391 ))
392 388
393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 389 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
394 ;;; 390 ;;;
395 ;;; Define Commands for GDB SRC Mode Buffer 391 ;;; Define Commands for GDB SRC Mode Buffer
396 ;;; 392 ;;;
501 (epnt (event-point click))) 497 (epnt (event-point click)))
502 (and ewin 498 (and ewin
503 epnt 499 epnt
504 extent 500 extent
505 (eq (window-buffer ewin) 501 (eq (window-buffer ewin)
506 (extent-object extent)) 502 (extent-buffer extent))
507 (extent-start-position extent) 503 (extent-start-position extent)
508 (> epnt (extent-start-position extent)) 504 (> epnt (extent-start-position extent))
509 (> (extent-end-position extent) epnt)))) 505 (> (extent-end-position extent) epnt))))
510 506
511 (defun point-inside-extent-p (extent) 507 (defun point-inside-extent-p (extent)
512 "Returns non-nil if the point is within or just after the bounds of the 508 "Returns non-nil if the point is within or just after the bounds of the
513 primary selection-extent, nil otherwise." 509 primary selection-extent, nil otherwise."
514 ;; stig@hackvan.com 510 ;; stig@hackvan.com
515 (and extent ; FIXME - I'm such a sinner... 511 (and extent ; FIXME - I'm such a sinner...
516 (eq (current-buffer) 512 (eq (current-buffer)
517 (extent-object extent)) 513 (extent-buffer extent))
518 (> (point) (extent-start-position extent)) 514 (> (point) (extent-start-position extent))
519 (>= (extent-end-position extent) (point)))) 515 (>= (extent-end-position extent) (point))))
520 516
521 (defun gdbsrc-select-or-yank (ee) 517 (defun gdbsrc-select-or-yank (ee)
522 ;; by Stig@hackvan.com 518 ;; by Stig@hackvan.com
562 ;; by Stig@hackvan.com 558 ;; by Stig@hackvan.com
563 (interactive) 559 (interactive)
564 (let ((gbuf (or gdbsrc-associated-buffer current-gdb-buffer))) 560 (let ((gbuf (or gdbsrc-associated-buffer current-gdb-buffer)))
565 (cond ((eq (current-buffer) gbuf) 561 (cond ((eq (current-buffer) gbuf)
566 (and gdb-arrow-extent 562 (and gdb-arrow-extent
567 (extent-object gdb-arrow-extent) 563 (extent-buffer gdb-arrow-extent)
568 (progn (pop-to-buffer (extent-object gdb-arrow-extent)) 564 (progn (pop-to-buffer (extent-buffer gdb-arrow-extent))
569 (goto-char (extent-start-position gdb-arrow-extent))))) 565 (goto-char (extent-start-position gdb-arrow-extent)))))
570 ((buffer-name gbuf) (pop-to-buffer gbuf)) 566 ((buffer-name gbuf) (pop-to-buffer gbuf))
571 ((y-or-n-p "No debugger. Start a new one? ") 567 ((y-or-n-p "No debugger. Start a new one? ")
572 (call-interactively 'gdbsrc)) 568 (call-interactively 'gdbsrc))
573 (t (error "No gdb buffer.")) 569 (t (error "No gdb buffer."))
842 "Advised to select the source buffer instead of the gdb-buffer" 838 "Advised to select the source buffer instead of the gdb-buffer"
843 ;; by Stig@hackvan.com 839 ;; by Stig@hackvan.com
844 (ad-set-arg 2 'source) ; tell it not to select the gdb window 840 (ad-set-arg 2 'source) ; tell it not to select the gdb window
845 ad-do-it 841 ad-do-it
846 (save-excursion 842 (save-excursion
847 (let* ((buf (extent-object gdb-arrow-extent)) 843 (let* ((buf (extent-buffer gdb-arrow-extent))
848 (win (get-buffer-window buf))) 844 (win (get-buffer-window buf)))
849 (setq gdbsrc-last-src-buffer buf) 845 (setq gdbsrc-last-src-buffer buf)
850 (select-window win) 846 (select-window win)
851 (set-window-point win (extent-start-position gdb-arrow-extent)) 847 (set-window-point win (extent-start-position gdb-arrow-extent))
852 (set-buffer buf)) 848 (set-buffer buf))