code.delx.au - gnu-emacs-elpa/blob - packages/realgud/realgud/common/file.el

   1 ;;; Copyright (C) 2010-2011, 2013-2014 Rocky Bernstein <rocky@gnu.org>
   2 ; Should realgud:file-loc-from-line be here or elsewhere?
   3 (require 'load-relative)
   4 (require 'compile) ;; for compilation-find-file
   5 (require-relative-list '("helper" "loc") "realgud-")
   6
   7 (defvar realgud-file-remap (make-hash-table :test 'equal)
   8   "How to remap files we otherwise can't find in the
   9   filesystem. The hash key is the file string we saw, and the
  10   value is associated filesystem string presumably in the
  11   filesystem")
  12
  13 (declare-function realgud:strip         'realgud)
  14 (declare-function realgud-loc-goto      'realgud-loc)
  15 (declare-function buffer-killed?        'helper)
  16 (declare-function compilation-find-file 'compile)
  17
  18 (defun realgud:file-line-count(filename)
  19   "Return the number of lines in file FILENAME, or nil FILENAME can't be
  20 found"
  21   (if (file-exists-p filename)
  22       (let ((file-buffer (find-file-noselect filename)))
  23         (with-current-buffer-safe file-buffer
  24           (line-number-at-pos (point-max))))
  25     nil))
  26
  27 (defun realgud:file-column-from-string(filename line-number source-text
  28                                                 &optional no-strip-blanks)
  29   "Return the column of the first column position of SOURCE-TEXT
  30 at LINE-NUMBER or nil if it is not there"
  31   (condition-case nil
  32       (if (file-exists-p filename)
  33           (let ((file-buffer (find-file-noselect filename)))
  34             (with-current-buffer-safe file-buffer
  35               (save-excursion
  36                 (goto-char (point-min))
  37                 (forward-line (1- line-number))
  38                 (unless no-strip-blanks
  39                   (setq source-text (realgud:strip source-text)))
  40                 (if (search-forward source-text (point-at-eol))
  41                     (- (current-column)
  42                        (length source-text))))))
  43         ;; else
  44         nil)
  45     (error nil))
  46 )
  47
  48
  49 ;; FIXME: should allow column number to be passed in.
  50 (defun realgud:file-loc-from-line(filename line-number
  51                                            &optional cmd-marker source-text bp-num
  52                                            ;; FIXME: remove ignore-file-re and cover with
  53                                            ;; find-file-fn.
  54                                            ignore-file-re find-file-fn)
  55   "Return a realgud-loc for FILENAME and LINE-NUMBER and the
  56 other optional position information.
  57
  58 CMD-MARKER and BP-NUM get stored in the realgud-loc
  59 object. FIND-FILE-FN is a function which do special things to
  60 transform filename so it can be found. This could include
  61 searching classpaths (in Java), stripping leading and trailing
  62 blanks, or deliberately ignoring 'pseudo-file patterns like (eval
  63 1) of Perl and <string> of Python.
  64
  65 If we're unable find the source code we return a string describing the
  66 problem as best as we can determine."
  67
  68   (unless (and filename (file-readable-p filename))
  69     (if find-file-fn
  70         (setq filename (funcall find-file-fn filename))
  71       ;; FIXME: Remove the below by refactoring to use the above find-file-fn
  72       ;; else
  73       (if (and ignore-file-re (string-match ignore-file-re filename))
  74           (message "tracking ignored for psuedo-file %s" filename)
  75         ;; else
  76         (let ((remapped-filename))
  77           (if (gethash filename realgud-file-remap)
  78               (progn
  79                 (setq remapped-filename (gethash filename realgud-file-remap))
  80                 (if (file-exists-p remapped-filename)
  81                     (setq filename remapped-filename)
  82                   (remhash filename realgud-file-remap)))
  83             ;; else
  84             (progn
  85               (setq remapped-filename
  86                     (buffer-file-name
  87                      (compilation-find-file (point-marker) filename nil)))
  88               (when (and remapped-filename (file-exists-p remapped-filename))
  89                 (puthash filename remapped-filename realgud-file-remap)
  90                 (setq filename remapped-filename)
  91                 )
  92               )))
  93         )
  94       ;; FIXME: remove above -----------------------------------.
  95       ))
  96   (if filename
  97       (if (file-readable-p filename)
  98           (if (integerp line-number)
  99               (if (> line-number 0)
 100                   (lexical-let ((line-count))
 101                     (if (setq line-count (realgud:file-line-count filename))
 102                         (if (> line-count line-number)
 103                             (let* ((column-number
 104                                     (realgud:file-column-from-string filename
 105                                                                     line-number
 106                                                                     source-text))
 107                                    ;; And you thought we'd never get around to
 108                                    ;; doing something other than validation?
 109                                    (loc (make-realgud-loc
 110                                          :num           bp-num
 111                                          :cmd-marker    cmd-marker
 112                                          :filename      filename
 113                                          :line-number   line-number
 114                                          :column-number column-number
 115                                          :source-text   source-text
 116                                          :marker        (make-marker)
 117                                          )))
 118                               loc)
 119                           ;; else
 120                           (format "File %s has only %d lines. (Line %d requested.)"
 121                                   filename line-count line-number))
 122                       (format "Problem getting line count for file `%s'" filename)))
 123                 (format "line number %s should be greater than 0" line-number))
 124             (format "%s is not an integer" line-number))
 125         ;; else
 126         (format "File named `%s' not readable" filename)))
 127   )
 128
 129 (provide-me "realgud-")