esup-el_0.7.1+git20220203.4b49c8d/0000755000175000017500000000000014536061472015467 5ustar dogslegdogslegesup-el_0.7.1+git20220203.4b49c8d/test/0000755000175000017500000000000014536061021016434 5ustar dogslegdogslegesup-el_0.7.1+git20220203.4b49c8d/test/test-esup.el0000644000175000017500000002022214536061021020705 0ustar dogslegdogsleg;;; test-esup.el --- ESUP: Tests for esup.el and esup-child.el -*- lexical-binding: t -*- ;; Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 2020 Joe Schafer ;; Author: Joe Schafer ;; Maintainer: Serghei Iakovlev ;; Version: 0.7.1 ;; URL: https://github.com/jschaf/esup ;; Package-Requires: ((emacs "25.1")) ;; This file is NOT part of GNU Emacs. ;;;; License ;; This file 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 3 ;; of the License, or (at your option) any later version. ;; This file 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 file. If not, see . ;;; Commentary: ;; Tests for esup-child.el and esup.el functionality using `buttercup'. ;;; Code: (require 'buttercup) ;; Load undercover at early stage to improve code coverage. (when (require 'undercover nil t) ;; Track coverage, but don't send to coverage serivice. Save in parent ;; directory as undercover saves paths relative to the repository root. (undercover "*.el" "test/util.el" (:report-file "coverage-final.json") (:send-report nil))) (load (concat (file-name-directory (or load-file-name (buffer-file-name) default-directory)) "utils.el") nil 'nomessage 'nosuffix) (defconst esup-test/fake-port -1) ;;;; Tests: ;; TODO(jschaf): There's a bug when using the same mock directory that ;; causes it to bleed into other tests. For a quick fix, don't use ;; the same directory. (describe "The esup-child-run during performing" (it "loads file" (with-esup-mock '(:load-path ("/fake") :files (("/fake/foof.el" . "(progn 'qux)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "/fake/foof.el" esup-test/fake-port) (list (esup-result :file "/fake/foof.el" :expression-string "(progn 'qux)" :start-point 1 :end-point 13)))))) (it "handles empty file" (with-esup-mock '(:load-path ("/fake") :files (("/fake/foo-bar.el" . ""))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "/fake/foo-bar.el" -1) (list))))) (it "handles whitespace-only file" (with-esup-mock '(:load-path ("/fake") :files (("/fake/foo-bar.el" . " "))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "/fake/foo-bar.el" -1) (list))))) (it "counts gc" (with-esup-mock '(:load-path ("/fake") :files (("/fake/bar-qux.el" . "(progn (garbage-collect) (garbage-collect))"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "/fake/bar-qux.el" esup-test/fake-port) (list (make-esup-result "/fake/bar-qux.el" "(progn (garbage-collect) (garbage-collect))" :gc-number 2)))))) (it "uses load-path" (with-esup-mock '(:load-path ("/fake1" "/fake2") :files (("/fake2/qux.el" . "(require 'baz) (progn 'qux)") ("/fake2/baz.el" . "(progn 'baz)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "qux.el" esup-test/fake-port) (list (make-esup-result "/fake2/baz.el" "(progn 'baz)") (make-esup-result "/fake2/qux.el" "(progn 'qux)" :start-point 16 :end-point 28)))))) (it "steps into requires" (with-esup-mock '(:load-path ("/fake3") :files (("/fake3/qux.el" . "(require 'baz)") ("/fake3/baz.el" . "(progn 'baz)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "qux.el" esup-test/fake-port) (list (make-esup-result "/fake3/baz.el" "(progn 'baz)")))))) (it "handles dynamic docstring" (with-esup-mock '(:load-path ("/fake1") :files (("/fake1/qux.el" . "#@2 A\n(defvar var 1)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "qux.el" esup-test/fake-port) (list (make-esup-result "/fake1/qux.el" "(defvar var 1)" :start-point 7 :end-point 21 :line-number 2)))))) (it "respects require level of 1" (with-esup-mock '(:load-path ("/fake8") :files (("/fake8/a.el" . "(require 'c)") ("/fake8/c.el" . "(require 'd)") ("/fake8/d.el" . "(progn 'd)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (let ((depth 1)) (esup-child-run "a.el" esup-test/fake-port depth)) (list (make-esup-result "/fake8/c.el" "(require 'd)")))))) (it "respects require level of 2" (with-esup-mock '(:load-path ("/fake9") :files (("/fake9/a.el" . "(require 'c)") ("/fake9/c.el" . "(require 'd)") ("/fake9/d.el" . "(progn 'd)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (let ((depth 2)) (esup-child-run "a.el" esup-test/fake-port depth)) (list (make-esup-result "/fake9/d.el" "(progn 'd)")))))) (it "handles require with sexp filename" (with-esup-mock '(:load-path ("/fake10") :files (("/fake10/bar.el" . "(require 'core (concat \"/specified/qux/\" \"core\"))") ("/specified/qux/core.el" . "(progn 'core)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "/fake10/bar.el" esup-test/fake-port) (list (make-esup-result "/specified/qux/core.el" "(progn 'core)")))))) (it "doesn't step into already required feature" (with-esup-mock '(:load-path ("/fake12") :files (("/fake12/qux.el" . "(require 'baz) (require 'baz)") ("/fake12/baz.el" . "(progn 'baz) (provide 'baz)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "qux.el" esup-test/fake-port) (list (make-esup-result "/fake12/baz.el" "(progn 'baz)") (make-esup-result "/fake12/baz.el" "(provide 'baz)" :start-point 14 :end-point 28) (make-esup-result "/fake12/qux.el" "(require 'baz)" :start-point 16 :end-point 30)))))) (it "advises require" (with-esup-mock '(:load-path ("/fake13") :files (("/fake13/qux.el" . "(defun my-require (feat) (require feat))(my-require 'baz)") ("/fake13/baz.el" . "(progn 'baz) (provide 'baz)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "qux.el" esup-test/fake-port) (list (make-esup-result "/fake13/qux.el" "(defun my-require (feat) (require feat))") (make-esup-result "/fake13/baz.el" "(progn 'baz)") (make-esup-result "/fake13/baz.el" "(provide 'baz)" :start-point 14 :end-point 28)))))) (it "advises load" (with-esup-mock '(:load-path ("/fake14") :files (("/fake14/qux.el" . "(defun my-load (file) (load file)) (my-load \"baz\")") ("/fake14/baz.el" . "(progn 'baz) (provide 'baz)"))) (should (esup-results-equal-p '(:gc-time :exec-time) (esup-child-run "qux.el" esup-test/fake-port) (list (make-esup-result "/fake14/qux.el" "(defun my-load (file) (load file))") (make-esup-result "/fake14/baz.el" "(progn 'baz)") (make-esup-result "/fake14/baz.el" "(provide 'baz)" :start-point 14 :end-point 28))))))) ;;; test-esup.el ends here esup-el_0.7.1+git20220203.4b49c8d/test/test-utils.el0000644000175000017500000001304614536061021021077 0ustar dogslegdogsleg;;; test-utils.el --- ESUP: Tests for utils.el -*- lexical-binding: t -*- ;; Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 2020 Joe Schafer ;; Author: Joe Schafer ;; Maintainer: Serghei Iakovlev ;; Version: 0.7.1 ;; URL: https://github.com/jschaf/esup ;; This file is NOT part of GNU Emacs. ;;;; License ;; This file 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 3 ;; of the License, or (at your option) any later version. ;; This file 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 file. If not, see . ;;; Commentary: ;; Tests for utils.el functionality using `buttercup'. ;;; Code: (require 'buttercup) ;; Load undercover at early stage to improve code coverage. (when (require 'undercover nil t) ;; Track coverage, but don't send to coverage serivice. Save in parent ;; directory as undercover saves paths relative to the repository root. (undercover "*.el" "test/util.el" (:report-file "coverage-final.json") (:send-report nil))) (load (concat (file-name-directory (or load-file-name (buffer-file-name) default-directory)) "utils.el") nil 'nomessage 'nosuffix) ;;;; Tests: (describe "Calling esup-results-equal-p to compare esup-result objects" (it "equal for empty lists" (expect (esup-results-equal-p '() '() '()) :to-equal t)) (it "equal for ojects with a single element" (should (esup-results-equal-p '() (list (make-esup-result "file" "sexp")) (list (make-esup-result "file" "sexp"))))) (it "equal for objects with three elements" (should (esup-results-equal-p '() (list (make-esup-result "file1" "sexp1" :start-point 10) (make-esup-result "file2" "sexp2" :gc-time 20) (make-esup-result "file3" "sexp3")) (list (make-esup-result "file1" "sexp1" :start-point 10) (make-esup-result "file2" "sexp2" :gc-time 20) (make-esup-result "file3" "sexp3"))))) (it "equal when ignoring :gc-time" (should (esup-results-equal-p '(:gc-time) (list (make-esup-result "file" "sexp" :gc-time 30)) (list (make-esup-result "file" "sexp" :gc-time 50))))) (it "NOT equal when :gc-time are mismatch" (let ((result (esup-results-equal-p '() (list (make-esup-result "file" "sexp" :gc-time 30)) (list (make-esup-result "file" "sexp" :gc-time 50))))) (expect result :to-be nil))) (it "NOT equal for objects with different elements" (let ((result (esup-results-equal-p '() (list (make-esup-result "file" "sexp1")) (list (make-esup-result "file" "sexp2"))))) (expect result :to-be nil)))) (describe "Calling esup-results-single-equal-p to compare esup-result objects" (it "eaqual when ignoring slots are absent" (should (esup-results-single-equal-p '() (make-esup-result "/fake/file-1.el" "(progn 'file-1)") (make-esup-result "/fake/file-1.el" "(progn 'file-1)")))) (it "equal when ignoring :gc-time" (should (esup-results-single-equal-p '(:gc-time) (esup-result :file "file" :expression-string "sexp" :end-point 20 :gc-time 444) (esup-result :file "file" :expression-string "sexp" :end-point 20 :gc-time 555)))) (it "NOT equal when sexps are mismatch (I)" (let ((result (esup-results-single-equal-p '() (make-esup-result "/fake/file-1.el" "(progn 'file-1)") (make-esup-result "/fake/file-1.el" "(progn 'file-2)")))) (expect result :to-be nil))) (it "NOT equal when sexps are mismatch (II)" (let ((result-a (esup-result :file "file" :expression-string "sexp")) (result-b (esup-result :file "file" :expression-string "sexp2"))) (expect (esup-results-single-equal-p '() result-a result-b) :to-be nil))) (it "NOT equal when :gc-time is mismatch" (let ((result-a (esup-result :file "file" :expression-string "sexp" :end-point 20 :gc-time 444)) (result-b (esup-result :file "file" :expression-string "sexp" :end-point 20 :gc-time 555))) (expect (esup-results-single-equal-p '() result-a result-b) :to-be nil)))) (describe "Making esup-result objects" (it "create the same object with NO extra args" (let((actual (make-esup-result "file" "sexp")) (expected (esup-result :file "file" :expression-string "sexp" :end-point 5))) (expect actual :to-equal expected))) (it "create the same object with extra args" (let ((actual (make-esup-result "file" "sexp" :gc-time 20 :exec-time 40)) (expected (esup-result :file "file" :expression-string "sexp" :end-point 5 :gc-time 20 :exec-time 40))) (expect actual :to-equal expected)))) ;;; test-utils.el ends here esup-el_0.7.1+git20220203.4b49c8d/test/utils.el0000644000175000017500000001706514536061021020127 0ustar dogslegdogsleg;;; utils.el --- Esup: Non-interactive unit-test setup -*- lexical-binding: t; -*- ;; Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 2020 Joe Schafer ;; Author: Joe Schafer ;; Maintainer: Serghei Iakovlev ;; Version: 0.7.1 ;; URL: https://github.com/jschaf/esup ;; This file is NOT part of GNU Emacs. ;;;; License ;; This file 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 3 ;; of the License, or (at your option) any later version. ;; This file 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 file. If not, see . ;;; Commentary: ;; Esup's non-interactive test suite setup tp use `buttercup'. ;;; Code: (require 'buttercup) (require 'time-date) ; TODO(serghei): W/o this all test fails (add to esup.el?) (require 'dash) ; `-clone', `-table-flat', `-non-nil', `-map', etc (require 'cl-lib) ; `cl-defmacro' (require 'noflet) ; `noflet' (defvar esup-debug-enabled nil "Enable debug messages for the test utilities. Also sends all esup-child log messages to stdout.") (let* ((current-file (if load-in-progress load-file-name (buffer-file-name))) (source-directory (locate-dominating-file current-file "Cask")) ;; Don't load old byte-compiled versions (load-prefer-newer t)) ;; Load the file under test (add-to-list 'load-path source-directory) (load (expand-file-name "esup") nil 'nomessage) (load (expand-file-name "esup-child") nil 'nomessage)) ;;;; Utulity: (defun make-esup-result (file expression-string &rest args) "Create `esup-result' with desired FILE and EXPRESSION-STRING. In addition apply rest ARGS if any." (apply #'esup-result :file file :expression-string expression-string :end-point (1+ (length expression-string)) args)) (defun esup-test--all-slots () "Return a list of all possible slots for an `esup-result'." (--map (intern (concat ":" (symbol-name it))) (object-slots (make-instance 'esup-result)))) (defun esup-test--slots-to-compare (ignoring-slots) "Return a list of slots to compare for an `esup-result'. Create a new list with only the members of IGNORING-SLOTS that are not in `esup-test--all-slots' result." (-difference (esup-test--all-slots) ignoring-slots)) (defun esup-results-single-equal-p (ignoring-slots a b) "Compare `esup-result' objects with an IGNORING-SLOTS. A test for equality of A and B objects is performed by using `eq' defun." (--all? (not (null it)) (--map (equal (eieio-oref a it) (eieio-oref b it)) (esup-test--slots-to-compare ignoring-slots)))) (defun esup-results-equal-p (ignoring-slots a b) "Compare a list of `esup-result' objects with an IGNORING-SLOTS. A test for equality of A and B objects is performed by using `eq' defun." (and (eq (length a) (length b)) (--all? (not (null it)) (--zip-with (esup-results-single-equal-p ignoring-slots it other) a b)))) (defun esup-debug-test (str &rest format-args) "Output STR with FORMAT-ARGS if debug-mode is t." (when esup-debug-enabled (apply 'message str format-args))) (defun esup--join-paths (dir file) "Ensure FILE is abolute file name, otherwise use DIR as a base path." (cond ((file-name-absolute-p file) file) ((string= " " dir) file) (t (concat (file-name-as-directory dir) file)))) (defun esup-test-make-locate-file-fn (mock-fs) "Create locate file defun using MOCK-FS." (lambda (filename path &optional suffixes predicate) (esup-debug-test (concat "starting generated locate-file-fn: " "filename=%s path=%s suffixes=%s predicate=%s") filename path suffixes predicate) (let* ((all-files-no-suffix (-table-flat 'esup--join-paths (cons "" path) (list filename))) (all-files (-table-flat 'concat all-files-no-suffix (cons "" load-suffixes))) (matching-files-in-mock-fs (-non-nil ;; Find files that exist in the mock-fs (-map (lambda (path) (car-safe (or (assoc path mock-fs) (assoc (concat "./" path) mock-fs)))) all-files)))) (esup-debug-test "searching for file match: matching-files=%s all-files=%s" matching-files-in-mock-fs all-files) (car-safe matching-files-in-mock-fs)))) (defmacro with-esup-mock (props &rest body) "Evaluate BODY with local esup state variables. Use PROPS as a property list to create mock filesystem." (let ((old-features (-clone features))) `(let* ((load-path (plist-get ,props :load-path)) (mock-fs (plist-get ,props :files)) (locate-fn (esup-test-make-locate-file-fn mock-fs))) (esup-debug-test "starting with-esup-mock: load-path=%s mock-fs=%s" load-path mock-fs) (noflet ((find-file-noselect (filename &optional nowarn rawfile wildcards) (esup-debug-test (concat "starting mock find-file-no-select: " "filename=%s nowarn=%s rawfile=%s wildcards=%s") filename nowarn rawfile wildcards) (let ((mock-file-exists (assoc filename mock-fs)) (contents (alist-get filename mock-fs))) (if mock-file-exists (with-current-buffer (get-buffer-create filename) (setq-local buffer-file-name filename) (setq-local buffer-read-only nil) (insert contents) (current-buffer)) (error "Unknown file %s not in mock-fs" filename)))) (locate-file (filename path &optional suffixes predicate) (esup-debug-test "starting mock locate-file: filename=%s path=%s suffixes=%s pred=%s" filename path suffixes predicate) (let ((results (funcall locate-fn filename path suffixes predicate))) (esup-debug-test "locate-file mock returned '%s'" results) results)) (require (feature &optional filename noerror) (esup-debug-test "starting mock require: feature=%s filename=%s noerror=%s" feature filename noerror) (if filename (funcall locate-fn filename load-path) (funcall locate-fn (symbol-name feature) load-path))) ;; Stub out network calls. (esup-child-init-streams (port)) (kill-emacs (&optional arg)) (process-send-string (process string) (when esup-debug-enabled (message string))) (process-send-eof (&optional process))) ,@body (esup-debug-test "test added features %s" (-difference features ',old-features)) ;; Reset the features list in case any tests provided features. (setq features ',old-features) ;; Reset the max depth since the tests re-use the same environment. (when (and (boundp 'esup-child-max-depth) (not (eq esup-child-max-depth 2))) (esup-debug-test "Resetting esup-child-max-depth back to 2 from %d" esup-child-max-depth) (setq esup-child-max-depth 2)))))) ;;; utils.el ends here esup-el_0.7.1+git20220203.4b49c8d/Makefile0000644000175000017500000000351214536061021017116 0ustar dogslegdogsleg# Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 2020 Joe Schafero # # This file is NOT part of GNU Emacs. # # License # # This file 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 3 # of the License, or (at your option) any later version. # # This file 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 file. If not, see . include default.mk %.elc: %.el @printf "Compiling $<\n" @$(RUNEMACS) --eval '(setq byte-compile-error-on-warn t)' \ -f batch-byte-compile $< ## Public targets .PHONY: .title .title: @echo Esup $(VERSION) .PHONY: init init: Cask @$(CASK) install .PHONY: test test: @$(CASK) exec buttercup $(TESTFLAGS) .PHONY: build build: $(OBJS) .PHONY: clean clean: $(info Remove all byte compiled Elisp files...) @$(CASK) clean-elc .PHONY: help help: .title @echo 'Run "make init" first to install and update all local dependencies.' @echo '' @echo 'Available targets:' @echo ' help: Show this help and exit' @echo ' init: Initialize the project (has to be launched first)' @echo ' build: Byte compile Esup package' @echo ' test: Run the non-interactive unit test suite' @echo ' clean: Remove all byte compiled Elisp files as well as build' @echo ' artifacts' @echo '' @echo 'Available programs:' @echo ' $(CASK): $(if $(HAVE_CASK),yes,no)' @echo '' @echo 'You need $(CASK) to develop and test Esup.' @echo 'See https://cask.readthedocs.io/ for more.' @echo '' esup-el_0.7.1+git20220203.4b49c8d/esup-child.el0000644000175000017500000004370414536061021020044 0ustar dogslegdogsleg;;; esup-child.el --- lisp file for child Emacs to run. -*- lexical-binding: t -*- ;; Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 2020 Joe Schafer ;; Author: Joe Schafer ;; Maintainer: Serghei Iakovlev ;; Version: 0.7.1 ;; URL: https://github.com/jschaf/esup ;; Keywords: convenience, processes ;; Package-Requires: ((cl-lib "0.5") (emacs "25.1")) ;; This file is NOT part of GNU Emacs. ;;;; License ;; This file 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 3 ;; of the License, or (at your option) any later version. ;; This file 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 file. If not, see . ;;; Commentary: ;; The Emacs invoked to be timed will load this file. ;; ;; See documentation on https://github.com/jschaf/esup ;;; Code: (require 'benchmark) (require 'eieio) (require 'seq) (require 'subr-x) ;; We don't use :accesssor for class slots because it cause a ;; byte-compiler error even if we use the accessor. This is fixed in ;; Emacs 25. The error text is below: ;; ;; Unused lexical variable `scoped-class' (defclass esup-result () ((file :initarg :file :initform "" :type string :documentation "The file location for the result.") (start-point :initarg :start-point :initform 1 :type number :documentation "The start position of the benchmarked expression.") (line-number :initarg :line-number :initform 1 :type number :documentation "The beginning line number of the expression.") (expression-string :initarg :expression-string :initform "" :type string :documentation "A string representation of the benchmarked expression.") (end-point :initarg :end-point :initform 0 :type number :documentation "The end position of the benchmarked expression.") (exec-time :initarg :exec-time :initform 0 :type number :documentation) (gc-number :initarg :gc-number :initform 0 :type number :documentation "The number of garbage collections that ran.") (gc-time :initarg :gc-time :initform 0 :type number :documentation "The time taken by garbage collection.") (percentage :initarg :percentage :initform 0 :type number :documentation "The percentage of time taken by expression.")) "A record of benchmarked results.") (defvar esup-child-max-depth 1 "How deep to profile (require) statements. 0, don't step into any require statements. 1, step into require statements in `esup-init-file'. n, step into up to n levels of require statements.") (defvar esup-child-current-depth 0 "The current depth of require forms we've stepped into.") (defvar esup-child-last-call-intercept-results nil "The results of an intercepted call, if any. This is set when eval'ing an esup-advised `require' or `load' call before reaching the max depth. The profile information of the advice is used instead of the whole benchmark of the require.") (defvar esup-child-parent-log-process nil "The network process that connects to the parent Emacs. We send our log information back to the parent Emacs via this network process.") (defvar esup-child-parent-results-process nil "The network process that connects to the parent Emacs. We send our results back to the parent Emacs via this network process.") (defvar esup-child-result-separator "\n;;ESUP-RESULT-SEPARATOR;;\n" "The separator between results. The parent Emacs uses the separator to know when the child has sent a full result. Emacs accepts network input only when it's not busy and in bunches of about 500 bytes. So, we might not get a complete result.") (defun esup-child-connect-to-parent (port) "Connect to the parent process at PORT." (let ((port-num (if (stringp port) (string-to-number port) port))) (open-network-stream "*esup-child-connection*" "*esup-child-connection*" "localhost" port-num :type 'plain))) (defun esup-child-init-stream (port init-message) "Create process on PORT, send INIT-MESSAGE, and return the process." (let ((proc (esup-child-connect-to-parent port))) (set-process-query-on-exit-flag proc nil) (process-send-string proc init-message) proc)) (defun esup-child-send-log (format-str &rest args) "Send FORMAT-STR formatted with ARGS as a log message." (process-send-string esup-child-parent-log-process (apply 'format (concat "LOG: " format-str "\n") args))) (defun esup-child-send-result-separator () "Send the result separator to the parent process." (process-send-string esup-child-parent-results-process esup-child-result-separator)) (defun esup-child-send-results (results) "Send RESULTS to the parent process." (process-send-string esup-child-parent-results-process (esup-child-serialize-results results))) (defun esup-child-send-eof () "Make process see end-of-file in its input." (process-send-eof esup-child-parent-log-process)) (defun esup-child-log-invocation-options () "Log the invocation options that esup-child was started with." (let ((invocation-binary (concat invocation-directory invocation-name))) (esup-child-send-log "binary: %s" invocation-binary))) (defun esup-child-init-streams (port) "Initialize the streams for logging and results on PORT." (setq esup-child-parent-log-process (esup-child-init-stream port "LOGSTREAM")) (setq esup-child-parent-results-process (esup-child-init-stream port "RESULTSSTREAM"))) (defun esup-child-run (init-file port &optional max-depth) "Profile INIT-FILE and send results to localhost:PORT." (esup-child-init-streams port) (setq esup-child-max-depth (or max-depth esup-child-max-depth)) (esup-child-send-log "starting esup-child on '%s' port=%s max-depth=%s" init-file port esup-child-max-depth) (advice-add 'require :around 'esup-child-require-advice) (advice-add 'load :around 'esup-child-load-advice) (setq enable-local-variables :safe) (esup-child-log-invocation-options) (prog1 (esup-child-profile-file init-file) (advice-remove 'require 'esup-child-require-advice) (advice-remove 'load 'esup-child-load-advice) (kill-emacs))) (defun esup-child-chomp (str) "Chomp leading and tailing whitespace from STR." (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str) (setq str (replace-match "" t t str))) str) (defun esup-child-s-pad-left (len padding s) "If S is shorter than LEN, pad it with PADDING on the left." (let ((extra (max 0 (- len (length s))))) (concat (make-string extra (string-to-char padding)) s))) (defun esup-child-unindent (str) "Remove common leading whitespace from each line of STR. If STR contains only whitespace, return an empty string." (let* ((lines (split-string str "\\(\r\n\\|[\n\r]\\)")) (non-whitespace-lines (seq-filter (lambda (s) (< 0 (length (string-trim-left s)))) lines)) (n-to-trim (apply #'min (mapcar (lambda (s) (- (length s) (length (string-trim-left s)))) (or non-whitespace-lines [""])))) (result (string-join (mapcar (lambda (s) (substring (esup-child-s-pad-left n-to-trim " " s) n-to-trim)) lines) "\n"))) (if (= 0 (length (esup-child-chomp result))) "" result))) (defmacro with-esup-child-increasing-depth (&rest body) "Run BODY and with an incremented depth level. Decrement the depth level after complete." `(progn (setq esup-child-current-depth (1+ esup-child-current-depth)) (setq esup-child-last-call-intercept-results '()) (prog1 ;; This is cleared after `esup-child-profile-string' completes. (setq esup-child-last-call-intercept-results (progn ,@body)) (setq esup-child-current-depth (1- esup-child-current-depth))))) (defun esup-child-require-advice (old-require-fn feature &optional filename noerror) "Advice to `require' to profile sexps with esup if max depth isn't exceeded." (esup-child-send-log "intercepted require call feature=%s filename=%s current-depth=%d max-depth=%d" feature filename esup-child-current-depth esup-child-max-depth) (cond ;; We've exceed the depth limit, call old require. ((>= esup-child-current-depth esup-child-max-depth) (progn (esup-child-send-log "using old require because depth %s >= max-depth %d" esup-child-current-depth esup-child-max-depth) (funcall old-require-fn feature filename noerror))) ;; Feature already loaded. ((featurep feature) (esup-child-send-log "intercepted require call but feature already loaded") (funcall old-require-fn feature filename noerror)) ;; Max depth not exceeded, so profile the file with esup. (t (with-esup-child-increasing-depth (esup-child-send-log "stepping into require call" feature filename noerror) (esup-child-profile-file (esup-child-require-feature-to-filename feature filename)))))) (defun esup-child-load-advice (old-load-fn file &optional noerror nomessage nosuffix must-suffix) "Advice around `load' to profile a file with esup. Only profiles if `esup-child-max-depth' isn't reached." (cond ;; We've exceed the depth limit, call old load. ((>= esup-child-current-depth esup-child-max-depth) (progn (esup-child-send-log "intercepted load call but depth %d exceeds max-depth %d" esup-child-current-depth esup-child-max-depth) (funcall old-load-fn file noerror nomessage nosuffix must-suffix))) ;; Max depth not exceeded, so profile the file with esup. (t (with-esup-child-increasing-depth (esup-child-send-log "intercepted load call file=%s noerror=%s" file noerror) (esup-child-profile-file file))))) (defun esup-child-profile-file (file-name) "Profile FILE-NAME and return the benchmarked expressions." (esup-child-send-log "profiling file='%s'" file-name) (let* ((clean-file (esup-child-chomp file-name)) (abs-file-path (locate-file clean-file load-path ;; Add empty string in case the user has (load ;; "file.el"), otherwise we'll look for file.el.el (cons "" load-suffixes)))) (if abs-file-path (progn (esup-child-send-log "loading %s" abs-file-path) (esup-child-profile-buffer (find-file-noselect abs-file-path))) ;; The file doesn't exist, return an empty list of `esup-result' (esup-child-send-log "found no matching files for %s" abs-file-path) '()))) (defun esup-child-skip-byte-code-dynamic-docstrings () "Skip dynamic docstrings generated by byte compilation." (while (looking-at "[\s\t\n\r]*#@\\([0-9]+\\) ") (goto-char (+ (match-end 0) (string-to-number (match-string 1)))))) (defun esup-child-create-location-info-string (&optional buffer) "Create a string of the location info for BUFFER. BUFFER defaults to the current buffer." (unless buffer (setq buffer (current-buffer))) (let* ((line-number (line-number-at-pos (point))) (file-name (with-current-buffer buffer (buffer-file-name))) (location-information (format "%s:%d" file-name line-number))) location-information)) (defun esup-child-profile-buffer (buffer) "Profile BUFFER and return the benchmarked expressions." (condition-case-unless-debug error-message (with-current-buffer buffer (goto-char (point-min)) (forward-comment (buffer-size)) (esup-child-skip-byte-code-dynamic-docstrings) ;; The only way to reliably figure out if we're done is to compare ;; sexp positions. `forward-sexp' handles all the complexities of ;; white-space and comments. (let ((buffer-read-only t) (last-start -1) (end (progn (forward-sexp 1) (point))) (start (progn (forward-sexp -1) (point))) results (after-init-time nil)) (while (> start last-start) (setq results (append results (esup-child-profile-sexp start end))) (setq last-start start) (goto-char end) (esup-child-skip-byte-code-dynamic-docstrings) (forward-sexp 1) (setq end (point)) (forward-sexp -1) (setq start (point))) results)) (error (esup-child-send-log "ERROR(profile-buffer) at %s %s" (esup-child-create-location-info-string buffer) error-message) (esup-child-send-eof)))) (defun esup-child-profile-sexp (start end) "Profile the sexp between START and END in the current buffer. Returns a list of class `esup-result'." (let* ((sexp-string (esup-child-unindent (buffer-substring start end))) (line-number (line-number-at-pos start)) (file-name (buffer-file-name)) sexp esup--profile-results) (esup-child-send-log "profiling sexp at %s: %s" (esup-child-create-location-info-string) (buffer-substring-no-properties start (min end (+ 30 start)))) (condition-case-unless-debug error-message (progn (setq sexp (if (string-equal sexp-string "") "" (car-safe (read-from-string sexp-string)))) (cond ((string-equal sexp-string "") '()) (t (setq esup--profile-results (esup-child-profile-string sexp-string file-name line-number start end)) (esup-child-send-results esup--profile-results) (esup-child-send-result-separator) esup--profile-results))) (error (esup-child-send-log "ERROR(profile-sexp) at %s with sexp %s: error=%s" (esup-child-create-location-info-string) sexp error-message) (esup-child-send-eof))))) (defun esup-child-profile-string (sexp-string &optional file-name line-number start-point end-point) "Profile SEXP-STRING. Returns an `esup-reusult'. FILE-NAME is the file that SEXP-STRING was `eval'ed in. LINE-NUMBER is the line number of the string. START-POINT and END-POINT are the points at which SEXP-STRING appears in FILE-NAME." (let ((sexp (if (string-equal sexp-string "") "" (car-safe (read-from-string sexp-string)))) benchmark) (setq benchmark (benchmark-run (eval sexp))) (prog1 (if esup-child-last-call-intercept-results ;; We intercepted the last call with advice on load or ;; require. That means the we profiled the file by sexp, ;; so use that instead of the load or require call. (progn (esup-child-send-log "using intercepted results for string %s: %s" sexp-string esup-child-last-call-intercept-results) esup-child-last-call-intercept-results) ;; Otherwise, use the normal profile results. (list (esup-result (when (<= emacs-major-version 25) "esup-result") :file file-name :expression-string sexp-string :start-point start-point :end-point end-point :line-number line-number :exec-time (nth 0 benchmark) :gc-number (nth 1 benchmark) :gc-time (nth 2 benchmark)))) ;; Reset for the next invocation. (setq esup-child-last-call-intercept-results nil)))) (defun esup-child-require-feature-to-filename (feature &optional filename) "Given a require FEATURE, return the corresponding FILENAME." (esup-child-send-log "converting require to file-name feature='%s' filename='%s'" feature filename) (if (not filename) ;; Filename wasn't provided so use the feature. (pcase (type-of feature) ('symbol (symbol-name feature)) ('cons (symbol-name (eval feature)))) ;; Filename was provided so it overrides the feature. (pcase (type-of filename) ('string filename) ('cons (eval filename))))) (defun esup-child-serialize-result (esup-result) "Serialize an ESUP-RESULT into a `read'able string. We need this because `prin1-to-string' isn't stable between Emacs 25 and 26." (concat "(esup-result (when (<= emacs-major-version 25) \"esup-result\") " (format ":file %s " (prin1-to-string (slot-value esup-result 'file))) (format ":start-point %d " (slot-value esup-result 'start-point)) (format ":line-number %d " (slot-value esup-result 'line-number)) (format ":expression-string %s " (prin1-to-string (slot-value esup-result 'expression-string))) (format ":end-point %d " (slot-value esup-result 'end-point)) (format ":exec-time %f " (slot-value esup-result 'exec-time)) (format ":gc-number %d " (slot-value esup-result 'gc-number)) (format ":gc-time %f" (slot-value esup-result 'gc-time)) ")")) (defun esup-child-serialize-results (esup-results) "Serialize a list of ESUP-RESULTS into a `read'able string." (format "(list\n %s)" (mapconcat 'identity (cl-loop for result in esup-results collect (esup-child-serialize-result result)) "\n "))) (provide 'esup-child) ;;; esup-child.el ends here esup-el_0.7.1+git20220203.4b49c8d/.dir-locals.el0000644000175000017500000000042014536061021020102 0ustar dogslegdogsleg;;; Directory Local Variables ;;; For more information see (info "(emacs) Directory Variables") ((nil (sentence-end-double-space . t)) (emacs-lisp-mode (indent-tabs-mode . nil) (outline-regexp . ";;[;*]+[\s\t]+")) (makefile-gmake-mode (outline-regexp . "##"))) esup-el_0.7.1+git20220203.4b49c8d/esup-screenshot.png0000644000175000017500000011407314536061021021320 0ustar dogslegdogslegPNG  IHDRʖsRGBgAMA a pHYsodIDATx^$W~A%P_l(B#!ݸaCH(IK[ЊGv1XQc&Pj ԀX9]hbNjiJ$s2+<'W;Ͼ~?/~?;w~wק_?~~{/a;'.VyNݻ00;tK$ 1W4eac&6?'/ + Ӽ*M} Ѭ˱Ώ}+?#_|7~և?~woK}p9'G8iăh\7F`"n ƱOɐd+y-UF7jhVp~ׯl~Ï?[7۷~?&] oEIߦVn+?ӝz񿡚Of~{5z=] i5cC~R\ʗ ogtCyhchV[ұ4*߷fX ?7?7??}w|/w1@]Z'Uxbͽ9VCݿcҼVݓ>Ρ3--1 h1n( m7z9M8V;h΅F+FzӜ0]hV/o}G_w'_|/}__G?~w~/>@͸ P(`sOrO;WdO+?}Xynf5l}4a<9IbpS2Uc96&|o?{Ώ_}׷c#?O?kb+?QwjbdžM%5w_2W_Ri!4m$Bb}CcndF~<ĆZGiSsL ap)Feͪ7~Ϳߺ?֝;M~I Ԩ;5yHT$61. ! 4u]BpaaS+n.Y4sdl4_9NuxbpC2Uc96|{+_/?O뭷>s//Ə|?x?6@M,ć*y0gbÐP/Cb@<194Ml i>c٣__7ha ЭiFeͪW>{{O>G+_}o:)t16tgX^w]򾾏_nMٝv_a66c(7Kf"MB$j]`T_Ѭb[_~~;?ݿW?k|#+ gBlJ?]ܱp6oda <%cCXZL]a |ǣn_e4ƪx~Ώg _{gɿQ,TF;7?W~_7~_{p}޶ $6 `,b@lcp7(4j?VɟX2ZB`,W96w[/7i4gri<~ -Da>*>n`^~?-\{߹={,97ݏFoSQ~xO}7_~֪o?z.t|tǯws_hX֏=Ϛ5/ĕ ]WbC|WvwcɏٝRӼ4.w~Z{]Jݚ`Os!䇐%5g+d+%ky/\ʌ}K:7Mqыz{ ?,6`yCBxokm]p%|ݡIņ'v?ҭ?KF{`@#9;t\}NWo/ڭ Glw0) 2c{tٛi,xX@~a߬l;ڥ]f[8n1aG#S-p:_:k&اƆ출{^VVR7M;6\4FaVam7йwݏFaGfx2Spg j]|;J3]xؐ q=io+|< )|gͫw|gڥ[yaw]݋P}%{^_E0`w6*[abٳwp3,(;^#oֹf7^5%:^l/gӷ:~g_W7~Ďy o7;NiݛE>~ݻL7HfEܗcfQFaʧu|E3ң:6y^ :#m>\ƍ_HxuŽCYNp5u!RY|8O $aۭ'-:T_ߔo,ù_F㞮>W,F酱|xkXGS;ċ3m~k/Jݚ1 u0}_/˷F.\ ӈsC9lɎkA|cj޼F]v8i|Z)uja}<~huG~{k|? c5ވ7ϙ0|L|mt\yn;$yo%N0SY<8ڷbq)/ŗM_:3;؛̰_yh+j[l*vk6+: m+>y皮\znj|T7Q|Bz&&hԧQh|ZV9zr3ٯn8cņMgxo|Mڂ|.sw8i2Ahe}j =iW|0->w`|+֩=ݵfڟo76$#s0k2:ٕ8F&{?as/xVn^< /C%ZMzwzX83K}YMkTXddZ_q*NWo/.oLfX]^|Ee3qS[S}p\Nj 5Th![[|9{ܬ阍֚94tُA1}[+Oh,Nc~t&S8(U}o|Һew`ھWb@w6mtɆ6sCLJ8@FeDq ՗9z)_oc8Hp*9 ~J(?#?9+ߖQq*j~:s\arI(=lJ7^;4:Ll}pÈ   }Zb@l X 6 `,b@l X 6 `,b@l X 6 rl8|I녽W}½99mog|ݒ}GW8'B[|:Mڇ֧}3_' v;cil[~se˗uiG= _}۟|׻Il(!̹kpl%s_(ыJa‹:y <5NjC0)N66oo|zWpIx|eiϠ/8MrB+k (NbCr_*8=HOg+$nW޵^Ʉy.gBH16]LhbC*N{ ywe{pYXp4.]O5M,4گF~頰_ abqx'g߱>5DZ<,ņN(g*ݰڰ<0Syzga ӫHw9(ņl]&3_}%ԯ Em~> nW  yT+0Q]~rbCjCafņXwn,cCZƀ^]v7 KE}\:hW6ӨWvH~=6lNcRH ^Nxq˨/Yu f[鬛yRȆ%Kum~e ++VzAb}0SYH,6jpbEWV޻Ɔ"ATUx {qHP\gjC&NP!5C;8Nqja 06Y-&51= qNbC_j;g]Z?kq"3Sy{fzu"6 *vF ].(ņ6l&AZ}B_Fo~#>_5nL3Y8vM 6'n CJCIi5eMtCfL a:uӥm.P4دP|oh濭Јuyw|ZⷱRNQKcF"~p"Cr D_bH݆B8 #6 `,b@l26wK MfudK{MZ ru Ԗ>sF޹7^(B}hƆ*-Plh Sw]aaw>9?[aVlXIl<.87bC MݭslCM 5]f*J+dCo__H5DV ̔v[yٗ2)lc,0}߅mg+¢ Е_`la ɶFaɾ̪7O=taBΟUoE[7_~ ˃ݶuJ0_۽ NPtz!FwZ Po^|/ etZRam0:&${x)N/6ģ7}5d.|o+i{]C&cX1m['ۅzB؋ՆG^kV/:@lHOQ?\Zf+̔wWaF2|N:`2F16, YB)+;*΢ذ+qHnm Hc9' )|!l?nVO;6|8ֲ L~7_49T޵^B|C64]J!m&&J[@7;W~k6(.5xWR<)KVu&{/JĐ0*ُTmcFBW pCjC"*|p.pVU%YAg6ml#PtЖ|@^aW\yn[]u 4LbC* {l؜&]46,PU$lga+ssݚ!jɝBqRɻWYmث[!HrLBUvY-WN~cCVj{ؐ׾aE6Tf8g<^ErX 6@'9Эy0 /jn^}pkTΗgaCYnt䟰Gq]ĆԎ7CE4Z?k𸔟˽j3 DѕݓmB먠ohpe9ذ@݆ocFf/Z+)XjbNF|fݘ{3 l۴jp,T]m~CwPCi]t_^oM7nE Ej~B}cZlt1 s)ek.NOD.oO Ei[\JZɴ)e8"MGpkGl X 6 `,8dlx /ņ&3ܺ{d%^Mrνך[?YaWoa?_{Yp`Պ{6^^cý&I?x;gO'0uClxDl9DlWh쳼.WNJ =Wo춛nĆp~hcχ6릫s]ɻ-M~n_smUٯ]Zl~i! bN!bC6lNuoYoJޝbCmF[,48Tlh!QٯNf2q,^u7)tMJ_?srC5 \e bC{GJr pE06׃,bJņ5)ņoڃ? bCO=qpiFlx=,bÓ!K 4\S %*ǣ?k?o~h|:^^?w tǟz\- 7QU ڜņ, iMVmKlf݆Q)]mbX0vbԖM_ ^3Mn+fnä/z4wLzoRf 6p\0WG4a I=*a7K Clpe]J<<@Y?Iip\\ X 6 `,_|g~BNe=_ݰџQeWv#xKĆ~}%O_ƯBjo_/̿Nu+JSAav䷟:b$6 6H7'6(6u 6 6HU}^آذbu ֋+M3n My9 )O^_DžFyVW 65FN?x4 wE]W6~ 0 <_5*M#ւJ\_2Ncp@v6Pn[ז˳3'6 G>kU9iS#Iw+%`-a4#ʕ>m%a>X f>mFk+%I}SVX=z}F,?_U>^NcBj84{ac\1'*M0 >kK4^]q/9XZ_m}$qqʅvyi*c7E2e;ì5|_OV܊ikrELi;kyYҴ%kƆ߹;g*M``,7 6w/~x>Zڭ +dž&3ܺ{dZh &'gotnM\M;6su>El5*wk α!TwΞN_Lj )me&k¥}Qb \P.[>­66;MwΞIk[z?ϲ(G\>Z:FҦ͔d7nWvk!˳w(*y7}8aWdž϶5?0`R:~i _٭ +fƆ!-s)ƆB& o~ۣ0aN&6Fwb s_(ыV&Jzj~5!!fjeLlX-^ y^cC&-uŪkqnvJ_ՆG^kV{-gѨ(p Bo#p{ 3'7٠*Z(!t} $뒮r[+ Xw%~w`RWzl Kc. db74BWؑGߍ8]mX 6 `,b/I>s\wyHwfg.?~{p-/pp?6*[^b:V}OoFP]m('L{X-֎kѨ46tEmsSa7hpA+((pp36Ē+yyÒI!غxlE^W%jŪ7݋mјmok ǹO\{Z hv#S.5_ӇţQah*(kDbèFLlzPy'a hivJSIan0ʑ?d]dإ]esr5j w9PWc|U)%BgMӱhPsAiJSIa<ʑ_?wMA< Wk~s^V(ayjbM]ʫҠTeBӽu>T OQG&_/ggX=acCЦWy.Z G(!7E^ץ[C٭.oK+WX EqV=^7V&_)^K3\:l6:Zrv5mMwث<rp\?Rol؇k@$;|:p-,6gO'DlAl Xpz_a4A?[MvabeZ-o¿so~;^҇|/Wlw43~II?[ v9PUH\)?00VK/v4 m| U{q&\xLR~McX}6wkN(6ܼд;W2`0_p_klj a+w4F%1Wɡr [gwJ/ݚndžpFzB*DieĆP ;mP'/1bCq4_SdpU džmkpJưZJE]lD{kNV6^{+;4Tޅؐ|aԫ%Ɔ5v&TbC !UJWb*#D\g3B.:̲fV8\dCWs#{eLr(ZbC $7, ~!p]0p;F߅=<0m K2:+3cVܘ UZȕ0b\0p ŚqxPRy !^ ,nkrl(j=8Pk|)6\٫ w ED 0mR q2CwdbÎ5\lhPg,ĆiX'nqO'g5裯"lV[b Q jٶV  OtbC 7#cC;0zDm:fX@oU{,7bh\엏ZR،n[%^Aw5#FQ_.U & O=fG_MF;:>VnWuo?z.4h0_aw^}۟|׻rĆӏ cC(G^|29TzlOÿօjBBCNWPt!>w 6iNJڀMnyW-6+kjqĆg76GUxpzQ&pc*pH&suI !nrŠm[lg7gл K*V 8b!4.iܱjAVTۯ;W_م+w Pr)6t Wbq/+_&ʻ֫`FA)6ĕMbRܵN1\5RrM#< +V 8+0=օ5.\ڐH+ <˛TU%_}%Vi{UN28 E"備},ņՆ0$+cC#=jXww<*6Z5`)6nw|wP\Yޯ0wK]Z6'뮱a)$džJ 'ac<øBۥrP"ltJgmlXg.uM^}7,Y*y+V XD (ņp:!,W`tJW~cCȓj{ذU$j*33a/"9uJWbC,]>_fBl}3HXt#T˳݋~m"DXmW*R;?LoyLk(ٗʻܫ6ЫKq uTз{4ZrA)6l&}a0W޴HQ(p^VbnTz-  d56 ДMy Cݞ0yQޝ]t_^oM7nsk[7]: E 7ڎ Kۋqw~EpW)]ٜ5ͥ5LFʯxmhJwlX 6 `,b/0p~v5l+ On)V#?6dh*T877-7 ^Ψaa[v!0V} M? v! 0>YqW/'ȱaBR_Η~]lXV0bKv0n:nXٚg[.g_#ƆFwLyY*PdžmmY_f׳x %Pgۚ38_-.Ͽ8u X>n ǥ2}~qa)Yg0W\lhG%~Dr!6uPp]e/Nbê1%;{=5Jyذ`6]ZyHkvc@ 5zcrg[< W!bCZbA9֤8&C/KҶbݜ[3`[Rz_Ef{]S{Q5VLŨ[p]-_ĆD {545.iGņ1K)'s<>z~Dl8.p j5;vٿӸp]06׃,bfdž79+φʿ vcc%A݈ \B-~d t736K !6pndlj(a'#PO.r)HL-z5.M OޝC@W$zﻇgwV5 y+E+Bl(Jq\(7}+y8j<>ؐn%6\6rS^181716g13glxQ䡫  {}Ti}K!U .l~$kؐxPw7ѝMџ}j@CB:`!6٣]I aKuCcQ4pccCwR#b7 D*~F` X 6 `ذ470atwϞL[pӿXwua#q$6psXU~ZFeaFrV k3P^76(ygB9 ~0De!$"%66 <1; > J?4eI6Vr= JlXooew0ѳatF!04ӨT68_I&>iĆ-*N[k=n*[$fNOU:6,N,,EzpĆ !9͟VۻƆg/jtIjlb7⇲xx޲)Q\+h٭> adr?DazpĆ pwk͝MW]ӃwBqX.w+Ey16 ҙp16]Z$Lwj4jMgX_mF'6'6b@l X 6\W}S* j66t? Kl8YbBl8YbBl؇_V~rv{T=w)dS!6\Ӈw_uqΐ?x;gO6*@lT @pa"  6\P(ۍ6m%+=+@l⾻PZMl .*nTܟĆ=!I)s:niW .,b@l X 6 `pQ᯹ $pĆĆĆĆbÓ۷^zݳ'޻BXew\{uՒ^5gw6zvy[ևɴMy톇۴Nfn*KK?rSy*?)Wˏܚa)%4Mwv:|g5$6\T,cɞBA7xzy!\|Hp4lx+QY?<^H7N#k sH{ 7pQm)8o';߆0ºRWcĺH&$l 7pQPXgXSj(lbWb $ĆJoaC|Q =E93@vF16g}Ţbnb[b%6\T ?OC[yݶ֮HL8f9cCzU0U.S9D g8Ib%\`,b@l *!? G&6Rl]g88:8:bݾuwΞ;[5+˓ht%3 bCs/٬y3&]Ĝ&('jG'6\LH wϞt!Vro=~0Ć?.f!6bB+XC9 P| q:V{c<0lb"6WI? u3I'dcnd[CD.p1:Ow+=-7&Eyi4?f{[Ϋreu 'DlJ ߢȊ gUx?rgpR'|ƽ7{^3rh6= *\Fy&Np1zt~ 9&ak\ mi~-{ocozS­6?n?9}Yt{F$tV;?.,Tse}$ν[/{/Ƥ٠Oq'.,^4h@&gOWcC m0茲GA0/ 6C{=!@-6ۓUR*&.9,ņZ$hw$6WrQ-6T ܧ%.*gVޤ4ӱJt7)z?9p`,b@l X 6 ĆKYh-;ɹ u.#t;\re7zN!69#n5|?W} gRF ?$;X<%6\X,g*XfÒXY倡rK(Ox<6WkbCR'wp8*`Ć}Em[C쪚~ʏ'ņze<;`3W^5[dž4J }*V]rTC/cfHgY>tpvƸбa~K0yLlدΙPt{Z櫅|pؐ*5C*LK/qJ4y)*dž4j6yKlX7Ɍ6FEs|Knᝳ}S96T0miB.lv*KBT24 }b@l X 6 `,S [ѧff\*z#zҕpjĆIl`Ćz ^J{/Y!IJ2<]}NߔYmӡKFdy6i,ԓ۷ue&q2 VX%EsLԻ˲Ax8[^;V\sT7qcш {Q9֝0j uvX 2izv|p4b^4&nKJ~> 16 ziG2|n6k.nr#F~_~RaaFԅbCdzv|p4bEʧ%LkZ('ew+H_?l7Vߥf_*Ɔo!G#60kribH8bs&!!o#6P0I n.X 6 `,n~!6R]_/VW??w az 8^#6=~ wΞN_yؖAyp?nMp(bȱ 6p番8ʎ!6f?C}pa7wKJEpkOn:fE Pɵ{mܺ͜j|}n[+of7kʟt7 wk#VuzyvyTfQ9»5A Tİ!nB,86{8 [3SpSt bE2[0{vI6`mwa[a-%|[uj,_a -ݦ@N/U;bnMpbC&TbXIr-AZ*BFJZCohΤIn4'>ڤrf4PdG]N_V*n+v{)]ѓ𖟯~(OݚPĆPUZJ b&R%#6̉gL/^ܸ0r?/T2nMpHbüօ]ݼ ]J8'zxּ?j%6 `,b@l X 6 `,b@l X 6 `,b@l Xppʧ}sn^ۊ[i}|ʕ_}͗-yݗy|5*ĆF /Ooz >s|z-JݚN7_}۟|ןyך%ab~@l3CbS s_(ыVV^5䛐CjeLlX㛯|! 1E\dJvr[[+N>kj `FQQޔڟz}Rvz}W彵>%c>Ƈrlh7:J;na;̘3gs%^5%Dy7MBA߷>&7$C:Ն ]VB)ՆX]ⵂq_ 텅<1uHn w7?x|ynMݘW1$ y,ُP9P!K\'WqcCRmF 20] /zjXww<*6ڭsv㻃]u 4H}A.c_26Khml^j+mI n ־Y,^5 $'lnt!oC[|`tJ׵ KՆ6'$-o:a`JݚrF߬z]Bu<۽N~!˜~e*ĆXj2aV)6~!/YJ2cϚz}T[Q[S.1)*|g 2ہ'?6 M6ĆJV{5J]qɺ+w_E,u|EpM\JZ o:h|~ţnFā6ׇ,b@l Xp3^Kp,64ݳ'嗭)V ?9}{Mp(6s։>­VBx !TwΞN!ݹbG ;Dl"63V\pfpf;gO:/euK~mCܵ]F]-'0H^0is.'s\IHp.N;p ڰ!)Fc]1]`.W&v À8܆J+ֻ/y.rF˛6<ݯʁ|g†J71cCc TFJ64uup/ϨWlͰZCUa0`X:4jx4ÒnS yQ۹`l(x>F=Q!$ҦvN2ځ8r 7c|]fTAb0ۘJ%]Wdu1a;vfJ ]@%Z; s؜Go 9app?`ԥՏMS@]LXrXr;;!bCZnTkF,ۻnB9g~0BM6O s=Nwlh䰑|د&Ҍtv31,OSH mn|s\9unņ7\e-:`lX 6 `,b@l X 6 `,b@l X 6 `,b@l&6gG/ۭ׶VZ>reWywK^{g=z;_ = !,‹ņo.lkΟUoE[[雛=/~o}3oZ;Llدˏ a>3'9RG+JݚN_aMHhI a{&6/<>OwnIkP.W^5 ֬[f߱QQ } I(ƣ{kO'c>Ƈrlh7mjaI&5ߜA>3S/ڭ).x'D8i 56MW_'ҁ6]`$JPoWҿqr(ņwҋ 共җJn w7?x|ynMݘW1$ y,ُP9P!K\'WqcCRF \.P sWIrԣVñx}Ul[S7vw5꼿Ahh=0wK]`ell ƆenC}7,Y*y+vk6+INbC84.4"Wدk"Aq . k^5bY3 |y{Q&B1-U ~)q&E|݆Y0݆~w(EϚz}T[Q[S.1)*|g 2ہ'?6 M6ĆJV{5J]qɺ+V,6\: ?: "ktyc. db74BN>w@WCl X 6 `,8dlx /xG pٓ= xuIkAS _0s~rv{c uuν[s'ChEm ݐfr + !TwΞN ;8ۀw;Ww :^lA' ]8ŭp 6Um0.lJE)%6$cS V<iL#[3l7Fa[3{jmƻLcR'+l $Pi- &bÚ=O~ +kXL8M/rVb 4K)P.Pگb=F=6n\  *sZ.G2XoJJvEmBy|FwK/qy2UߩEXrXr;;!bCZ7荼~-5e'%Yވ}tqf?cC˱C&f+ƣ5OlTf9HlsbCwOv.+gNv斫Al X 6 `,b@l X 6 `,b@l X 6 `, ?|7v뵭֧'\og|ݒ}GW`-?ml>FƇYnΟUoE[[雛=/~o}3oZ&6džoM*h:4ͭP ?he5_[+L !?4i!_v`b*!F]2 M `]z+vk:}ɇ6W=zYݟ}džvQ$P5s"O 7cCLcCm}V/5ߜA>3S/ڭ).x'D8i 56MW_'\؁6]IUaIm](巿KKhJas?Fgq™ *$7ބ;CApkn+EXj*a/ԱF}7,Y*y+vk6+INbC84.4"W KVW%+m:z_Xwk\7k^sW!P/v/D0_\kR LXדF)6J3MN(p^VbnTz֔nL v  ,jE96TjQNH.VWF ;. +5pI!mD,u|EpM\JZ o:h|~ţnF@WCl X 6 `,8dlx /{G pٓ[uMeM)|"eNm-@{NsF~4>VB6x+ !ԬwΞN0^'m,4pPӷy\mi4҂>m[Ɔ-0l!Ե3|[N? Ю]nP1nrݮg߁)O(~8HC2.osNs޴ۇZ6T+bFLcU7K %SJ5K ۚTk<ޝd<\hd+ 7cC#mkj b;y&E[oz:97$B Y['cZ )6{w zzInMqI,?Q')MPieOɇo2.= ta(CW&yjC,.qr(ņH٠.v-ǻj8ܑ| ^5uc_y/JĐ0d?B@,qU.Ɔv=B韕3#b.WpVñx}Ul[S7vw5꼿Ahh=0wK]`26q:>ZjnRVW_ٹBoV%K%onMf [2]l'"Ж&&];a)׹wa/&a`JݚrF߬z]Bu<۽N~!˜~erbC,K1 36*ņ6[ɵ Y[N(p^VbnTz֔nL v  ,jE96̔כ*Z(!t}'z%]a淒 xXwL66LJ卹2f|t1;Gߍ݁6ׇ,b@l Xp3^x|i yG [&,64gO&ˏ26%V"s(L{ ٯS/}_xEM_y_K=Zvz .t+Mi;Plxޤ z'>L_ik7]( 3ب4u O}Ǔf8S`BpC,ycqbSظaKǰDkAbC(L=>t>6NUimZy#Ɔ91 @lhz]K Rl1;B5C5 ['9g :E0(z;p^iNcC*ņxWHlL+סOKizmp)mLi4`z%~m'oϬ=9':/߇316<,[spjvc!Vu !~Ͻj;ޤTFi\:'ey^Z׎jܹwްm+l(9ykGcٟ4tn;}bޮ4{O HKPx3a]N p@lh=6Lפ+Κ6 6W +I[snD16*d>VBV╁5! )Lc~KE;cB]|abDW14.GaƆ0'iI=*זQٯܶ06i ktK khyQB56̐\RHKsjC*_ڰ.*K8M kӋ VjJsEzkUKRƊP^ٵb0l7i(Zd/ܶzhO$&@?-{׾gCR}s` [kU&9ds#./,~)6 |Vy∱hNgwJN'6_lH?6P6yJl895 ϳG:צiAnH{5 l*MhfGBU*ͶG-Pu_=*lQ:PwщM;o=:5eSR+Y>~6Maa3+g>T.N,1>Liwfno^G5S 3r1|Wco$.t{y3\ȧHS vFWtk\VP8|M7Q9Pi_ûYo:a֟նߵ/m 5G+AGTWT>`:)O#J^NsU1˵i\ʰonMJĆcϿgG¸hҔ3KO&۪O#J9U(;+6UVzc@զQ|TT&x&ߙlZŧlZs J^ÑSٚ|ס8)]d%ǰ~xKOY=25G{u*`&Xp:?;g𺲦\2[ʑtX3l4ʎ~m k\(=_ja/]zٴqfwae*חVlUPh (~j;U.קqM~+#6[,8P-)63o16as͔F^Ԧqm~++nMdbêϳ1Wd Q >߂Ii1ӟax4"Lfs4j *G#Ym| V~׊G(ޅH.o:`iڱY^VٯmFhʠ*<˕iDa{v7r0wk%A,kw4*bF״5>aMs}ny[t=n3fS~YQV0{4Fhʓ+Hg?eUFPV;1]K޺Yn+ ^RUܯڶbhFigyfm%[u,Jݚ` ņ3{TG:^5j z.ҥ.IņmӍ'6\џ/xb*[Y9P5:'3G .O-j[lto&Xbpj`,b@l X 6 `,b@l X 6 `,b@l Xppʧ}sn^ۊ[i}|u_}͗-yݗy|5ֺ !,‹Ɔ>o|o ?SlϟUoE[[雛=/~o}3oZ&6džo$:6RG+JݚN_aMHhI aVƣ>Ƈ]HHcC.֬Ь9iZ-`]z+vk:}ɇ6W=zY]w\̾cC'Ϥ(pR I({1blh7:|3_}=p|s{pNk$(i|O(ִߧ7_}fܞpa0Sw ҼPo!}x89b~lP Ж]5o~>Jݚ1<%bHJXR_sB*ONqcCRRF 2ذՆ0E/54j8V]ϣ vkƜfW7 R|yZƆYjʱ6k߬ KJJݚ A6eNE-M 0MU%vpmcR$(Ն0ږ,u+vk}f5w"l:M cZh[U X/ŀ0ΤϿ0n%7܏K Q(p^VbnTz֔nL v  ,jE96̔כlP ^.o8d]Vnk~+Mlh/ARC'?: "ktyc. db74BN>wvw !6 `,b@l26wKbCn={2Y5ێ Zޛ&/'w ܻsx^6 a.LkRƯoZFGu*;gO'wHZpn`lxnZ9M(m3C]~M;{N vB%6P8P706db6iCE{N)8ĆrA ֋:צ);OܯI+Wc]A96)UC/϶USm+ӔjZQ;Ps-u A C޶fUܓ*Ͱ(ĆAϛ7K:U 4'XackyWG+VV^192]`zQ>P 5T=)VU9aQ)۳#l08gf.`l1X&C\Vzt?l6I(9ާd̹he+ V6{vS zzInMqI,?Q')MPieOɇo2.= ta(J+LjB)J6ʾW0MWnYѨ]᫯Ă3TIn w7?x|ynMݘW1$ y,ُP9P!K\''!)G}ņPgdfRlXІu&-Vñx}Ul[S7vw5꼿Ahh=0wK]`26qj>X*̐N{ Ա,־Y,^5 $'lnt!oC[|`tJƆHP\Pw7/t_Y?/ ;_[S.5CAΗgo"DXBگ VBlx)WFU~,IfV 32N(p^VbnTz֔nL v  ,jE96TjJlXӯBwR]Vn+J-641w=) iƆi\CS1Rl2!f'_;b@l X 6 ޻ƒw yG ņ&3ܺ{d4V&sJ1n{MZ/lfoLu?׿'_gwyX<'@{{PC{hl>5Sn^x/36Z-V_/~i/彖<8ĆP9{:Y [cќD \ 64K \18CĆB)S ņE~Kg W x;p )7 _'4m|NvMګPxN2t2˨v+DZay+J,G)L8Lcftcڴ3\|Bz=4w” bBҾ3lJĉirR1z4JWvX bC|JVm 5ezWTFcɇ)_'i^ino1je~5^ةc|{fNQ9_ue4ƥt)ppm %'ah mU7w9fIHz=vlKޤKNRw+C ZicC\ڬsPhbjGcPQş̧C-^Z}-!|!^yG^|XOldžU%o,s7Vt8Pv*1]4)Ͱ50hmjCyְfJ԰̗׫4+aU񔝗Me18xiY%SF<͒Ao_d~}~K?ru뒄wΫCņfY2VqtL?&֘~6~O>,?GCڙaׅ̘p|i_^K6 u Kt%_"6 G]7t25gT(qȏG?zk?_s'2SP\‹y3XM^RElwT|_~l"/lVlh>dsҫ ?~p__Ͽ/҃MV;i9^^W {^Ҝ/VLr韗 3Lw=D7w!ǻGe: 7:6\68ՆV 3>/^pZYjO+vUR/D;O8w*̐7M{ #mSm7\KUc+p%jϠžꪡF ?yRGv)4OJ{žN>V*=__LfgM&>@t'/|pH@>4_~6Gϒ ڊ*++bCa7|ajZ,d˯\)zh!FtiVWoA !EN<1 䐦3YF/q+jh?_8S9;Uv)auO]HQ\ҝy`t`jFӸɦL 4[Ϩ6*gl3l ٚ,uU83N6GcjlwŅ+/; &He>ulʛFME3Kr oGlV.'6O3fykz;ՆC *M񅄲iʵšXX9-*5œK'3oOZXrqZ}H㫨g5Fҫq_6rqG*p],p\RluCUoPn]h7)|b / 5~«qu [u/8Vbͽk*@/Uak!j>cՋW:[ѥؐUe/ǨP ݗ((UUƨoY/ ;sز,J=FL?e ;; Maintainer: Serghei Iakovlev ;; Version: 0.7.1 ;; URL: https://github.com/jschaf/esup ;; Keywords: convenience, processes ;; Package-Requires: ((cl-lib "0.5") (s "1.2") (emacs "25.1")) ;; This file is NOT part of GNU Emacs. ;;;; License ;; This file 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 3 ;; of the License, or (at your option) any later version. ;; This file 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 file. If not, see . ;;; Commentary: ;; Benchmark Emacs Startup time without ever leaving your Emacs. ;; ;; Esup profiles your Emacs startup time by examining all top-level ;; S-expressions (sexps). Esup starts a new Emacs process from ;; Emacs to profile each SEXP. After the profiled Emacs is complete, ;; it will exit and your Emacs will display the results. ;; ;; Esup will step into `require' and `load' forms at the top level ;; of a file, but not if they're enclosed in any other statement. ;; ;; Installation: ;; ;; Place esup.el and esup-child.el on your `load-path' by adding this ;; to your `user-init-file', usually ~/.emacs or ~/.emacs.d/init.el ;; ;; (add-to-list 'load-path "~/dir/to-esup") ;; ;; Load the code: ;; ;; (autoload 'esup "esup" "Emacs Start Up Profiler." nil) ;; ;; M-x `esup' to profile your Emacs startup and display the results. ;; ;; The master of all the material is the GitHub repository ;; (see URL `https://github.com/jschaf/esup'). ;; ;; Bugs: ;; ;; Bug tracking is currently handled using the GitHub issue tracker ;; (see URL `https://github.com/jschaf/esup/issues'). ;;; Code: ;;; Requirements (require 'eieio) (require 'esup-child) (eval-when-compile (require 'cl-lib)) ;;; Esup internals (defvar esup-load-path ;; Emacs doesn't visit a file when loading it, meaning ;; `buffer-file-name' returns nil. (file-name-directory (file-truename (if load-in-progress load-file-name buffer-file-name))) "Full directory path to esup.el and esup-child.el.") ;;; User variables (defgroup esup nil "A major mode for the Emacs Start Up Profiler." :prefix "esup-" :version "0.6" :group 'languages) (defcustom esup-user-init-file user-init-file "The user init files to profile." :group 'esup :type 'string) (defcustom esup-depth 1 "How deep to profile require and load expressions. 0, don't step into any require statements. 1, step into require statements in `esup-init-file'. n, step into up to n levels of require statements." :group 'esup :type 'integer) (defcustom esup-run-as-batch-p nil "If non-nil, run the profiled Emacs as batch. This option is off by default because batch runs faster than regular Emacs, so the timing information is not as realistic. If you don't want to the benchmarked Emacs frame to appear when running `esup', set this to t." :group 'esup :type 'boolean) (defcustom esup-insignificant-time 0.009 "Only show expressions that take longer than this time." :group 'esup :type 'float) (defcustom esup-server-port nil "The port for esup to communicate with the child Emacs. If value is nil, Emacs selects an unused port." :group 'esup :type 'integer) (defface esup-timing-information '((t :inherit font-lock-type-face)) "Face for displaying timing information. Includes execution time, gc time and number of gc pauses." :group 'esup :version "24.3") (defface esup-line-number '((t :inherit font-lock-constant-face)) "Face for displaying line numbers in the *esup* buffer." :group 'esup :version "24.3") (defface esup-column-number '((t :inherit font-lock-doc-face)) "Face for displaying column numbers in the *esup* buffer." :group 'esup :version "24.3") (defface esup-file '((t :inherit font-lock-function-name-face)) "Face for displaying the file name in the *esup* buffer." :group 'esup :version "24.3") (defface esup-error-face '((t :inherit font-lock-warning-face)) "Face for displaying errors in the *esup* buffer." :group 'esup :version "25.1") (defvar esup-child-process nil "The current esup child process, i.e the Emacs being timed.") (defvar esup-emacs-path (concat invocation-directory invocation-name) "Path to the Emacs binary used for profiling.") (defvar esup-errors '() "A list of error messages from the child Emacs.") (defun esup-total-exec-time (results) "Calculate the total execution time of RESULTS." (cl-loop for result in results sum (slot-value result 'exec-time) into total-exec-time finally return total-exec-time)) (defun esup-total-gc-number (results) "Calculate the total number of GC pauses of RESULTS." (cl-loop for result in results sum (slot-value result 'gc-number) into total-gc-number finally return total-gc-number)) (defun esup-total-gc-time (results) "Calculate the total time spent in GC of RESULTS." (cl-loop for result in results sum (slot-value result 'gc-time) into total-gc-time finally return total-gc-time)) (defun esup-drop-insignificant-times (results) "Remove inconsequential entries and sort RESULTS." (cl-delete-if (lambda (a) (< a esup-insignificant-time)) results :key #'(lambda (obj) (slot-value obj 'exec-time))) (cl-sort results '> :key #'(lambda (obj) (slot-value obj 'exec-time)))) (defun esup-update-percentages (results) "Add the percentage of exec-time to each item in RESULTS." (cl-loop for result in results with total-time = (esup-total-exec-time results) do (oset result :percentage (* 100 (/ (slot-value result 'exec-time) total-time))))) ;;; Controller - the entry points. (defun esup-visit-item () "Visit current item." (interactive) (let ((file (get-text-property (point) 'full-file)) (start-point (get-text-property (point) 'start-point))) (if file (progn (find-file-other-window file) (goto-char start-point)) (message "Not at a file.")))) (define-derived-mode esup-mode special-mode "esup" (buffer-disable-undo) (font-lock-mode 1)) (define-key esup-mode-map (kbd "") 'esup-visit-item) (define-key esup-mode-map "n" 'esup-next-result) (define-key esup-mode-map "p" 'esup-previous-result) (defun esup-next-result (&optional arg) "Move down the next ARG results." ;; This function and its counterpart `esup-previous-result' rely on ;; the text-property `result-break' that we added to the newline ;; between each result. The text-property is inserted in the ;; function `esup-display-results'. (interactive "p") (setq arg (or arg 1)) ;; Move off of the result-break text-property because otherwise the ;; movement will be off by one character. (when (get-text-property (point) 'result-break) (backward-char)) (let ((next-point (point))) (while (> arg 0) (setq next-point (next-single-property-change next-point 'result-break)) (if next-point (progn (setq arg (1- arg)) (setq next-point (1+ next-point))) (setq arg 0) (setq next-point (point-max)))) (goto-char next-point))) (defun esup-previous-result (&optional arg) "Move up the previous ARG results." (interactive "p") ;; Add one to arg because we have to go up 2 results then down one ;; character to be at the start of a new result. (setq arg (+ 2 (or arg 1))) ;; Get off the result-break because the movements will be off by one ;; character. (when (get-text-property (point) 'result-break) (forward-char)) (let ((prev-point (point))) (while (> arg 0) (setq prev-point (previous-single-property-change prev-point 'result-break)) (if prev-point (setq arg (1- arg)) ;; Break out of the loop because we couldn't find a previous ;; text-property of result-break, so we're at the beginning of ;; the buffer. (setq arg 0) (setq prev-point (point-min)))) (goto-char prev-point) (when (get-text-property (point) 'result-break) (forward-char)))) (defun esup-child-process-sentinel (process status) "Monitor PROCESS for change in STATUS." (cond ((string= status "finished\n") (esup-display-results)) (t (insert (format "Process %s %s" process status))))) (defvar esup-server-process nil "The parent Emacs' server process. The child Emacs send data to this process on `esup-child-results-port' and `esup-child-log-port'.") (defvar esup-child-results-port nil "The port by which the child Emacs sends profile results.") (defvar esup-child-log-port nil "The port by which the child Emacs sends log information.") (defvar esup-server-log-buffer "*esup-log*" "The log buffer for esup server messages.") (defun esup-server-log (format-str &rest args) "Log FORMAT-STR with format ARGS to `esup-server-log-buffer'." (unless (string-equal format-str "") (with-current-buffer esup-server-log-buffer (unless (bobp) (insert "\n")) (goto-char (point-max)) (if args (insert (apply 'format format-str args)) (insert format-str))))) (defvar esup-incoming-results-buffer "*esup-results*" "The buffer to hold incoming information from the child Emacs.") (defun esup-store-partial-result (result-str) "Write RESULT-STR to `esup-incoming-results-buffer'." (with-current-buffer (get-buffer-create esup-incoming-results-buffer) (goto-char (point-max)) (insert result-str))) (defun esup-select-port () "Select a port for the esup server process. If `esup-server-port' is nil, then let the OS select an unused port." ;; The value `t' instructs Emacs to pick an unused port. (or esup-server-port t)) (defun esup-server-create (port) "Create the esup parent server at localhost:PORT." (interactive) (make-network-process :name "*esup-server*" :type nil ; stream :server t :host 'local :service port :family nil ;; Broken on Emacs 25 ;; :nowait t :stop nil :buffer esup-server-log-buffer :coding 'utf-8 :noquery t :filter 'esup--server-filter :sentinel 'esup--server-sentinel :log 'esup--server-logger)) (defun esup--server-filter (proc string) "Filter the log and result entries recieved at the parent process. PROC is the process and STRING is the message. `esup-child' starts messages with LOGSTREAM or RESULTSSTREAM to indicate the type of message." (cond ((string-prefix-p "LOGSTREAM" string) (setq esup-child-log-port (process-contact proc :service)) (esup-server-log "Set information from port %s to be the log process" esup-child-log-port) ;; There might be information that tagged along with LOGSTREAM (esup-server-log (substring string (length "LOGSTREAM") (length string)))) ((string-prefix-p "RESULTSSTREAM" string) (setq esup-child-results-port (process-contact proc :service)) (esup-server-log "Set information from port %s to be the results process" esup-child-results-port) ;; There might be information that tagged along with RESULTSSTREAM (esup-store-partial-result (substring string (length "RESULTSSTREAM") (length string)))) ((eq esup-child-results-port (process-contact proc :service)) (esup-store-partial-result string)) ((eq esup-child-log-port (process-contact proc :service)) (when (string-prefix-p "LOG: ERROR" string) (push (substring string (length "LOG: ")) esup-errors)) (esup-server-log string)) (t (error "Recieved unknown message type")))) (defun esup--server-sentinel (proc event) "Listen for PROC EVENTs." (esup-server-log "name: %s, sentinel: proc: %s, event %s" (process-name proc) proc event)) (defun esup--server-logger (server connection message) "Log adapter for `make-network-process'. Provides a useful default for SERVER, CONNECTION and MESSAGE." (esup-server-log "logged: server %s, connection %s, message %s" server connection message)) (defvar esup-last-result-start-point 1 "The end point of the last read result from `esup-incoming-results-buffer'.") (defun esup-reset () "Reset all variables and buffers for another run of `esup'." (setq esup-last-result-start-point 1) (with-current-buffer (get-buffer-create esup-server-log-buffer) (buffer-disable-undo) (erase-buffer)) (with-current-buffer (get-buffer-create esup-incoming-results-buffer) (buffer-disable-undo) (erase-buffer)) (setq esup-errors '()) (when esup-server-process (delete-process esup-server-process))) ;;;###autoload (defun esup (&optional init-file &rest args) "Profile the startup time of Emacs in the background. If INIT-FILE is non-nil, profile that instead of USER-INIT-FILE. ARGS is a list of extra command line arguments to pass to Emacs." (interactive "P") (setq init-file (cond ;; Universal prefix arg, so prompt ((equal init-file '(4)) (read-file-name "Profile a file with esup: ")) ((stringp init-file) init-file) (t esup-user-init-file))) (message "Starting esup...") (esup-reset) (setq esup-server-process (esup-server-create (esup-select-port))) (setq esup-server-port (process-contact esup-server-process :service)) (message "esup process started on port %s" esup-server-port) (let ((process-args `("*esup-child*" "*esup-child*" ,esup-emacs-path ,@args "-q" "-L" ,esup-load-path "-l" "esup-child" ,(format "--eval=(esup-child-run \"%s\" \"%s\" %d)" init-file esup-server-port esup-depth)))) ;; The option -q is set by itself because this `start-process' errors if we ;; pass either an empty string or nil as an argument. (when esup-run-as-batch-p (setq process-args (append process-args '("--batch")))) (setq esup-child-process (apply #'start-process process-args))) (set-process-sentinel esup-child-process 'esup-child-process-sentinel)) (defun esup-follow-link (pos) "Follow the link that was clicked at point POS." (let ((file (get-text-property pos 'full-file)) (start-point (get-text-property pos 'start-point))) (message "Opening link to %s" file) (find-file-other-window file) (goto-char start-point))) ;;; Utilities. (defsubst esup-propertize-string (str &rest properties) "Replace all properties of STR with PROPERTIES." (set-text-properties 0 (length str) properties str) str) (defsubst esup-fontify-string (str face) "Modify STR's font-lock-face property to FACE and return STR." (esup-propertize-string str 'font-lock-face face)) ;;; View - rendering functions. (defvar esup-display-buffer "*esup*" "The buffer in which to display benchmark results.") (defun esup-buffer () "Initialize and return the *esup* buffer." (let ((buf (get-buffer esup-display-buffer))) (if buf buf (setq buf (generate-new-buffer esup-display-buffer)) (with-current-buffer buf (esup-mode))) buf)) (defun esup-display-results () "Display the results of the benchmarking." (interactive) (let* ((all-results (esup-fontify-results (esup-read-results))) (results (esup-drop-insignificant-times all-results)) (result-break (esup-propertize-string "\n" 'result-break t)) ;; Needed since the buffer is in `view-mode'. (inhibit-read-only t)) (with-current-buffer (esup-buffer) (erase-buffer) (esup-update-percentages results) (when esup-errors (insert (esup-render-errors esup-errors) result-break)) (insert (esup-render-summary results) result-break) (cl-loop for result in results do (insert (render result) result-break)) ;; We want the user to be at the top because it's disorienting ;; to start at the bottom. (goto-char (point-min)) (pop-to-buffer (current-buffer)))) (message "esup finished")) (defun esup-render-errors (errors) "Return a fontified string of ERRORS." (if esup-errors (concat (esup-fontify-string "ERROR: the child emacs had the following errors:\n" 'esup-error-face) (mapconcat 'identity (cl-loop for error-string in errors collect (format " %s" error-string)) "\n") "\n\n" (esup-fontify-string "Results will be incomplete due to errors.\n\n" 'esup-error-face)) "")) (defun esup-render-summary (results) "Return a summary string for RESULTS." (let ((total-exec-time (esup-total-exec-time results)) (total-gc-number (esup-total-gc-number results)) (total-gc-time (esup-total-gc-time results))) (concat "Total User Startup Time: " (esup-fontify-string (format "%.3fsec " total-exec-time) 'esup-timing-information) "Total Number of GC Pauses: " (esup-fontify-string (format "%d " total-gc-number) 'esup-timing-information) "Total GC Time: " (esup-fontify-string (format "%.3fsec" total-gc-time) 'esup-timing-information) "\n"))) (cl-defmethod render ((obj esup-result)) "Render fields with OBJ and return the string." (with-slots (file expression-string start-point end-point line-number exec-time percentage) obj (let* ((short-file (file-name-nondirectory file))) ;; TODO: make mouse clicking work on goto file (esup-propertize-string short-file 'font-lock-face 'esup-file 'mouse-face 'highlight 'full-file file 'follow-link 'esup-open-link 'start-point start-point 'keymap 'esup-open-link) (concat short-file (esup-fontify-string (format ":%d " line-number) 'esup-line-number) (esup-fontify-string (format "%.3fsec" exec-time) 'esup-timing-information) " " (esup-fontify-string (format "%d%%" percentage) 'esup-timing-information) "\n" expression-string "\n")))) (defun esup-fontify-results (results) "Add Emacs-Lisp font-lock to each expression in RESULTS." (with-temp-buffer (emacs-lisp-mode) (cl-loop for result in results do (erase-buffer) (insert (slot-value result 'expression-string)) (font-lock-ensure) (setf (slot-value result 'expression-string) (buffer-string))) results)) (defun esup-read-result (start-point) "Return one `esup-result' object from the current buffer. Begins reading at START-POINT. Returns either a class `esup-result' or nil." (goto-char start-point) (eval (read (current-buffer)))) (defun esup-next-separator-end-point () "Return the end point of the next `esup-child-result-separator'. Returns either an point or nil if `esup-child-result-separator' isn't bounded in current lexical context." (when (boundp 'esup-child-result-separator) (save-excursion (search-forward esup-child-result-separator (point-max) 'noerror)))) (defun esup-read-results () "Read all `esup-result' objects from `esup-incoming-results-buffer'." (let (results sep-end-point) (with-current-buffer (get-buffer esup-incoming-results-buffer) (goto-char esup-last-result-start-point) (message "at %s" esup-last-result-start-point) (unless (eobp) (while (setq sep-end-point (esup-next-separator-end-point)) (setq results (cons (car (esup-read-result (point))) results)) (setq esup-last-result-start-point sep-end-point) (goto-char esup-last-result-start-point)))) (nreverse results))) (provide 'esup) ;;; esup.el ends here esup-el_0.7.1+git20220203.4b49c8d/Cask0000644000175000017500000000036214536061021016262 0ustar dogslegdogsleg;; -*- mode: cask -*- (source gnu) (source melpa) (package-file "esup.el") (files "esup-child.el") (depends-on "cl-lib" "0.5") (development (depends-on "dash") (depends-on "buttercup") (depends-on "undercover") (depends-on "noflet")) esup-el_0.7.1+git20220203.4b49c8d/README.md0000644000175000017500000001053114536061021016734 0ustar dogslegdogsleg# ESUP - Emacs Start Up Profiler [![MELPA][melpa badge]][melpa link] [![MELPA Stable][melpa-s badge]][melpa-s link] [![Build Status][actions badge]][actions link] Benchmark Emacs Startup time without ever leaving your Emacs.

