;;; ein-traceback.el --- Traceback module -*- lexical-binding:t -*-
;; Copyright (C) 2012- Takafumi Arakaki
;; Author: Takafumi Arakaki <aka.tkf at gmail.com>
;; This file is NOT part of GNU Emacs.
;; ein-traceback.el 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.
;; ein-traceback.el 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 ein-traceback.el. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'eieio)
(require 'ewoc)
(require 'ansi-color)
(require 'ein-core)
(require 'ein-shared-output)
(declare-function ein:get-notebook "ein-notebook")
(declare-function ein:notebook-buffer "ein-notebook")
(defclass ein:traceback ()
((tb-data :initarg :tb-data :type list)
(notebook :initarg :source-notebook ;; :type ein:$notebook
:accessor ein:traceback-notebook)
(buffer-name :initarg :buffer-name :type string)
(buffer :initarg :buffer :type buffer)
(ewoc :initarg :ewoc :type ewoc)))
(ein:deflocal ein:%traceback% nil
"Buffer local variable to store an instance of `ein:traceback'.")
(defvar ein:tb-buffer-name-template "*ein:tb %s/%s*")
(defun ein:tb-new (buffer-name notebook)
(make-instance 'ein:traceback
:buffer-name buffer-name
:source-notebook notebook))
(cl-defmethod ein:tb-get-buffer ((traceback ein:traceback))
(unless (and (slot-boundp traceback :buffer)
(buffer-live-p (slot-value traceback 'buffer)))
(let ((buf (get-buffer-create (slot-value traceback 'buffer-name))))
(setf (slot-value traceback 'buffer) buf)))
(slot-value traceback 'buffer))
(defun ein:tb-pp (ewoc-data)
(insert (ansi-color-apply ewoc-data)))
(cl-defmethod ein:tb-render ((traceback ein:traceback) tb-data)
(with-current-buffer (ein:tb-get-buffer traceback)
(setq ein:%traceback% traceback)
(setq buffer-read-only t)
(let ((inhibit-read-only t)
(ewoc (ein:ewoc-create #'ein:tb-pp)))
(erase-buffer)
(setf (slot-value traceback 'ewoc) ewoc)
(setf (slot-value traceback 'tb-data) tb-data)
(mapc (lambda (data) (ewoc-enter-last ewoc data)) tb-data))
(ein:traceback-mode)))
(cl-defmethod ein:tb-popup ((traceback ein:traceback) tb-data)
(ein:tb-render traceback tb-data)
(pop-to-buffer (ein:tb-get-buffer traceback)))
;;;###autoload
(defun ein:tb-show ()
"Show full traceback in traceback viewer."
(interactive)
(unless
(ein:and-let* ((tb-data (ein:get-traceback-data))
(url-or-port (or (ein:get-url-or-port)
(ein:get-url-or-port--shared-output)))
(kernel (or (ein:get-kernel)
(ein:get-kernel--shared-output)))
(kr-id (ein:kernel-id kernel))
(tb-name (format ein:tb-buffer-name-template
url-or-port kr-id)))
(ein:tb-popup (ein:tb-new tb-name (ein:get-notebook)) tb-data)
t)
(error "No traceback is available.")))
(cl-defmethod ein:tb-range-of-node-at-point ((traceback ein:traceback))
(let* ((ewoc (slot-value traceback 'ewoc))
(ewoc-node (ewoc-locate ewoc))
(beg (ewoc-location ewoc-node))
(end (ein:aand (ewoc-next ewoc ewoc-node) (ewoc-location it))))
(list beg end)))
(cl-defmethod ein:tb-file-path-at-point ((traceback ein:traceback))
(cl-destructuring-bind (beg end)
(ein:tb-range-of-node-at-point traceback)
(let* ((file-tail
(next-single-property-change beg 'font-lock-face nil end))
(file (when file-tail
(buffer-substring-no-properties beg file-tail))))
(if (string-match "\\.pyc$" file)
(concat (file-name-sans-extension file) ".py")
file))))
(cl-defmethod ein:tb-file-lineno-at-point ((traceback ein:traceback))
(cl-destructuring-bind (beg end)
(ein:tb-range-of-node-at-point traceback)
(when (save-excursion
(goto-char beg)
(search-forward-regexp "^[-]+> \\([0-9]+\\)" end t))
(string-to-number (match-string 1)))))
(cl-defmethod ein:tb-jump-to-source-at-point ((traceback ein:traceback)
&optional select)
(let ((file (ein:tb-file-path-at-point traceback))
(lineno (ein:tb-file-lineno-at-point traceback)))
(if (string-match "<ipython-input-\\([0-9]+\\)-.*" file)
(let* ((cellnum (string-to-number (match-string 1 file)))
(nb (slot-value traceback 'notebook))
(ws (cl-first (ein:$notebook-worksheets nb)))
(cells (ein:worksheet-get-cells ws))
(it (cl-find cellnum cells :key #'(lambda (x)
(if (same-class-p x 'ein:codecell)
(slot-value x 'input-prompt-number))))))
(if it
(progn
(pop-to-buffer (ein:notebook-buffer nb))
(ein:cell-goto-line it lineno))))
(let ((url-or-port (ein:$notebook-url-or-port (ein:traceback-notebook traceback))))
(cond
((numberp url-or-port) (ein:tb-jtsap--local file lineno select))
((string-match "localhost" url-or-port) (ein:tb-jtsap--local file lineno select))
((string-match "127.0.0.1" url-or-port) (ein:tb-jtsap--local file lineno select))
(t (ein:tb-jtsap--remote url-or-port file lineno select)))))))
(defun ein:tb-jtsap--local (file lineno select)
(cl-assert (file-exists-p file) nil "File %s does not exist." file)
(let ((buf (find-file-noselect file))
(scroll (lambda ()
(goto-char (point-min))
(forward-line (1- lineno)))))
(if select
(progn (pop-to-buffer buf)
(funcall scroll))
(with-selected-window (display-buffer buf)
(funcall scroll)))))
(defun ein:tb-jtsap--remote (uri path lineno select)
(let* ((uri (url-generic-parse-url uri))
(host-path (concat "/" (url-host uri)
":" path)))
(ein:tb-jtsap--local host-path lineno select)))
(defun ein:tb-jump-to-source-at-point-command (&optional select)
(interactive "P")
(ein:tb-jump-to-source-at-point ein:%traceback% select))
(defun ein:tb-prev-item ()
(interactive)
(ewoc-goto-prev (slot-value ein:%traceback% 'ewoc) 1))
(defun ein:tb-next-item ()
(interactive)
(ewoc-goto-next (slot-value ein:%traceback% 'ewoc) 1))
(defvar ein:traceback-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'ein:tb-jump-to-source-at-point-command)
(define-key map "p" 'ein:tb-prev-item)
(define-key map "n" 'ein:tb-next-item)
map)
"Keymap for ein:traceback-mode.")
(define-derived-mode ein:traceback-mode special-mode "ein:tb"
(font-lock-mode))
(add-hook 'ein:traceback-mode-hook 'ein:truncate-lines-on)
(provide 'ein-traceback)
;;; ein-traceback.el ends here