call tracer

jorbi.el

;;---------------------------------------------------------------------------
;; Tracker Demo
;;---------------------------------------------------------------------------  
(defun add4(x)
  "Returns X + 4."
  (tkr/todo "make sure this adds the right value") ;put a todo call in the function...
  (+ x 3))

(add4 3) ;then, whenever add4 is called...


;; this shows up in the *Messages* buffer
;; tkr/TODO: "make sure this adds the right value"
;;   func: (add4)
;;   file: ../user/jorbi.el

;;---------------------------------------------------------------------------
;; Tracker
;;---------------------------------------------------------------------------
(defun tkr/up-to-func()
  "Returns the nearest backtrace frame that is a direct function call."
  (let ((func-frame) (height 10)) ;; 10 is when the frames move outside this lib
    (while (progn (setq func-frame (backtrace-frame height))
		  (not (tkr/frame-is-direct-call-p func-frame)))
      (setq height (1+ height)))
    func-frame))

(defun tkr/frame-is-direct-call-p(frame)
  "Returns true is a backtrace frame is top level function call."
  (if (> (length frame) 1)
      (and (equal (first frame) t)
	   (fboundp (second frame)))))

(defun tkr/find-func-definition(frame)
  "Returns the name of the file containing the definition of the function that is being
called in the backtrace frame, FRAME."
  (symbol-file (tkr/get-frame-func frame)))



(defun tkr/get-frame-func(frame)
  "Returns the symbol name of the function being called in FRAME"
  (if (> (length frame) 1)
      (second frame)
    nil))

(defun tkr/make-string(msg)
  "Returns a formated string with a given message, MSG to be logged."
  (let ((frame (tkr/up-to-func)))
    (format "\"%s\"\n\tfunc: (%s)\n\tfile: %s"
	    msg
	    (tkr/get-frame-func frame)
	    (tkr/find-func-definition frame))))

(defun tkr/msg(msg)
  (message "tkr/MSG: %s" (tkr/make-string msg)))

(defun tkr/bug(msg)
  (message "tkr/BUG: %s" (tkr/make-string msg)))

(defun tkr/todo(msg)
  (message "tkr/TODO: %s" (tkr/make-string msg)))