334 lines
12 KiB
EmacsLisp
334 lines
12 KiB
EmacsLisp
;;; racket-collection.el
|
|
|
|
;; Copyright (c) 2013-2016 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 'ido)
|
|
(require 'tq)
|
|
(require 'racket-repl)
|
|
(require 'racket-complete) ;for `racket--symbol-at-point-or-prompt'
|
|
(require 'racket-custom) ;for `racket-program'
|
|
(require 'racket-util)
|
|
|
|
;;; racket-find-collection
|
|
|
|
(defun racket-find-collection (&optional prefix)
|
|
"Given a collection name, try to find its directory and files.
|
|
|
|
Takes a collection name from point (or, with a prefix, prompts you).
|
|
|
|
If only one directory is found, `ido-find-file-in-dir' lets you
|
|
pick a file there.
|
|
|
|
If more than one directory is found, `ido-completing-read' lets
|
|
you pick one, then `ido-find-file-in-dir' lets you pick a file
|
|
there.
|
|
|
|
Note: This requires the `raco-find-collection' package to be
|
|
installed. To install it, in `shell' enter:
|
|
|
|
raco pkg install raco-find-collection
|
|
|
|
Tip: This works best with `ido-enable-flex-matching' set to t.
|
|
Also handy is the `flx-ido' package from MELPA.
|
|
|
|
See also: `racket-visit-module' and `racket-open-require-path'."
|
|
(interactive "P")
|
|
(pcase (racket--symbol-at-point-or-prompt prefix "Collection name: ")
|
|
(`() nil)
|
|
(coll
|
|
(pcase (racket--cmd/await `(find-collection ,coll))
|
|
(`()
|
|
(user-error (format "Collection `%s' not found" coll)))
|
|
(`(,path)
|
|
(racket--find-file-in-dir path))
|
|
(paths
|
|
(let ((done nil))
|
|
(while (not done)
|
|
;; `(ido-find-file-in-dir (ido-completing-read paths))`
|
|
;; -- except we want to let the user press C-g inside
|
|
;; ido-find-file-in-dir to back up and pick a different
|
|
;; module path.
|
|
(let ((dir (ido-completing-read "Directory: " paths)))
|
|
(condition-case ()
|
|
(progn (racket--find-file-in-dir dir)
|
|
(setq done t))
|
|
(quit nil))))))))))
|
|
|
|
(defun racket--find-file-in-dir (dir)
|
|
"Like `ido-find-file-in-dir', but allows C-d to `dired' as does `ido-find-file'."
|
|
(ido-file-internal ido-default-file-method nil dir))
|
|
|
|
|
|
;;; racket-open-require-path
|
|
|
|
|
|
;; From looking at ido-mode and ido-vertical-mode:
|
|
;;
|
|
;; Just use read-from-minibuffer.
|
|
;;
|
|
;; We're doing vertical mode, so we don't need var like ido-eoinput.
|
|
;; We can simply look for the first \n in the minibuffer -- that's the
|
|
;; end of user input.
|
|
;;
|
|
;; Everything after the input and first \n, is the candiates we
|
|
;; display, \n separated. The minibuffer automatically grows
|
|
;; vertically.
|
|
;;
|
|
;; Have some maximum number of candidates to display (10?). If > 10, print
|
|
;; last line 10 as "...", like ido-vertical-mode.
|
|
;;
|
|
;; Also use a keymap for commands:
|
|
;; - C-n and C-p, which move through the candidates
|
|
;; - ENTER
|
|
;; - on a dir will add its contents to the candidates (like DrR's
|
|
;; "Enter Subsellection" button.
|
|
;; - on a file will exit and open the file.
|
|
;;
|
|
;; Remember that typing a letter triggers `self-insert-command'.
|
|
;; Therefore the pre and post command hooks will run then, too.
|
|
;;
|
|
;; Early version of this used racket--eval/sexpr. Couldn't keep up
|
|
;; with typing. Instead: run dedicated Racket process and more direct
|
|
;; pipe style; the process does a read-line and responds with each
|
|
;; choice on its own line, terminated by a blank like (like HTTP
|
|
;; headers).
|
|
|
|
(defvar racket--orp/tq nil
|
|
"tq queue")
|
|
(defvar racket--orp/active nil ;;FIXME: Use minibuffer-exit-hook instead?
|
|
"Is `racket-open-require-path' using the minibuffer?")
|
|
(defvar racket--orp/input ""
|
|
"The current user input. Unless user C-g's this persists, as with DrR.")
|
|
(defvar racket--orp/matches nil
|
|
"The current user matches. Unless user C-g's this persists, as with DrR.")
|
|
(defvar racket--orp/match-index 0
|
|
"The index of the current match selected by the user.")
|
|
(defvar racket--orp/max-height 10
|
|
"The maximum height of the minibuffer.")
|
|
(defvar racket--orp/keymap
|
|
(racket--easy-keymap-define
|
|
'((("RET" "C-j") racket--orp/enter)
|
|
("C-g" racket--orp/quit)
|
|
(("C-p" "<up>") racket--orp/prev)
|
|
(("C-n" "<down>") racket--orp/next)
|
|
;; Some keys should be no-ops.
|
|
(("SPC" "TAB" "C-v" "<next>" "M-v" "<prior>" "M-<" "<home>" "M->" "<end>")
|
|
racket--orp/nop))))
|
|
|
|
(defun racket--orp/process ()
|
|
"Start process to run find-module-path-completions.rkt.
|
|
|
|
To do so, prefer `make-process' when available (Emacs 25.1+)
|
|
because we can filter stderr. This helps e.g. when Racket core
|
|
developers insert an eprintf in racket/base.rkt or similar -- see
|
|
issue #345."
|
|
(let ((name "racket-find-module-path-completions-process")
|
|
(buffer " *racket-find-module-path-completions*")
|
|
(stderr " *racket-find-module-path-completions-stderr*")
|
|
(rkt (funcall racket-adjust-run-rkt
|
|
(expand-file-name "find-module-path-completions.rkt"
|
|
racket--rkt-source-dir))))
|
|
(if (fboundp 'make-process)
|
|
(make-process :name name
|
|
:buffer buffer
|
|
:command (list racket-program rkt)
|
|
:connection-type 'pipe
|
|
:stderr stderr)
|
|
(let ((process-connection-type nil)) ;use pipe not tty
|
|
(start-process name buffer racket-program rkt)))))
|
|
|
|
(defun racket--orp/begin ()
|
|
(setq racket--orp/tq (tq-create (racket--orp/process))))
|
|
|
|
(defun racket--orp/request-tx-matches (input)
|
|
"Request matches from the Racket process; delivered to `racket--orp/rx-matches'."
|
|
(when racket--orp/tq
|
|
(tq-enqueue racket--orp/tq
|
|
(concat input "\n")
|
|
".*\n\n"
|
|
(current-buffer)
|
|
'racket--orp/rx-matches)))
|
|
|
|
(defun racket--orp/rx-matches (buffer answer)
|
|
"Completion proc; receives answer to request by `racket--orp/request-tx-matches'."
|
|
(when racket--orp/active
|
|
(setq racket--orp/matches (mapcar racket-path-from-racket-to-emacs-function
|
|
(split-string answer "\n" t)))
|
|
(setq racket--orp/match-index 0)
|
|
(with-current-buffer buffer
|
|
(racket--orp/draw-matches))))
|
|
|
|
(defun racket--orp/end ()
|
|
(when racket--orp/tq
|
|
(tq-close racket--orp/tq)
|
|
(setq racket--orp/tq nil)))
|
|
|
|
(defun racket-open-require-path ()
|
|
"Like Dr Racket's Open Require Path.
|
|
|
|
Type (or delete) characters that are part of a module path name.
|
|
\"Fuzzy\" matches appear. For example try typing \"t/t/r\".
|
|
|
|
Choices are displayed in a vertical list. The current choice is
|
|
at the top, marked with \"->\".
|
|
|
|
- C-n and C-p move among the choices.
|
|
- RET on a directory adds its contents to the choices.
|
|
- RET on a file exits doing `find-file'.
|
|
- C-g aborts.
|
|
|
|
Note: This requires Racket 6.1.1.6 or newer. Otherwise it won't
|
|
error, it will just never return any matches."
|
|
(interactive)
|
|
(racket--orp/begin)
|
|
(setq racket--orp/active t)
|
|
(setq racket--orp/match-index 0)
|
|
;; We do NOT initialize `racket--orp/input' or `racket--orp/matches'
|
|
;; here. Like DrR, we remember from last time invoked. We DO
|
|
;; initialize them in racket--orp/quit i.e. user presses C-g.
|
|
(add-hook 'minibuffer-setup-hook #'racket--orp/minibuffer-setup)
|
|
(condition-case ()
|
|
(progn
|
|
(read-from-minibuffer "Open require path: "
|
|
racket--orp/input
|
|
racket--orp/keymap)
|
|
(when racket--orp/matches
|
|
(find-file (elt racket--orp/matches racket--orp/match-index))))
|
|
(error (setq racket--orp/input "")
|
|
(setq racket--orp/matches nil)))
|
|
(setq racket--orp/active nil)
|
|
(racket--orp/end))
|
|
|
|
(defun racket--orp/minibuffer-setup ()
|
|
(add-hook 'pre-command-hook #'racket--orp/pre-command nil t)
|
|
(add-hook 'post-command-hook #'racket--orp/post-command nil t)
|
|
(when racket--orp/active
|
|
(racket--orp/draw-matches)))
|
|
|
|
(defun racket--orp/eoinput ()
|
|
"Return position where user input ends, i.e. the first \n before the
|
|
candidates or (point-max)."
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(condition-case ()
|
|
(1- (re-search-forward "\n"))
|
|
(error (point-max)))))
|
|
|
|
(defun racket--orp/get-user-input ()
|
|
"Get the user's input from the mini-buffer."
|
|
(buffer-substring-no-properties (minibuffer-prompt-end)
|
|
(racket--orp/eoinput)))
|
|
|
|
(defun racket--orp/pre-command ()
|
|
nil)
|
|
|
|
(defun racket--orp/post-command ()
|
|
"Update matches if input changed.
|
|
Also constrain point in case user tried to navigate past
|
|
`racket--orp/eoinput'."
|
|
(when racket--orp/active
|
|
(let ((input (racket--orp/get-user-input)))
|
|
(when (not (string-equal input racket--orp/input))
|
|
(racket--orp/on-input-changed input)))
|
|
(let ((eoi (racket--orp/eoinput)))
|
|
(when (> (point) eoi)
|
|
(goto-char eoi)))))
|
|
|
|
(defun racket--orp/on-input-changed (input)
|
|
(setq racket--orp/input input)
|
|
(cond ((string-equal input "") ;"" => huge list; ignore like DrR
|
|
(setq racket--orp/match-index 0)
|
|
(setq racket--orp/matches nil)
|
|
(racket--orp/draw-matches))
|
|
(t (racket--orp/request-tx-matches input))))
|
|
|
|
(defun racket--orp/draw-matches ()
|
|
(save-excursion
|
|
(let* ((inhibit-read-only t)
|
|
(eoi (racket--orp/eoinput))
|
|
(len (length racket--orp/matches))
|
|
(n (min racket--orp/max-height len))
|
|
(i racket--orp/match-index))
|
|
(delete-region eoi (point-max)) ;delete existing
|
|
(while (> n 0)
|
|
(insert "\n")
|
|
(cond ((= i racket--orp/match-index) (insert "-> "))
|
|
(t (insert " ")))
|
|
(insert (elt racket--orp/matches i))
|
|
(setq n (1- n))
|
|
(cond ((< (1+ i) len) (setq i (1+ i)))
|
|
(t (setq i 0))))
|
|
(when (< racket--orp/max-height len)
|
|
(insert "\n ..."))
|
|
(put-text-property eoi (point-max) 'read-only 'fence))))
|
|
|
|
(defun racket--orp/enter ()
|
|
"On a dir, adds its contents to choices. On a file, opens the file."
|
|
(interactive)
|
|
(when racket--orp/active
|
|
(let ((match (and racket--orp/matches
|
|
(elt racket--orp/matches racket--orp/match-index))))
|
|
(cond (;; Pressing RET on a directory inserts its contents, like
|
|
;; "Enter subcollection" button in DrR.
|
|
(and match (file-directory-p match))
|
|
(setq racket--orp/matches
|
|
(delete-dups ;if they RET same item more than once
|
|
(sort (append racket--orp/matches
|
|
(directory-files match t "[^.]+$"))
|
|
#'string-lessp)))
|
|
(racket--orp/draw-matches))
|
|
(;; Pressing ENTER on a file selects it. We exit the
|
|
;; minibuffer; our main function treats non-nil
|
|
;; racket--orp/matches and racket--orp/match-index as a
|
|
;; choice (as opposed to quitting w/o a choice.
|
|
t
|
|
(exit-minibuffer))))))
|
|
|
|
(defun racket--orp/quit ()
|
|
"Our replacement for `keyboard-quit'."
|
|
(interactive)
|
|
(when racket--orp/active
|
|
(setq racket--orp/input "")
|
|
(setq racket--orp/matches nil)
|
|
(exit-minibuffer)))
|
|
|
|
(defun racket--orp/next ()
|
|
"Select the next match."
|
|
(interactive)
|
|
(when racket--orp/active
|
|
(setq racket--orp/match-index (1+ racket--orp/match-index))
|
|
(when (>= racket--orp/match-index (length racket--orp/matches))
|
|
(setq racket--orp/match-index 0))
|
|
(racket--orp/draw-matches)))
|
|
|
|
(defun racket--orp/prev ()
|
|
"Select the previous match."
|
|
(interactive)
|
|
(when racket--orp/active
|
|
(setq racket--orp/match-index (1- racket--orp/match-index))
|
|
(when (< racket--orp/match-index 0)
|
|
(setq racket--orp/match-index (max 0 (1- (length racket--orp/matches)))))
|
|
(racket--orp/draw-matches)))
|
|
|
|
(defun racket--orp/nop ()
|
|
"A do-nothing command target."
|
|
(interactive)
|
|
nil)
|
|
|
|
(provide 'racket-collection)
|
|
|
|
;; racket-collection.el ends here
|