Commits

Taylor Venable committed ddad83b

Implement tags table scanning

Comments (0)

Files changed (1)

 ;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 ;;; POSSIBILITY OF SUCH DAMAGE.
 
-(tcv-require 'char)
+(tcv-require '(char string table))
 
-(namespace "tags#")
+(##include "tcv-tags#.scm")
 
-(define *file-sep* (kbd 'ctrl #\L))
-(define *pos-sep* (kbd 'ctrl #\?))
+(namespace ("tags#" read-etags-file symbol-info))
+
+(define *file-sep* (char#kbd 'ctrl #\L))
+(define *pos-sep-1* (char#kbd 'ctrl #\?))
+(define *pos-sep-2* (char#kbd 'ctrl #\A))
+
+(define (read-etags-file path)
+  (let ((port (open-input-file path))
+        (tags (make-tags-file
+               path
+               (make-table test: string=?)
+               (make-table test: string=?))))
+    (let loop ((file-name #f))
+      (let ((line (read-line port)))
+        (cond ((eof-object? line) tags)
+              ((string=? line (string *file-sep*))
+               (let ((new-file-name (car (string-split (read-line port) #\,))))
+                 (loop new-file-name)))
+              (else
+               (let* ((sep-1 (string-split line *pos-sep-1*))
+                      (sep-2 (string-split (cadr sep-1) *pos-sep-2*))
+                      (full-name (car sep-1))
+                      (short-name (if (null? (cdr sep-2)) #f (car sep-2)))
+                      (symbol-name (if short-name short-name
+                                       (let ((s (car (reverse (string-split (string-trim full-name) #\space)))))
+                                         (substring s 0 (- (string-length s) 1)))))
+                      (pos (string-split (if (null? (cdr sep-2)) (car sep-2) (cadr sep-2)) #\,))
+                      (symbol-defn (make-symbol-defn symbol-name file-name pos))
+                      (symbols-tbl (tags#tags-file-symbols tags))
+                      (files-tbl (tags#tags-file-files tags)))
+                 (table#prepend! symbols-tbl symbol-name symbol-defn)
+                 (table#prepend! files-tbl file-name symbol-defn)
+                 (loop file-name))))))))
+
+(define (symbol-info tags symbol-name)
+  (table-ref (tags#tags-file-symbols tags) symbol-name))
+
+(namespace (""))
 
 ;; Local Variables:
 ;; scheme-dialect: gambit