Skip to content

Commit

Permalink
Add racket-insert-symbol command
Browse files Browse the repository at this point in the history
I'd made something similar while exploring using abbrev-mode instead
of an input method, and liked it, so "porting" it to this branch.
  • Loading branch information
greghendershott committed Oct 15, 2024
1 parent 700f7ea commit a3dacb9
Show file tree
Hide file tree
Showing 2 changed files with 86 additions and 1 deletion.
80 changes: 79 additions & 1 deletion racket-input.el
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,9 @@

(require 'quail)
(require 'cl-lib)
(require 'racket-complete)
(require 'racket-util)

;; Quail is quite stateful, so be careful when editing this code. Note
;; that with-temp-buffer is used below whenever buffer-local state is
;; modified.
Expand Down Expand Up @@ -521,7 +524,11 @@ Suitable for use in the :set field of `defcustom'."
;; Set up the input method.
(racket-input-setup)

;;; Convenience minor mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; Some conveniences in the original agda input method

;;; Minor mode

(define-minor-mode racket-input-mode
"A minor mode to enable the Racket input method.
Expand Down Expand Up @@ -573,6 +580,77 @@ can turn it off by setting `input-method-highlight-flag' to nil."
#'racket-input-mode
"2024-10-15")

;;; Command using completing-read

(defun racket-insert-symbol ()
"A command alternative to the \"Racket\" input method.
Presents `completing-read' UI to choose and insert from
`racket-input-translations' and `racket-input-user-translations'.
When there is a symbol `thing-at-point', that is the initial
input to `completing-read'. When that exactly matches the chosen
symbol name, the name is deleted from the buffer, as well as
inserting the symbol."
(interactive)
(pcase (racket--bounds-of-thing-at-point 'symbol)
(`(,beg . ,end)
(let ((thing (buffer-substring-no-properties beg end)))
(pcase (racket--choose-symbol thing)
(`(,key . ,str)
(when (string-equal key thing)
(delete-region beg end))
(insert str)))))
(_ (pcase (racket--choose-symbol)
(`(,_key . ,str)
(insert str))))))

(defun racket--choose-symbol (&optional initial-input)
"Caveat: When a translation has multiple choices for a key,
ignores all but the first one."
(let* ((translations ;make alist with single, string value
(seq-map (pcase-lambda (`(,k . ,v))
(cons k
(cond
((characterp v) (make-string 1 v))
((stringp v) v)
((sequencep v)
(let ((v (seq-elt v 0)))
(cond
((characterp v) (make-string 1 v))
((stringp v) v))))
(t ""))))
(append racket-input-user-translations
racket-input-translations)))
(collection
(racket--completion-table
translations
`((category . racket-symbol-name)
(affixation-function . ,(racket--input-make-affixator translations)))))
(predicate nil)
(require-match t))
(when-let (str (completing-read "Symbol: "
collection
predicate
require-match
initial-input))
(assoc str translations))))

(defun racket--input-make-affixator (translations)
(lambda (strs)
(let ((max-len 16))
(dolist (str strs)
(setq max-len (max max-len (1+ (length str)))))
(seq-map (lambda (str)
(let ((v (cdr (assoc str translations))))
(list str
""
(concat
(make-string (- max-len (length str)) 32)
(propertize v 'face 'bold)))))
strs))))


(provide 'racket-input)

;;; racket-input.el ends here
7 changes: 7 additions & 0 deletions racket-util.el
Original file line number Diff line number Diff line change
Expand Up @@ -171,6 +171,13 @@ s-expressions."
(thing-at-point thing no-properties))
(thing-at-point thing no-properties)))

(defun racket--bounds-of-thing-at-point (thing)
(if-let (pos (racket--menu-position))
(save-excursion
(goto-char pos)
(bounds-of-thing-at-point thing))
(bounds-of-thing-at-point thing)))

(defun racket--symbol-at-point-or-prompt (force-prompt-p
prompt
&optional
Expand Down

0 comments on commit a3dacb9

Please sign in to comment.