[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/elp.el

[Stefan Monnier]

Index: emacs/lisp/emacs-lisp/elp.el
diff -c emacs/lisp/emacs-lisp/elp.el:1.34 emacs/lisp/emacs-lisp/elp.el:1.35
*** emacs/lisp/emacs-lisp/elp.el:1.34   Sat Aug  6 17:08:59 2005
--- emacs/lisp/emacs-lisp/elp.el        Mon Nov 28 21:55:15 2005
***************
*** 206,223 ****
    "Master function symbol.")
  
  (defvar elp-not-profilable
!   '(elp-wrapper elp-elapsed-time error call-interactively apply current-time 
interactive-p)
    "List of functions that cannot be profiled.
  Those functions are used internally by the profiling code and profiling
  them would thus lead to infinite recursion.")
  
! (defun elp-not-profilable-p (fun)
!   (or (memq fun elp-not-profilable)
!       (keymapp fun)
!       (condition-case nil
!         (when (subrp (symbol-function fun))
!           (eq 'unevalled (cdr (subr-arity (symbol-function fun)))))
!       (error nil))))
  
  
  ;;;###autoload
--- 206,233 ----
    "Master function symbol.")
  
  (defvar elp-not-profilable
!   ;; First, the functions used inside each instrumented function:
!   '(elp-wrapper called-interactively-p
!     ;; Then the functions used by the above functions.  I used
!     ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
!     ;;                   (aref (symbol-function 'elp-wrapper) 2)))
!     ;; to help me find this list.
!     error call-interactively apply current-time)
    "List of functions that cannot be profiled.
  Those functions are used internally by the profiling code and profiling
  them would thus lead to infinite recursion.")
  
! (defun elp-profilable-p (fun)
!   (and (symbolp fun)
!        (fboundp fun)
!        (not (or (memq fun elp-not-profilable)
!                 (keymapp fun)
!                 (memq (car-safe (symbol-function fun)) '(autoload macro))
!                 (condition-case nil
!                     (when (subrp (indirect-function fun))
!                       (eq 'unevalled
!                           (cdr (subr-arity (indirect-function fun)))))
!                   (error nil))))))
  
  
  ;;;###autoload
***************
*** 237,245 ****
    (let* ((funguts (symbol-function funsym))
         (infovec (vector 0 0 funguts))
         (newguts '(lambda (&rest args))))
-     ;; We cannot profile functions used internally during profiling.
-     (when (elp-not-profilable-p funsym)
-       (error "ELP cannot profile the function: %s" funsym))
      ;; we cannot profile macros
      (and (eq (car-safe funguts) 'macro)
         (error "ELP cannot profile macro: %s" funsym))
--- 247,252 ----
***************
*** 252,257 ****
--- 259,267 ----
      ;; type functionality (i.e. it shouldn't execute the function).
      (and (eq (car-safe funguts) 'autoload)
         (error "ELP cannot profile autoloaded function: %s" funsym))
+     ;; We cannot profile functions used internally during profiling.
+     (unless (elp-profilable-p funsym)
+       (error "ELP cannot profile the function: %s" funsym))
      ;; put rest of newguts together
      (if (commandp funsym)
        (setq newguts (append newguts '((interactive)))))
***************
*** 344,361 ****
  For example, to instrument all ELP functions, do the following:
  
      \\[elp-instrument-package] RET elp- RET"
!   (interactive "sPrefix of package to instrument: ")
    (if (zerop (length prefix))
        (error "Instrumenting all Emacs functions would render Emacs unusable"))
    (elp-instrument-list
     (mapcar
      'intern
!     (all-completions
!      prefix obarray
!      (lambda (sym)
!        (and (fboundp sym)
!           (not (or (memq (car-safe (symbol-function sym)) '(autoload macro))
!                    (elp-not-profilable-p sym)))))))))
  
  (defun elp-restore-list (&optional list)
    "Restore the original definitions for all functions in `elp-function-list'.
--- 354,368 ----
  For example, to instrument all ELP functions, do the following:
  
      \\[elp-instrument-package] RET elp- RET"
!   (interactive
!    (list (completing-read "Prefix of package to instrument: "
!                           obarray 'elp-profilable-p)))
    (if (zerop (length prefix))
        (error "Instrumenting all Emacs functions would render Emacs unusable"))
    (elp-instrument-list
     (mapcar
      'intern
!     (all-completions prefix obarray 'elp-profilable-p))))
  
  (defun elp-restore-list (&optional list)
    "Restore the original definitions for all functions in `elp-function-list'.
***************
*** 488,499 ****
      ;; check for very large or small numbers
      (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
        (concat (substring
!                (substring number (match-beginning 1) (match-end 1))
                 0
                 (- width (match-end 2) (- (match-beginning 2)) 3))
                "..."
!               (substring number (match-beginning 2) (match-end 2)))
!       (concat (substring number 0 width)))))
  
  (defun elp-output-result (resultvec)
    ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
--- 495,506 ----
      ;; check for very large or small numbers
      (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
        (concat (substring
!                (match-string 1 number)
                 0
                 (- width (match-end 2) (- (match-beginning 2)) 3))
                "..."
!               (match-string 2 number))
!       (substring number 0 width))))
  
  (defun elp-output-result (resultvec)
    ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
***************
*** 528,547 ****
  
  (defvar elp-results-symname-map
    (let ((map (make-sparse-keymap)))
!     (define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse)
      (define-key map "\C-m" 'elp-results-jump-to-definition)
      map)
    "Keymap used on the function name column." )
  
! (defun elp-results-jump-to-definition-by-mouse (event)
!   "Jump to the definition of the function under the place specified by EVENT."
!   (interactive "e")
!   (posn-set-point (event-end event))
!   (elp-results-jump-to-definition))
! 
! (defun elp-results-jump-to-definition ()
    "Jump to the definition of the function under the point."
!   (interactive)
    (find-function (get-text-property (point) 'elp-symname)))
  
  (defun elp-output-insert-symname (symname)
--- 535,549 ----
  
  (defvar elp-results-symname-map
    (let ((map (make-sparse-keymap)))
!     (define-key map [mouse-2] 'elp-results-jump-to-definition)
      (define-key map "\C-m" 'elp-results-jump-to-definition)
      map)
    "Keymap used on the function name column." )
  
! (defun elp-results-jump-to-definition (&optional event)
    "Jump to the definition of the function under the point."
!   (interactive (list last-nonmenu-event))
!   (if event (posn-set-point (event-end event)))
    (find-function (get-text-property (point) 'elp-symname)))
  
  (defun elp-output-insert-symname (symname)
***************
*** 550,556 ****
                      'elp-symname (intern symname)
                      'keymap elp-results-symname-map
                      'mouse-face 'highlight
!                     'help-echo (substitute-command-keys 
"\\{elp-results-symname-map}"))))
  
  ;;;###autoload
  (defun elp-results ()
--- 552,558 ----
                      'elp-symname (intern symname)
                      'keymap elp-results-symname-map
                      'mouse-face 'highlight
!                     'help-echo "mouse-2 or RET jumps to definition")))
  
  ;;;###autoload
  (defun elp-results ()
***************
*** 630,634 ****
  
  (provide 'elp)
  
! ;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
  ;;; elp.el ends here
--- 632,636 ----
  
  (provide 'elp)
  
! ;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
  ;;; elp.el ends here