;; inspector - An addition to gdb(gud)-mode (GNU emacs, not Lucid)
;;             to allow following members of a c++ class with the mouse
;;
;; Copyright (C) 1993,1994  Stefan Strobel
;; 
;; $Id: inspect.el,v 1.13 1994/01/21 16:09:20 strobel Exp $

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; 
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software

;; Please send bug-reports, suggestions etc. to
;;
;; 		strobel@sun1.rz.fh-heilbronn.de
;;
;; Any feedback is very welcome !

;; Credits
;; I looked at the comint and gud-mode
;; Thank's to whoever wrote them
;; Many Thanks to David Fox for his additions and ideas

;; Installation
;; Put inspect.el somewhere into your load-path and add the lines
;;
;;    (autoload 'load-inspect-mode "inspect" "Inspector addition" t)
;;    (setq gud-mode-hook '(lambda ()
;;	        	       (load-inspect-mode)))
;;
;; to your .emacs .
;; This will load the inspector when you run M-x gdb
;;


;; TODO
;; Fix Bugs 
;; - add some more menu options
;; - use different fonts in the inspect Buffer
;;
;; - parse the output of ptype and print and 
;;   display the values directly after each type
;; - one could extend it to be a class browser : 
;;    - selection of a member function serches the function source 
;;      using TAGS or grep or whatever and go to the definition
;; - ...
;;


(defvar inspect-mode-hook nil
  "Hook to be run when mode is entered")

(defvar gud-prompt-regexp "\(gdb\)"
  "regexp to find the debugger prompt - should be changed if not gdb")

(defvar inspect-current-expression ""
  "Expression whose value is currently being inspected.")

;;
;; Keyboard Maps
;;

(defvar inspect-mode-map nil
  "Keymap for the inspector window") 

(defvar inspect-watch-map nil
  "Keymap for the watch window") 

;;
;; internal Vars
;;

(defvar inspect-watch-list nil
  "List of expressions in the watch buffer (auto update)")

(defvar inspect-gud-filter 'gud-filter
  "value of the original gud-filter function")

(defvar inspect-old-c++-hook nil
  "original value of c++-mode-hook")

;;
;; initialisation
;;

