You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
210 lines
8.0 KiB
210 lines
8.0 KiB
;; Copyright (C) 2010-2011, 2013-2014, 2016-2019 Free Software Foundation, Inc
|
|
|
|
;; Author: Rocky Bernstein <rocky@gnu.org>
|
|
|
|
;; This program 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 program 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.
|
|
|
|
; Should realgud:file-loc-from-line be here or elsewhere?
|
|
(require 'load-relative)
|
|
(require 'compile) ;; for compilation-find-file
|
|
(require 'seq) ;; for seq-find
|
|
(require-relative-list '("helper" "loc") "realgud-")
|
|
(require-relative-list '("buffer/command") "realgud-buffer-")
|
|
|
|
(declare-function realgud:strip 'realgud)
|
|
(declare-function realgud-loc-goto 'realgud-loc)
|
|
(declare-function realgud-get-cmdbuf 'realgud-buffer-helper)
|
|
(declare-function buffer-killed? 'helper)
|
|
(declare-function compilation-find-file 'compile)
|
|
(declare-function realgud-cmdbuf-info-ignore-re-file-list 'realgud-buffer-command)
|
|
(declare-function realgud-cmdbuf-info-source-path= 'realgud-buffer-command)
|
|
(declare-function realgud-cmdbuf-mutex 'realgud-buffer-command)
|
|
(declare-function realgud-cmdbuf-filename-remap-alist 'realgud-buffer-command)
|
|
(declare-function realgud-cmdbuf-filename-remap-alist= 'realgud-buffer-command)
|
|
(declare-function realgud-cmdbuf-mutex 'realgud-buffer-command)
|
|
|
|
(defcustom realgud-file-find-function 'realgud:find-file
|
|
;;(defcustom realgud-file-find-function 'compilation-find-file
|
|
"Function to call when we can't easily find file"
|
|
:type 'function
|
|
:group 'realgud)
|
|
|
|
(defun realgud:find-file (marker filename directory &optional formats)
|
|
"A wrapper around compilation find-file. We set the prompt
|
|
to indicate we are looking for a source-code file."
|
|
(or formats (setq formats "%s"))
|
|
(let ((compilation-error "source-code file"))
|
|
(compilation-find-file marker filename directory formats)))
|
|
|
|
(defun realgud:file-line-count(filename)
|
|
"Return the number of lines in file FILENAME, or nil FILENAME can't be
|
|
found"
|
|
(if (file-exists-p filename)
|
|
(let ((file-buffer (find-file-noselect filename)))
|
|
(with-current-buffer-safe file-buffer
|
|
(line-number-at-pos (point-max))))
|
|
nil))
|
|
|
|
(defun realgud:file-column-from-string(filename line-number source-text
|
|
&optional no-strip-blanks)
|
|
"Return the column of the first column position of SOURCE-TEXT
|
|
at LINE-NUMBER or nil if it is not there"
|
|
(condition-case nil
|
|
(when (and source-text (file-exists-p filename))
|
|
(let ((file-buffer (find-file-noselect filename)))
|
|
(with-current-buffer-safe file-buffer
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(forward-line (1- line-number))
|
|
(unless no-strip-blanks
|
|
(setq source-text (realgud:strip source-text)))
|
|
(when (search-forward source-text (point-at-eol))
|
|
(goto-char (match-beginning 0))
|
|
(current-column))))))
|
|
(error nil)))
|
|
|
|
(defun realgud:file-ignore(filename ignore-re-file-list)
|
|
(seq-find '(lambda (file-re) (string-match file-re filename)) ignore-re-file-list))
|
|
|
|
;; FIXME: should allow column number to be passed in.
|
|
(defun realgud:file-loc-from-line(filename line-number
|
|
&optional cmd-marker source-text bp-num
|
|
find-file-fn directory)
|
|
"Return a realgud-loc for FILENAME and LINE-NUMBER and the
|
|
other optional position information.
|
|
|
|
CMD-MARKER and BP-NUM get stored in the realgud-loc
|
|
object. FIND-FILE-FN is a function which do special things to
|
|
transform filename so it can be found. This could include
|
|
searching classpaths (in Java), stripping leading and trailing
|
|
blanks, or deliberately ignoring 'pseudo-file patterns like (eval
|
|
1) of Perl and <string> of Python.
|
|
|
|
If we're unable find the source code we return a string describing the
|
|
problem as best as we can determine."
|
|
|
|
(let* ((cmdbuf (or (realgud-get-cmdbuf) cmd-marker))
|
|
(ignore-re-file-list (realgud-cmdbuf-ignore-re-file-list cmdbuf))
|
|
(filename-remap-alist (realgud-cmdbuf-filename-remap-alist cmdbuf))
|
|
(remapped-filename
|
|
(assoc filename filename-remap-alist))
|
|
(mutex (realgud-cmdbuf-mutex cmdbuf))
|
|
)
|
|
|
|
;;(with-mutex
|
|
;; mutex
|
|
(when remapped-filename
|
|
(if (file-readable-p (cdr remapped-filename))
|
|
(setq filename (cdr remapped-filename))
|
|
;; else remove from map since no find
|
|
(realgud-cmdbuf-filename-remap-alist=
|
|
(delq (assoc remapped-filename filename-remap-alist)
|
|
filename-remap-alist))))
|
|
|
|
(unless (and filename (file-readable-p filename))
|
|
|
|
(cond
|
|
;; Is file already listed for ignore?
|
|
((realgud:file-ignore filename ignore-re-file-list)
|
|
(message "tracking ignored for %s" filename))
|
|
|
|
;; Do we want to black-list this?
|
|
((y-or-n-p (format "Black-list file %s for location tracking?" filename))
|
|
;; FIXME: there has to be a simpler way to set ignore-file-list
|
|
(with-current-buffer cmdbuf
|
|
(push filename ignore-re-file-list)
|
|
(realgud-cmdbuf-info-ignore-re-file-list= ignore-re-file-list))
|
|
(setq filename nil)
|
|
)
|
|
|
|
;; Do we have a custom find-file function?
|
|
(find-file-fn
|
|
(setq filename (funcall find-file-fn cmd-marker filename directory)))
|
|
|
|
(t
|
|
(let ((found-file (funcall realgud-file-find-function (point-marker) filename directory)))
|
|
(if found-file
|
|
(progn
|
|
(setq remapped-filename (buffer-file-name found-file))
|
|
(when (and remapped-filename (file-exists-p remapped-filename))
|
|
(realgud-cmdbuf-filename-remap-alist=
|
|
(cons
|
|
(cons filename remapped-filename)
|
|
filename-remap-alist)
|
|
cmdbuf)
|
|
(setq filename remapped-filename)
|
|
))
|
|
;; else
|
|
(setq filename nil)
|
|
)))
|
|
)))
|
|
;;)
|
|
|
|
(if filename
|
|
(if (file-readable-p filename)
|
|
(if (integerp line-number)
|
|
(if (> line-number 0)
|
|
(let ((line-count))
|
|
(if (setq line-count (realgud:file-line-count filename))
|
|
(if (> line-count line-number)
|
|
(let* ((column-number
|
|
(realgud:file-column-from-string filename
|
|
line-number
|
|
source-text))
|
|
(source-buffer (find-file-noselect filename))
|
|
(source-mark))
|
|
|
|
;; Set this filename as the last one seen in cmdbuf
|
|
(realgud-cmdbuf-info-source-path= filename)
|
|
|
|
;; And you thought we'd never get around to
|
|
;; doing something other than validation?
|
|
(with-current-buffer source-buffer
|
|
(goto-char (point-min))
|
|
;; FIXME also allow column number and byte offset
|
|
(forward-line (1- line-number))
|
|
(make-realgud-loc
|
|
:num bp-num
|
|
:cmd-marker cmd-marker
|
|
:filename filename
|
|
:line-number line-number
|
|
:column-number column-number
|
|
:source-text source-text
|
|
:marker (point-marker)
|
|
)
|
|
))
|
|
;; else
|
|
(format "File %s has only %d lines. (Line %d requested.)"
|
|
filename line-count line-number))
|
|
(format "Problem getting line count for file `%s'" filename)))
|
|
(format "line number %s should be greater than 0" line-number))
|
|
(format "%s is not an integer" line-number))
|
|
;; else
|
|
(if filename
|
|
(format "File named `%s' not readable" filename))))
|
|
)
|
|
|
|
;; FIXME: should allow column number to be passed in.
|
|
(defun realgud:file-remove-ignore(path-to-stop-ignoring)
|
|
"Remove `path-to-stop-ignoring' from the list of paths which
|
|
are ignored in debugger location tracking. You might do this if you accidentllay
|
|
added a a path for ignoring by mistake."
|
|
(interactive
|
|
(list (completing-read "File name to stop ignoring: "
|
|
(realgud-cmdbuf-ignore-re-file-list (current-buffer))
|
|
nil t)))
|
|
(when (member path-to-stop-ignoring (realgud-cmdbuf-ignore-re-file-list (current-buffer)))
|
|
(realgud-cmdbuf-info-ignore-re-file-list=
|
|
(delete path-to-stop-ignoring (realgud-cmdbuf-ignore-re-file-list (current-buffer)))))
|
|
)
|
|
|
|
|
|
(provide-me "realgud-")
|