## Installation Known to work with GNU Emacs 25.1 and later. Esup may work with older versions of Emacs, but this is NOT guaranteed. Bug reports for problems related to using Esup with older versions of Emacs will most like not be addressed. The master of all the material is the Git repository at https://github.com/jschaf/esup . NOTE: The `master` branch will always contain the latest _unstable_ version. If you wish to check older versions or formal, tagged release, please switch to the relevant [tag][esup tags]. ### Using MELPA Add MELPA or MELPA Stable to the list of repositories to access this mode. MELPA tracks this Git repository and updates relatively soon after each commit or formal release. For more detail on setting up see [MELPA Getting Started][melpa help]. For those who want only formal, tagged releases use MELPA Stable: ``` emacs-lisp (require 'package) (add-to-list 'package-archives '("melpa-stable" . "https://stable.melpa.org/packages/") t) (package-initialize) ``` For those who want rolling releases as they happen use MELPA: ``` emacs-lisp (require 'package) (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) (package-initialize) ``` After initializing packaging system you can install Esup using preferred way: #### `package-list-packages` Use M-x package-refresh-contents and M-x package-list-packages to get to the package listing and install `esup` from there. #### Manual You can install `esup` manually by adding following to your init file: ``` emacs-lisp (unless (package-installed-p 'esup) (package-refresh-contents) (package-install 'esup)) ``` #### Cask Add following to your [Cask][cask] file: ``` emacs-lisp (source melpa) (depends-on "esup") ``` #### `use-package` Add following to your init file: ``` emacs-lisp (use-package esup :ensure t ;; To use MELPA Stable use ":pin melpa-stable", :pin melpa) ``` ### El-Get Esup is included in the El-Get repository. To install Esup using El-Get: M-x el-get-install RET esup RET Another way is to create a recipe file `esup.rcp` as follows: ``` emacs-lisp (:name esup :website "https://github.com/jschaf/esup" :description "Emacs Start Up Profiler" :type github :pkgname "jschaf/esup") ``` and add it to a directory present in `el-get-recipe-path`. Then, use M-x el-get-install RET esup or add: ``` emacs-lisp (el-get-bundle esup) ``` to your init file. ### Manual Install Download Esup and place the download directory on your `load-path` like so: ```emacs-lisp (add-to-list 'load-path "~/.emacs.d/path/to/esup") ``` And add _either_ of the two following lines to your initialization file. The first only loads Esup when necessary, the 2nd always during startup of GNU Emacs. ``` emacs-lisp (autoload 'esup "esup" "Emacs Start Up Profiler." nil) ;; OR (require 'esup) ``` ## Usage To start Esup, run M-x esup, and watch the magic happen. ### Profile a custom file with esup By default, Esup will profile `user-init-file`. To profile a custom file, call `esup` with a prefix argument. That is, C-u M-x esup. ## Developing Patches are always welcome. To submit a patch, use something like the following workflow. - Clone the project: ``` sh git clone https://github.com/jschaf/esup.git cd esup git checkout -b MY-NEW-FIX ``` - Implement your fix - Ensure that all elisp code is lint-clean with Flycheck - Test your fix with [Cask][cask] - Test your fixes with the Emacs Regression Test runner ``` make test ``` - Create a pull request with the normal GitHub user interface [actions badge]: https://github.com/jschaf/esup/workflows/build/badge.svg [actions link]: https://github.com/jschaf/esup/actions [melpa badge]: https://melpa.org/packages/esup-badge.svg [melpa link]: https://melpa.org/#/esup [melpa-s badge]: https://stable.melpa.org/packages/esup-badge.svg [melpa-s link]: https://stable.melpa.org/#/esup [esup tags]: https://github.com/jschaf/esup/tags [melpa help]: https://melpa.org/#/getting-started [cask]: https://cask.github.io esup-el_0.7.1+git20220203.4b49c8d/default.mk0000644000175000017500000000244314536061021017435 0ustar dogslegdogsleg# Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019, 2020 Joe Schafero # # This file is NOT part of GNU Emacs. # # License # # This file 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 3 # of the License, or (at your option) any later version. # # This file 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 file. If not, see . # Run “make build” by default .DEFAULT_GOAL = build EMACS ?= emacs CASK ?= cask EMACSFLAGS ?= TESTFLAGS ?= -L . EMACSBATCH = $(EMACS) -Q --batch -L . $(EMACSFLAGS) RUNEMACS = # Program availability HAVE_CASK := $(shell sh -c "command -v $(CASK)") ifndef HAVE_CASK $(warning "$(CASK) is not available. Please run make help") RUNEMACS = $(EMACSBATCH) else RUNEMACS = $(CASK) exec $(EMACSBATCH) endif VERSION="$(shell sed -nre '/^;; Version:/ { s/^;; Version:[ \t]+//; p }' esup.el)" # File lists SRCS = esup-child.el esup.el OBJS = $(SRCS:.el=.elc)