335 lines
12 KiB
EmacsLisp
335 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
|