125 lines
4.6 KiB
EmacsLisp
125 lines
4.6 KiB
EmacsLisp
|
;;; racket-visit.el -*- lexical-binding: t -*-
|
||
|
|
|
||
|
|
;; Copyright (c) 2013-2020 by Greg Hendershott.
|
||
|
|
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
|
||
|
|
|
||
|
|
;; Author: Greg Hendershott
|
||
|
|
;; URL: https://github.com/greghendershott/racket-mode
|
||
|
|
|
||
|
|
;; License:
|
||
|
|
;; This 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 2, or (at your option)
|
||
|
|
;; any later version. This 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. See
|
||
|
|
;; http://www.gnu.org/licenses/ for details.
|
||
|
|
|
||
|
|
(require 'racket-cmd)
|
||
|
|
(require 'racket-ppss)
|
||
|
|
(require 'racket-util)
|
||
|
|
|
||
|
|
;;; visiting defs and mods
|
||
|
|
|
||
|
|
(defun racket-visit-module (&optional prefix)
|
||
|
|
"Visit definition of module at point, e.g. net/url or \"file.rkt\".
|
||
|
|
|
||
|
|
If there is no module at point, prompt for it.
|
||
|
|
|
||
|
|
With a prefix, always prompt for the module.
|
||
|
|
|
||
|
|
Use `racket-unvisit' to return.
|
||
|
|
|
||
|
|
See also: `racket-find-collection'."
|
||
|
|
(interactive "P")
|
||
|
|
(let* ((v (racket--module-at-point))
|
||
|
|
(v (if (or prefix (not v))
|
||
|
|
(read-from-minibuffer "Visit module: " (or v ""))
|
||
|
|
v)))
|
||
|
|
;; If the module name is quoted e.g. "file.rkt", just do
|
||
|
|
;; equivalent of `find-file-at-point'. Else ask back-end.
|
||
|
|
(cond ((and (equal "\"" (substring v 0 1))
|
||
|
|
(equal "\"" (substring v -1 nil)))
|
||
|
|
(racket--push-loc)
|
||
|
|
(find-file (expand-file-name (substring v 1 -1)))
|
||
|
|
(message "Type M-, to return"))
|
||
|
|
(t (racket--do-visit-def-or-mod nil `(mod ,v))))))
|
||
|
|
|
||
|
|
(defun racket--module-at-point ()
|
||
|
|
"Treat point as a Racket module path name, possibly in a multi-in form."
|
||
|
|
;; `thing-at-point' 'filename matches both net/url and "file.rkt".
|
||
|
|
;; But. 1. Returns both without the quotes; use `syntax-ppss' to
|
||
|
|
;; detect latter (string). 2. Returns nil if on the opening quote;
|
||
|
|
;; use `forward-char' then.
|
||
|
|
(save-excursion
|
||
|
|
(when (eq ?\" (char-syntax (char-after))) ;2
|
||
|
|
(forward-char))
|
||
|
|
(pcase (thing-at-point 'filename t)
|
||
|
|
(`() `())
|
||
|
|
(v
|
||
|
|
(let* ((ppss (syntax-ppss))
|
||
|
|
(relative-p (and (racket--ppss-string-p ppss) t)) ;1
|
||
|
|
(multi-in (condition-case ()
|
||
|
|
(progn
|
||
|
|
(when relative-p
|
||
|
|
(goto-char (racket--ppss-string/comment-start ppss)))
|
||
|
|
(backward-up-list 1)
|
||
|
|
(backward-sexp 2)
|
||
|
|
(when (looking-at-p "multi-in")
|
||
|
|
(forward-sexp 2)
|
||
|
|
(backward-sexp 1)
|
||
|
|
(when (eq ?\" (char-syntax (char-after))) ;2
|
||
|
|
(forward-char))
|
||
|
|
(unless (eq relative-p
|
||
|
|
(and (racket--ppss-string-p ppss) t)) ;1
|
||
|
|
(user-error "multi-in mixes absolute and relative paths"))
|
||
|
|
(thing-at-point 'filename t)))
|
||
|
|
(scan-error nil))))
|
||
|
|
(concat (if relative-p "\"" "") ;1
|
||
|
|
(if multi-in
|
||
|
|
(concat multi-in "/")
|
||
|
|
"")
|
||
|
|
v
|
||
|
|
(if relative-p "\"" ""))))))) ;1
|
||
|
|
|
||
|
|
(defun racket--do-visit-def-or-mod (repl-session-id cmd)
|
||
|
|
(unless (memq major-mode '(racket-mode racket-repl-mode racket-describe-mode))
|
||
|
|
(user-error "That doesn't work in %s" major-mode))
|
||
|
|
(racket--cmd/async
|
||
|
|
repl-session-id
|
||
|
|
cmd
|
||
|
|
(lambda (result)
|
||
|
|
(pcase result
|
||
|
|
(`(,path ,line ,col)
|
||
|
|
(racket--push-loc)
|
||
|
|
(find-file (funcall racket-path-from-racket-to-emacs-function path))
|
||
|
|
(goto-char (point-min))
|
||
|
|
(forward-line (1- line))
|
||
|
|
(forward-char col)
|
||
|
|
(message "Type M-, to return"))
|
||
|
|
(`kernel
|
||
|
|
(message "Defined in #%%kernel -- source not available"))
|
||
|
|
(_
|
||
|
|
(message "Not found"))))))
|
||
|
|
|
||
|
|
(defvar racket--loc-stack '())
|
||
|
|
|
||
|
|
(defun racket--push-loc ()
|
||
|
|
(push (cons (current-buffer) (point))
|
||
|
|
racket--loc-stack))
|
||
|
|
|
||
|
|
(defun racket-unvisit ()
|
||
|
|
"Return from previous `racket-visit-definition' or `racket-visit-module'."
|
||
|
|
(interactive)
|
||
|
|
(if racket--loc-stack
|
||
|
|
(pcase (pop racket--loc-stack)
|
||
|
|
(`(,buffer . ,pt)
|
||
|
|
(pop-to-buffer-same-window buffer)
|
||
|
|
(goto-char pt)))
|
||
|
|
(message "Stack empty.")))
|
||
|
|
|
||
|
|
(provide 'racket-visit)
|
||
|
|
|
||
|
|
;; racket-visit.el ends here
|