# HG changeset patch # User Karl Heuer # Date 907785175 0 # Node ID 25eb153a9d4c929fb55dbb890cf31fc4ad4d6f02 # Parent bcac7111042adfa1acb7d528cf99aff0df0a1793 (profile-fix-fun): If already profiled, return DEF unchanged, not nil. Simplify. diff -r bcac7111042a -r 25eb153a9d4c lisp/emacs-lisp/profile.el --- a/lisp/emacs-lisp/profile.el Wed Oct 07 02:29:06 1998 +0000 +++ b/lisp/emacs-lisp/profile.el Wed Oct 07 18:32:55 1998 +0000 @@ -269,45 +269,35 @@ (defun profile-fix-fun (fun def) "Take function FUN and return it fixed for profiling. DEF is (symbol-function FUN)." - (let (prefix first second third (count 2) inter suffix) - (if (< (length def) 3) - nil ; nothing to see - (setq first (car def) second (car (cdr def)) - third (car (nthcdr 2 def))) - (setq prefix (list first second)) + (if (< (length def) 3) + def ; nothing to see + (let ((prefix (list (car def) (car (cdr def)))) + (suffix (cdr (cdr def)))) ;; Skip the doc string, if there is a string ;; which serves only as a doc string, ;; and put it in PREFIX. - (if (or (not (stringp third)) (not (nthcdr 3 def))) - ;; Either no doc string, or it is also the function value. - (setq inter third) - ;; Skip the doc string, - (setq count 3 - prefix (nconc prefix (list third)) - inter (car (nthcdr 3 def)))) + (if (and (stringp (car suffix)) (cdr suffix)) + (setq prefix (nconc prefix (list (car suffix))) + suffix (cdr suffix))) ;; Check for an interactive spec. - ;; If found, put it inu PREFIX and skip it. - (if (not (and (listp inter) - (eq (car inter) 'interactive))) - nil - (setq prefix (nconc prefix (list inter))) - (setq count (1+ count))) ; skip this sexp for suffix - ;; Set SUFFIX to the function body forms. - (setq suffix (nthcdr count def)) + ;; If found, put it into PREFIX and skip it. + (if (and (listp (car suffix)) + (eq (car (car suffix)) 'interactive)) + (setq prefix (nconc prefix (list (car suffix))) + suffix (cdr suffix))) (if (equal (car suffix) '(profile-get-time)) - nil + def ; already profiled ;; Prepare new function definition. (nconc prefix - (list '(profile-get-time)) ; read time - (list (list 'profile-start-function - (list 'quote fun))) - (list (list 'setq 'profile-temp-result- - (nconc (list 'progn) suffix))) - (list '(profile-get-time)) ; read time - (list (list 'profile-update-function - (list 'quote fun))) - (list 'profile-temp-result-) - ))))) + (list '(profile-get-time) ; read time + (list 'profile-start-function + (list 'quote fun)) + (list 'setq 'profile-temp-result- + (cons 'progn suffix)) + '(profile-get-time) ; read time + (list 'profile-update-function + (list 'quote fun)) + 'profile-temp-result-)))))) (defun profile-restore-fun (fun) "Restore profiled function FUN to its original state."