spacemacs/core/core-debug.el

;;; core-debug.el --- Spacemacs Core File  -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2012-2020 Sylvain Benner & Contributors
;;
;; Author: Sylvain Benner <sylvain.benner@gmail.com>
;; URL: https://github.com/syl20bnr/spacemacs
;;
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3

(defun spacemacs/display-and-copy-version ()
  "Echo the current spacemacs version and copy it."
  (interactive)
  (let ((msg (format "Spacemacs v.%s" spacemacs-version)))
    (message msg) (kill-new msg)))


;; startup debug

(require 'profiler)

(defvar spacemacs-debug-timer-threshold 0.15
  "Generate message if file takes longer than this number of
seconds to load")

(defvar spacemacs-debugp nil)
(defvar spacemacs-debug-with-profile nil)
(defvar spacemacs-debug-with-timed-requires nil)
(defvar spacemacs-debug-with-adv-timers nil)

(defun spacemacs//load-timer (origfunc &rest args)
  "Used to time invocation of `require' or `load'."
  (let ((start (current-time))
        (required (car args))
        delta)
    (prog1
        (apply origfunc args)
      (setq delta (float-time (time-since start)))
      (when (> delta spacemacs-debug-timer-threshold)
        (with-current-buffer "*load-times*"
          (goto-char (point-max))
          (insert (format "[%.3f] (%.3f) Load or require\n    Feature: %s\n    In file: %s\n\n"
                          (float-time (time-since emacs-start-time))
                          delta required load-file-name)))))))

(defmacro spacemacs||make-function-timer (func)
  "Used to time call to FUNC."
  `(lambda (origfunc &rest args)
     (let ((start (current-time))
           delta)
       (prog1
           (apply origfunc args)
         (setq delta (float-time (time-since start)))
         (when (> delta spacemacs-debug-timer-threshold)
           (with-current-buffer "*load-times*"
             (goto-char (point-max))
             (insert (format "[%.3f] (%.3f) Function call\n    Function: %s\n    Args: %s\n\n"
                             (float-time (time-since emacs-start-time))
                             delta ',func args))))))))

(defmacro spacemacs||make-function-profiler (func)
  `(lambda (origfunc &rest args)
     (if (profiler-running-p)
         (profiler-report)
       (profiler-start 'cpu))
     (prog1
         (apply origfunc args)
       (with-current-buffer "*load-times*"
         (goto-char (point-max))
         (insert (format "[%.3f] Done profiling function: %s\n\n"
                         (float-time (time-since emacs-start-time)) ',func)))
       (profiler-report))))

(defun spacemacs/init-debug ()
  "Set the debug hooks."
  (when spacemacs-debug-with-profile
    (profiler-start 'cpu+mem)
    (add-hook 'after-init-hook
              (lambda ()
                (run-with-idle-timer 2 nil (lambda ()
                                             (profiler-report)
                                             (profiler-stop))))))

  (when (version<= "27.0" emacs-version)
    (require 'time-date))
  (when spacemacs-debug-with-timed-requires
    (with-current-buffer (get-buffer-create "*load-times*")
      (insert (format "Threshold set at %.3f seconds\n\n"
                      spacemacs-debug-timer-threshold)))

    (defadvice package-initialize (around spacemacs//timed-initialize activate)
      (let ((start (current-time)) res delta)
        (setq res ad-do-it
              delta (float-time (time-since start)))
        (when (> delta spacemacs-debug-timer-threshold)
          (with-current-buffer "*load-times*"
            (goto-char (point-max))
            (insert (format "package-initialize took %.3f sec\n" delta))))
        res))

    (defadvice require (around spacemacs//timed-require activate)
      (let ((start (current-time)) res delta)
        (setq res ad-do-it
              delta (float-time (time-since start)))
        (when (> delta spacemacs-debug-timer-threshold)
          (with-current-buffer "*load-times*"
            (goto-char (point-max))
            (insert (format "File %s: Required %s: %.3f sec\n"
                            load-file-name (ad-get-arg 0) delta))))
        res))

    (defadvice load (around spacemacs//timed-load activate)
      (let ((start (current-time)) res delta)
        (setq res ad-do-it
              delta (float-time (time-since start)))
        (when (> delta spacemacs-debug-timer-threshold)
          (with-current-buffer "*load-times*"
            (goto-char (point-max))
            (insert (format "File %s: Loaded %s: %.3f sec\n"
                            load-file-name (ad-get-arg 0) delta))))
        res)))

  (when spacemacs-debug-with-adv-timers
    (with-current-buffer (get-buffer-create "*load-times*")
      (insert (format "Measured times greater than %.3f sec:\n\n"
                      spacemacs-debug-timer-threshold)))

    (add-hook 'after-init-hook
              (lambda ()
                (with-current-buffer "*load-times*"
                  (goto-char (point-max))
                  (insert (format "[%.3f] Spacemacs finished initializing\n\n"
                                  (float-time (time-since emacs-start-time)) )))))

    (advice-add 'load :around #'spacemacs//load-timer)
    (advice-add 'require :around #'spacemacs//load-timer)
    (advice-add 'package-initialize
                :around
                (spacemacs||make-function-timer package-initialize))
    (advice-add 'configuration-layer/load
                :around
                (spacemacs||make-function-timer configuration-layer/load))
    ;; (advice-add 'configuration-layer/load
    ;;             :around
    ;;             (spacemacs||make-function-profiler configuration-layer/load))
    (advice-add 'configuration-layer//configure-package
                :around
                (spacemacs||make-function-timer configuration-layer//configure-package)))

  ;; Keep debug-on-error on for stuff that is lazily loaded
  (add-hook 'after-init-hook (lambda () (setq debug-on-error t))))


;; Report issue

(defun spacemacs//describe-system-info-string ()
  "Gathers info about your Spacemacs setup and returns it as a string."
  (format
   (concat "#### System Info :computer:\n"
           "- OS: %s\n"
           "- Emacs: %s\n"
           "- Spacemacs: %s\n"
           "- Spacemacs branch: %s (rev. %s)\n"
           "- Graphic display: %s\n"
           "- Distribution: %s\n"
           "- Editing style: %s\n"
           "- Completion: %s\n"
           "- Layers:\n```elisp\n%s```\n"
           (when (version<= "25.1" emacs-version)
             "- System configuration features: %s\n"))
   system-type
   emacs-version
   spacemacs-version
   (spacemacs//git-get-current-branch)
   (spacemacs/git-get-current-branch-rev)
   (display-graphic-p)
   dotspacemacs-distribution
   dotspacemacs-editing-style
   (cond ((configuration-layer/layer-used-p 'helm)
          'helm)
         ((configuration-layer/layer-used-p 'ivy)
          'ivy)
         (t 'helm))
   (pp-to-string dotspacemacs--configuration-layers-saved)
   (bound-and-true-p system-configuration-features)))

(defun spacemacs/describe-system-info ()
  "Gathers info about your Spacemacs setup and copies to clipboard."
  (interactive)
  (let ((sysinfo (spacemacs//describe-system-info-string)))
    (kill-new sysinfo)
    (message sysinfo)
    (message (concat "Information has been copied to clipboard.\n"
                     "You can paste it in the gitter chat.\n"
                     "Check the *Messages* buffer if you need to review it"))))

(defun spacemacs//describe-last-keys-string ()
  "Gathers info about your Emacs last keys and returns it as a string."
  (cl-loop
   for key
   across (recent-keys)
   collect (if (or (integerp key) (symbolp key) (listp key))
               (single-key-description key)
             (prin1-to-string key))
   into keys
   finally (return
            (with-temp-buffer
              (set-fill-column 60)
              (insert (mapconcat 'identity keys " "))
              (fill-region (point-min) (point-max))
              (format "#### Emacs last keys :musical_keyboard: \n```text\n%s\n```\n" (buffer-string))))))

(defun spacemacs/describe-last-keys ()
  "Gathers info about your Emacs last keys and copies to clipboard."
  (interactive)
  (let ((lossage (spacemacs//describe-last-keys-string)))
    (kill-new lossage)
    (message lossage)
    (message (concat "Information has been copied to clipboard.\n"
                     (propertize
                      "PLEASE REVIEW THE DATA BEFORE GOING FURTHER AS IT CAN CONTAIN SENSITIVE DATA (PASSWORD, ...)\n"
                      'face 'font-lock-warning-face)
                     "You can paste it in the gitter chat.\n"
                     "Check the *Messages* buffer if you need to review it"))))

(defun spacemacs/report-issue (arg)
  "Open a spacemacs/report-issue-mode buffer prepopulated with
   issue report template and system information.

   With prefix arg,include the last keys pressed."
  (interactive "P")
  (let ((buf
         (generate-new-buffer "REPORT_SPACEMACS_ISSUE"))
        (system-info
         (spacemacs//describe-system-info-string))
        (backtrace
         (if (get-buffer "*Backtrace*")
             (with-current-buffer "*Backtrace*"
               (buffer-substring-no-properties
                (point-min)
                (min (point-max) 1000)))
           "<<BACKTRACE IF RELEVANT>>"))
        (last-keys
         (if (and arg (y-or-n-p (concat "Do you really want to "
                                        "include your last pressed keys? It "
                                        "may include some sensitive data.")))
             (concat (spacemacs//describe-last-keys-string) "\n")
           "")))
    (switch-to-buffer buf)
    (let ((ov (make-overlay (point-min) (point-min)))
          (prop-val
           (concat (propertize (concat "REPLACE ALL UPPERCASE EXPRESSIONS"
                                       " AND PRESS `C-c C-c` TO SUBMIT")
                               'display
                               '(raise -1)
                               'face
                               'font-lock-warning-face)
                   "\n\n")))
      (overlay-put ov 'after-string prop-val))
    (insert-file-contents
     (concat configuration-layer-template-directory "REPORTING.template"))
    (cl-loop
     for (placeholder replacement)
     in `(("%SYSTEM_INFO%" ,system-info)
          ("%BACKTRACE%" ,backtrace)
          ("(%LAST_KEYS%)\n" ,last-keys))
     do (save-excursion
          (goto-char (point-min))
          (search-forward placeholder)
          (replace-match replacement [keep-case] [literal])))
    (set-buffer-modified-p nil)
    (spacemacs/report-issue-mode)))

(defun spacemacs//report-issue-kill-buffer-query ()
  "Check if issue has been edited when buffer is about to be
  killed. Intended to be used with
  `kill-buffer-query-functions'"
  (if (buffer-modified-p)
      (y-or-n-p "Issue has unsaved changes, kill buffer anyways? ")
    t))

(define-derived-mode spacemacs/report-issue-mode text-mode "Report-Issue"
  "Major mode for reporting issues with Spacemacs.

When done editing, you can type \\[spacemacs//report-issue-done] to create the
issue on GitHub. You must be logged in already for this to work. After you see
that the issue has been created successfully, you can close this buffer.

\\{spacemacs/report-issue-mode-map}
"
  (font-lock-add-keywords 'spacemacs/report-issue-mode
                          '(("\\(<<.*?>>\\)" . 'font-lock-comment-face)))
  (add-hook 'kill-buffer-query-functions
            'spacemacs//report-issue-kill-buffer-query
            nil t))

(define-key spacemacs/report-issue-mode-map
  (kbd "C-c C-c") 'spacemacs//report-issue-done)
(define-key spacemacs/report-issue-mode-map
  (kbd "C-c C-k") 'kill-buffer)

(with-eval-after-load 'bind-map
  (spacemacs/set-leader-keys-for-major-mode 'spacemacs/report-issue-mode
    "," 'spacemacs//report-issue-done
    "c" 'spacemacs//report-issue-done
    "a" 'kill-buffer
    "k" 'kill-buffer))

(defun spacemacs//report-issue-done ()
  (interactive)
  (let ((url "http://github.com/syl20bnr/spacemacs/issues/new?body=")
        (body (url-hexify-string (buffer-string))))
    (browse-url (url-encode-url (concat url body)))))

(provide 'core-debug)