;;
;; Keys inside the inspect window
;;
(if inspect-mode-map
    ()              ; Do not change the keymap if it is already set up.
  (setq inspect-mode-map (make-sparse-keymap))
  (define-key inspect-mode-map [S-mouse-2] 'inspect-mouse)
  (define-key inspect-mode-map [mouse-2] 'inspect-mouse)
  (define-key inspect-mode-map [mouse-3] 'inspect-parent)
  (define-key inspect-mode-map "<" 'inspect-parent)
  (define-key inspect-mode-map "p" 'inspect-parent)
  (define-key inspect-mode-map "*" 'inspect-reference)
  (define-key inspect-mode-map "&" 'inspect-dereference)
  (define-key inspect-mode-map "^" 'inspect-base)
  (define-key inspect-mode-map "b" 'inspect-base)
  (define-key inspect-mode-map "\C-l" 'inspect-re-inspect)
  (define-key inspect-mode-map "\C-m" 'inspect-line)
  (define-key inspect-mode-map "f" 'inspect-line)
  (define-key inspect-mode-map [newline] 'inspect-line)
  
  (define-key inspect-mode-map "w" 'inspect-add-watch)
  (define-key inspect-mode-map "r" 'inspect-remove-watch)
  
  (define-key inspect-mode-map [menu-bar inspect]
    (cons "Inspect" (make-sparse-keymap "inspect")))
  (define-key inspect-mode-map [menu-bar inspect deref]
    '("DeReference" . inspect-dereference))
  (define-key inspect-mode-map [menu-bar inspect ref]
    '("Reference" . inspect-reference))
  (define-key inspect-mode-map [menu-bar inspect parent]
    '("Parent" . inspect-parent)))

;;
;; Keys inside the watch window
;;
(if inspect-watch-map
    ()              ; Do not change the keymap if it is already set up.
  (setq inspect-watch-map (make-sparse-keymap))
  (define-key inspect-watch-map "r" 'inspect-remove-watch)
  
  (define-key inspect-watch-map [menu-bar watch]
    (cons "Watch" (make-sparse-keymap "watch")))
  (define-key inspect-watch-map [menu-bar watch remove]
    '("Remove" . inspect-remove-watch)))


(defun load-inspect-mode ()
  "inspector entry point. set the key S-mouse-2 to 'inspect-mouse
   and change the process-filter function
   gdb-mode has to be running already !"
  (interactive)
  (if (and (boundp 'c++-mode-hook)
	   (not (eql c++-mode-hook 'inspect-c++-hook)))
      (setq inspect-old-c++-hook c++-mode-hook)) ; save old hook
  (setq c++-mode-hook 
	'inspect-c++-hook)             ; set the mouse-key when mode is loaded
  (if (boundp 'c++-mode-map)
      (define-key c++-mode-map 
	[S-mouse-2] 'inspect-mouse))   ; mouse in c++ mode (if loaded)
  (define-key (current-local-map) 
    [S-mouse-2] 'inspect-mouse)        ; mouse in gud buffer 
  (gud-set-buffer)                     ; set variable gud-comint-buffer
  (let ((proc (get-buffer-process gud-comint-buffer)))
    (set-process-filter proc 'inspect-comint-watch-filter))
  (inspect-send-command "set height" "0"))


(defun inspect-c++-hook ()
  "set the key when c++-mode is loaded"
  (define-key c++-mode-map [S-mouse-2] 'inspect-mouse)
  (run-hooks inspect-old-c++-hook))
  



(defun inspect-mode ()
  "Major mode to be used inside the inspector output window

Quick reference:
    Inspect line			  \\[inspect-line]
    Re-inspect current expression	  \\[inspect-re-inspect]
    Inspect base class(not implemented)	  \\[inspect-base]
    Inspect &expr			  \\[inspect-dereference]
    Inspect *expr			  \\[inspect-reference]
    Inspect containing object		  \\[inspect-parent]
    Inspect member at mouse position	  \\[inspect-mouse]

    Add current expression to watchlist   \\[inspect-add-watch]
    Remove current expression from watch  \\[inspect-remove-watch]

"
  (kill-all-local-variables)
  (use-local-map inspect-mode-map)       ; This provides the local keymap.
  (setq mode-name "inspector")           ; This name goes into the mode line.
  (setq major-mode 'inspect-mode)        ; for `describe-mode'
  (setq buffer-read-only t)              ; make it read-only
  (setq mode-line-format
	(list (purecopy "")              ; use a different mode-lie-format
	      'mode-line-modified        ; to show the current expression
	      'mode-line-buffer-identification
	      (purecopy "  ")
	      'inspect-current-expression ; current expression 
	      (purecopy "  ")
	      'global-mode-string
	      (purecopy "   %[(")
	      'mode-name 'minor-mode-alist "%n" 'mode-line-process
	      (purecopy ")%]--")
	      (purecopy '(line-number-mode "L%l--"))
	      (purecopy '(-3 . "%p"))
	      (purecopy "-%-")))
  (run-hooks 'inspect-mode-hook))       ; Finally, this permits the user to
					;   customize the mode with a hook.


(defun inspect-watch-mode ()
  "Major mode to be used inside the watch output window"
  (kill-all-local-variables)
  (use-local-map inspect-watch-map)      ; This provides the local keymap.
  (setq mode-name "inspector-watch")     ; This name goes into the mode line.
  (setq major-mode 'inspect-mode)        ; for `describe-mode'
  (setq buffer-read-only t))             ; make it read-only


(defun inspect-add-watch ()
  "Add the current expression in front of the watch list
   if under X and no buffer yet, pop up a new frame 
   for the watch output buffer"
  (interactive)
  (setq inspect-watch-list 
	(cons inspect-current-expression inspect-watch-list))
  (if (and window-system                          ; if under X 
	   (not (get-buffer "*inspect-watch*")))  ; and no buffer yet
      (save-excursion
	(let ((pop-up-frames t)                     ; pop up a new frame
	      (buff (get-buffer-create "*inspect-watch*"))
	      (frame (make-frame '((width . 70) 
				   (height . 20) 
				   (minibuffer . nil)))))
	  (set-window-buffer (frame-root-window frame) buff))))
  (inspect-update-watch))


(defun inspect-remove-watch ()
  "remove the current expression from the watch list"
  (interactive)
  (save-excursion
    (end-of-line)
    (search-backward "Variable : " nil t)   ; get expression from the property
    (let ((expr (get-text-property (point) 'inspect-expr)))
      (setq inspect-watch-list (delete expr inspect-watch-list)))
    (inspect-update-watch)))


(defun inspect-update-watch ()
  "update the watch window and the current inspect expression"
  (save-excursion
    (inspect-re-inspect)                           ; update inspector-window
    (let ((buff (get-buffer-create "*inspect-watch*")))
      (set-buffer buff)                            ; go to the watch buffer
      (inspect-watch-mode)
      (let ((buffer-read-only nil)
	    (explist inspect-watch-list))
	(erase-buffer)                             ; delete old contents
	(beginning-of-buffer)
	(while explist                             ; loop for all watch exprs
	  (let* ((cexpr (car explist))
		 (value (inspect-get-value cexpr)))
	    (insert "Variable : ")                 ; fill info in buffer
	    (let ((spos (point)))
	      (put-text-property (- (point) 11) spos 'inspect-expr cexpr)
	      (insert cexpr)
	      (put-text-property spos (point) 'face 'highlight))
	    (insert "\nValue    : ")
	    (if (> (length value) 30)
		(insert "\n"))
	    (insert value "\n\n")
	    (setq explist (cdr explist))))))))


(defun inspect-mouse (event)
  "inspect at mouse"
  (interactive "e")
  (mouse-set-point event)                          ; go to the mouse position
  (inspect-point))                                 ; inspect expr at point


(defun inspect-line ()
  "inspect value in current line of ptype output"
  (interactive)
  (beginning-of-line)
  (forward-word 2)
  (backward-char 1)
  (inspect-point))

(defun inspect-point ()
  "inspect at position (used for mouse and keyboard inspect)"
  (let ((expression (find-c-expr)))                ; get expression at point
    (if (string-match "^[*&]*" expression)	   ; strip any leading [*&]
	(setq expression (substring expression (match-end 0))))
    (cond ((string-equal (buffer-name) "*inspect*"); if inside the inspector 
	   (end-of-line)
	   (search-backward "Variable : " nil t)   ; get expression from prop.
	   (let* ((baseexp (get-text-property (point) 'inspect-expr))
		  ;; We don't need to parenthesize expression because either it
		  ;; has been parenthesized in the condition below or it was
		  ;; generated here, in which case the precedence is ok.  -fox
		  (exp (if (get-text-property (point) 'inspect-isptr)
			   (concat baseexp "->" expression)
			 (concat baseexp "." expression))))
	     (inspect-expression exp)))            ; inspect the new expression
	  (t	
	   (inspect-expression (concat "(" expression ")"))         
	   (switch-to-buffer-other-window "*inspect*")))))


(defun inspect-re-inspect ()
  "re-inspect current expression"
  (interactive)
  (inspect-expression inspect-current-expression))


(defun inspect-parent ()
  "inspect parent of current expression"
  (interactive)
  (if (string-match "\\(\.\\|->\\)[a-zA-Z0-9_$]+\\(\\[.*\\]\\)*$" 
		    inspect-current-expression)
      (inspect-expression	; Strip off last member qualifier.
       (substring inspect-current-expression 0 (match-beginning 0)))
    (beep)))


(defun inspect-reference ()
  "follow the adress of the current expression (add a *)"
  (interactive)
  (if (string-match "\&" inspect-current-expression)
      (inspect-expression (substring inspect-current-expression 1))
    (inspect-expression (concat "*" inspect-current-expression))))


(defun inspect-dereference ()
  "add a & to the current expression"
  (interactive)
  (if (string-match "\*" inspect-current-expression)
      (inspect-expression (substring inspect-current-expression 1))
    (inspect-expression (concat "&" inspect-current-expression))))


(defun inspect-base (event)
  "not yet implemented"
  (interactive)
  (beep))


(defun inspect-expression (cexpr)
  "inspect an expression"
  (setq inspect-current-expression cexpr)
  (gud-set-buffer)
  (save-excursion
    (let ((buff (get-buffer-create "*inspect*")))
      (set-buffer buff)
      (inspect-mode)
      (let* ((buffer-read-only nil)
	     (type  (inspect-get-type cexpr))
	     (value (inspect-get-value cexpr))
	     (isptr (equal (substring (concat " " type) -1) "*"))) 
	(erase-buffer)
	(beginning-of-buffer)
	(insert "Variable : ")                         
	(let ((pos0 (point-min))
	      (pos1 (point)))
	  (put-text-property pos0 pos1 'inspect-expr cexpr)
	  (put-text-property pos0 pos1 'inspect-type type)
	  (put-text-property pos0 pos1 'inspect-isptr isptr)
	  (insert cexpr)
	  (put-text-property pos1 (point) 'face 'highlight))
	(insert "\n" type "\n\nValue : ")
	(if (> (length value) 30)
	    (insert "\n"))
	(insert value)
	(beginning-of-buffer)))))



(defun inspect-get-type (expr)
  "get the type description of an expression from gdb"
  (let ((buff (get-buffer-create "*inspect-tmp*")))
    (save-excursion
      (set-buffer buff)
      (inspect-send-command "ptype" expr)
      (end-of-buffer)
      (skip-chars-backward " \C-j")
      (buffer-substring (point-min) (point)) )))

(defun inspect-get-value (expr)
  "get the value of an expression from gdb"
  (let ((buff (get-buffer-create "*inspect-tmp*")))
    (save-excursion
      (set-buffer buff)
      (inspect-send-command "print" expr)
      (end-of-buffer)
      (skip-chars-backward " \C-j")
      (delete-region (point) (point-max))
      (beginning-of-buffer)
      (if (search-forward "=" (point-max) t)
	  (delete-region (point-min) (+ 1 (point))))
      (buffer-string))))
		     

;;
;;
;; Low-level Functions I/O with gdb
;;
;;


(defun inspect-send-command (command arg)
  "send a command to gdb and return the output"
  (save-excursion
    (let* ((tmpbuff (get-buffer-create "*inspect-tmp*"))
	   (proc (get-buffer-process gud-comint-buffer)))
      (set-buffer tmpbuff)
      (erase-buffer)            ; delete old contents
      (unwind-protect
	  (progn 
	    (set-process-filter proc 'inspect-comint-filter)
	    (comint-send-string proc (format "%s %s\n" command arg))
	    (inspect-wait-for-prompt))
	(set-process-filter proc 'inspect-comint-watch-filter))
      (buffer-string))))


(defun inspect-wait-for-prompt ()
  "Wait for the debug prompt in the current (tmp) buffer"
    (let* ((proc (get-buffer-process gud-comint-buffer)))
      (while (and (accept-process-output proc 3)
		  (not (inspect-find-prompt))))
      (beginning-of-line)
      (delete-region (point) (point-max))))


(defun inspect-find-prompt ()
  (beginning-of-line)
  (search-forward-regexp gud-prompt-regexp (point-max) t))



;;
;; Comint - Filter functions
;;

(defun inspect-comint-filter (proc string)
  "comint filter function for the inspector.
   collects the output for the ptype / print command sent by the 
   inspector and put the lines in the *inspector-tmp* buffer"
  (save-excursion
    (let ((buff (get-buffer-create "*inspect-tmp*")))
      (set-buffer buff)
      (end-of-buffer)
      (insert string))))


(defun inspect-comint-watch-filter (proc string)
  "comint filter function for the inspector. Updates watch"
  (funcall inspect-gud-filter proc string)
  (save-excursion
    (let ((buff (get-buffer-create "*inspect-tmp*")))
      (set-buffer buff)
      (end-of-buffer)
      (insert string)
      (let ((end (point)))
	(beginning-of-line)
	(if (search-forward-regexp gud-prompt-regexp end t)
	    (inspect-update-watch))))))

