├── .github └── PULL_REQUEST_TEMPLATE.md ├── .gitignore ├── .travis.yml ├── Makefile ├── README.org ├── frog-menu.el ├── images ├── spellcheck.png └── spellcheck2.png ├── stub ├── .nosearch ├── avy.el └── posframe.el └── test └── frog-menu-test.el /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | This package is subject to the [Copyright Assignment](https://www.gnu.org/prep/maintain/html_node/Copyright-Papers.html) 2 | policy of [GNU ELPA](https://elpa.gnu.org/packages/) packages. 3 | 4 | If your changes are not 5 | [significant](https://www.gnu.org/prep/maintain/html_node/Legally-Significant.html#Legally-Significant) 6 | (below 15 lines) I can add your changes without assignment. If your contribution 7 | is bigger than 15 lines and you don't want to assign you should still open a PR 8 | and I will consider adding the changes myself. 9 | 10 | The assignment is applicable for all projects related to Emacs. It basically 11 | transfers copyright of your submitted changes to the FSF. That way they can 12 | enforce [Copyleft](https://www.gnu.org/copyleft/). 13 | 14 | The assignment process is very easy and can often be handled via email. 15 | 16 | Please see [the request form](https://git.savannah.gnu.org/cgit/gnulib.git/tree/doc/Copyright/request-assign.future) 17 | if you want to do the assignment (use Emacs for the name of the program you want to contribute to). 18 | 19 | Confirm with `x` if applicable: 20 | 21 | - [ ] I have signed the copyright paperwork for contributing to GNU Emacs. 22 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | *-pkg.el 3 | *-autoloads.el 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: trusty 2 | sudo: required 3 | # addons: 4 | # apt: 5 | # packages: 6 | # - texinfo 7 | env: 8 | - EMACS_VERSION=26.1-travis 9 | # - EMACS_VERSION=git-snapshot 10 | # matrix: 11 | # allow_failures: 12 | # - env: EMACS_VERSION=git-snapshot 13 | install: 14 | - git clone https://github.com/purcell/package-lint.git ~/package-lint 15 | - git clone --depth 1 https://github.com/rejeep/evm.git ~/.evm 16 | - export PATH="$HOME/.evm/bin:$PATH" 17 | - evm config path /tmp 18 | - evm install "emacs-$EMACS_VERSION" 19 | - export PATH="/tmp/emacs-$EMACS_VERSION/bin:$PATH" 20 | - emacs --version 21 | script: 22 | - make 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | 3 | package_files := $(wildcard *.el) 4 | test_files := $(wildcard test/*.el) 5 | package_lint := ~/package-lint/package-lint.el 6 | 7 | .PHONY: all 8 | all: compile checkdoc lint test itest 9 | 10 | .PHONY: compile 11 | compile: 12 | @for file in $(package_files); do \ 13 | echo "[compile] $$file" ;\ 14 | $(EMACS) -Q --batch -L . -L stub \ 15 | --eval "(setq byte-compile-error-on-warn t)"\ 16 | -f batch-byte-compile $$file;\ 17 | done 18 | 19 | .PHONY: checkdoc 20 | checkdoc: 21 | @for file in $(package_files); do \ 22 | echo "[checkdoc] $$file" ;\ 23 | $(EMACS) -Q --batch \ 24 | --eval "(setq sentence-end-double-space nil)" \ 25 | --eval "(checkdoc-file \"$$file\")" \ 26 | --eval "(when (get-buffer \"*Warnings*\") (kill-emacs 1))" ;\ 27 | done 28 | 29 | .PHONY: lint 30 | lint: 31 | @for file in $(package_files); do \ 32 | echo "[package-lint] $$file" ;\ 33 | $(EMACS) -Q --batch \ 34 | -l $(package_lint) \ 35 | --eval "(defalias 'package-lint--check-packages-installable #'ignore)" \ 36 | -f package-lint-batch-and-exit $$file ;\ 37 | done 38 | 39 | .PHONY: test 40 | test: 41 | @for file in $(test_files); do \ 42 | echo "[ert-test] $$file" ;\ 43 | $(EMACS) -Q --batch -L . -L stub \ 44 | -l $$file \ 45 | -f ert-run-tests-batch-and-exit ;\ 46 | done 47 | 48 | .PHONY: itest 49 | itest: 50 | @if emacsclient -a false -e 't' 1>/dev/null 2>/dev/null; then \ 51 | echo "[interactive-test]" ;\ 52 | emacsclient --eval "(load-file \"test/frog-menu-test.el\")" ;\ 53 | fi 54 | 55 | .PHONY: clean 56 | clean: 57 | @echo "[clean]" *.elc 58 | @rm -f *.elc 59 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+BEGIN_HTML 2 |

3 | GNU ELPA 4 | Travis CI 5 |

6 | #+END_HTML 7 | 8 | 9 | * Description 10 | 11 | This package lets you quickly pick strings from ad hoc menus. Just like a frog 12 | would catch a fly. The menu is built "on the fly" from a collection of 13 | strings. It's presented to the user to choose one of them by pressing a single 14 | key. One example where this kind of menu is useful are spelling correction 15 | suggestions: 16 | 17 | [[./images/spellcheck.png]] 18 | 19 | The user can specify a prompt and additional action keys as you can see in the 20 | bottom of the menu. Usage in the terminal is also supported: 21 | 22 | [[./images/spellcheck2.png]] 23 | 24 | 25 | Inspired by [[https://github.com/mrkkrp/ace-popup-menu][ace-popup-menu]]. 26 | 27 | * Example 28 | 29 | To invoke the menu users can call =frog-menu-read=. How items are displayed 30 | and choosen depends on =frog-menu-type=. For graphical displays the type 31 | =avy-posframe= uses [[https://github.com/abo-abo/avy][avy]] and [[https://github.com/tumashu/posframe][posframe]]. In terminals the type =avy-side-window= 32 | is used. The implemented handler functions can be used as reference if you 33 | want to define your own =frog-menu-type=. 34 | 35 | Here is an example how you would invoke a frog menu: 36 | 37 | #+begin_src elisp 38 | (frog-menu-read "Choose a string" 39 | '("a" "list" "of strings")) 40 | #+end_src 41 | 42 | It is also possible to define additional action keys (as shown in the 43 | screenshot). Here is an example how you could use =frog-menu-read= to 44 | implement a [[https://github.com/d12frosted/flyspell-correct][flyspell-correct-interface]]: 45 | 46 | #+begin_src elisp 47 | (require 'flyspell-correct) 48 | 49 | (defun frog-menu-flyspell-correct (candidates word) 50 | "Run `frog-menu-read' for the given CANDIDATES. 51 | 52 | List of CANDIDATES is given by flyspell for the WORD. 53 | 54 | Return selected word to use as a replacement or a tuple 55 | of (command . word) to be used by `flyspell-do-correct'." 56 | (let* ((corrects (if flyspell-sort-corrections 57 | (sort candidates 'string<) 58 | candidates)) 59 | (actions `(("C-s" "Save word" (save . ,word)) 60 | ("C-a" "Accept (session)" (session . ,word)) 61 | ("C-b" "Accept (buffer)" (buffer . ,word)) 62 | ("C-c" "Skip" (skip . ,word)))) 63 | (prompt (format "Dictionary: [%s]" (or ispell-local-dictionary 64 | ispell-dictionary 65 | "default"))) 66 | (res (frog-menu-read prompt corrects actions))) 67 | (unless res 68 | (error "Quit")) 69 | res)) 70 | 71 | (setq flyspell-correct-interface #'frog-menu-flyspell-correct) 72 | #+end_src 73 | 74 | Afterwards calling =M-x flyspell-correct-wrapper= will prompt you with a 75 | =frog-menu=. 76 | 77 | And here is yet another example I use to navigate the menubar: 78 | 79 | #+begin_src elisp 80 | (require 'tmm) 81 | 82 | (defun tmm-init-km-list+ (menu) 83 | (setq tmm-km-list nil) 84 | (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu) 85 | (setq tmm-km-list (nreverse tmm-km-list)) 86 | ;; filter unenabled items 87 | (setq tmm-km-list 88 | (cl-remove-if 89 | (lambda (item) 90 | (eq (cddr item) 'ignore)) tmm-km-list))) 91 | 92 | (defun frog-tmm-prompt (menu &optional entry) 93 | "Adapted from `counsel-tmm-prompt'." 94 | (let (out 95 | choice 96 | chosen-string) 97 | (setq tmm-km-list (tmm-init-km-list+ menu)) 98 | (setq out (or entry (frog-menu-read "Menu: " (mapcar #'car tmm-km-list)))) 99 | (setq choice (cdr (assoc out tmm-km-list))) 100 | (setq chosen-string (car choice)) 101 | (setq choice (cdr choice)) 102 | (cond ((keymapp choice) 103 | (frog-tmm-prompt choice)) 104 | ((and choice chosen-string) 105 | (setq last-command-event chosen-string) 106 | (call-interactively choice))))) 107 | 108 | (defun frog-tmm (&optional entry) 109 | "Adapted from `counsel-tmm'." 110 | (interactive) 111 | (run-hooks 'menu-bar-update-hook) 112 | (setq tmm-table-undef nil) 113 | (frog-tmm-prompt (tmm-get-keybind [menu-bar]) entry)) 114 | 115 | (defun frog-tmm-mode () 116 | "Adapted from `counsel-tmm'." 117 | (interactive) 118 | (frog-tmm mode-name)) 119 | #+end_src 120 | -------------------------------------------------------------------------------- /frog-menu.el: -------------------------------------------------------------------------------- 1 | ;;; frog-menu.el --- Quickly pick items from ad hoc menus -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2019 Free Software Foundation, Inc. 4 | 5 | ;; Author: Clemens Radermacher 6 | ;; URL: https://github.com/clemera/frog-menu 7 | ;; Version: 0.2.11 8 | ;; Package-Requires: ((emacs "26") (avy "0.4") (posframe "0.4")) 9 | ;; Keywords: convenience 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;; 26 | ;; This package lets you quickly pick strings from ad hoc menus. Just like a 27 | ;; frog would catch a fly. The menu is built "on the fly" from a collection of 28 | ;; strings. It's presented to the user to choose one of them. One example 29 | ;; where this kind of menu is useful are spelling correction suggestions. 30 | ;; 31 | ;; To invoke the menu users can call `frog-menu-read'. How items are displayed 32 | ;; and chosen depends on `frog-menu-type'. The default type `avy-posframe' 33 | ;; uses `avy' and `posframe'. Their handler functions can be used as reference 34 | ;; if you want to define a new `frog-menu-type'. 35 | ;; 36 | ;; Here is an example how you would use `frog-menu-read' to implement a 37 | ;; `flyspell-correct-interface': 38 | ;; 39 | ;; (defun frog-menu-flyspell-correct (candidates word) 40 | ;; "Run `frog-menu-read' for the given CANDIDATES. 41 | ;; 42 | ;; List of CANDIDATES is given by flyspell for the WORD. 43 | ;; 44 | ;; Return selected word to use as a replacement or a tuple 45 | ;; of (command . word) to be used by `flyspell-do-correct'." 46 | ;; (let* ((corrects (if flyspell-sort-corrections 47 | ;; (sort candidates 'string<) 48 | ;; candidates)) 49 | ;; (actions `(("C-s" "Save word" (save . ,word)) 50 | ;; ("C-a" "Accept (session)" (session . ,word)) 51 | ;; ("C-b" "Accept (buffer)" (buffer . ,word)) 52 | ;; ("C-c" "Skip" (skip . ,word)))) 53 | ;; (prompt (format "Dictionary: [%s]" (or ispell-local-dictionary 54 | ;; ispell-dictionary 55 | ;; "default"))) 56 | ;; (res (frog-menu-read prompt corrects actions))) 57 | ;; (unless res 58 | ;; (error "Quit")) 59 | ;; res)) 60 | ;; 61 | ;; (setq flyspell-correct-interface #'frog-menu-flyspell-correct) 62 | ;; 63 | ;;; Code: 64 | 65 | (require 'avy) 66 | (require 'posframe) 67 | (eval-when-compile 68 | (require 'subr-x)) 69 | 70 | (defgroup frog-menu nil 71 | "Quickly pick items from ad hoc menus." 72 | :group 'convenience 73 | :prefix "frog-menu-") 74 | 75 | (defvar frog-menu-type nil 76 | "Type of menu to use. 77 | 78 | By default types `avy-posframe' and `avy-side-window' are possible. 79 | 80 | When using a new menu type, handlers need to be added for 81 | 82 | `frog-menu-init-handler-alist' 83 | 84 | `frog-menu-display-handler-alist' 85 | 86 | `frog-menu-display-option-alist' 87 | 88 | `frog-menu-query-handler-alist' 89 | 90 | and optionally to 91 | 92 | `frog-menu-cleanup-handler-alist'.") 93 | 94 | (defcustom frog-menu-type-function #'frog-menu-type 95 | "Function which should return the variable `frog-menu-type' to be used. 96 | 97 | See variable `frog-menu-type'" 98 | :type 'function) 99 | 100 | (defcustom frog-menu-after-init-hook '() 101 | "Frog menu init hook. 102 | 103 | Runs after menu buffer is initialized by its init handler. The 104 | menu buffer is set current when this hook runs." 105 | :type '(repeat function)) 106 | 107 | (defcustom frog-menu-init-handler-alist 108 | '((avy-posframe . frog-menu-init-display-buffer) 109 | (avy-side-window . frog-menu-init-display-buffer)) 110 | "Maps variable `frog-menu-type' to an init handler. 111 | 112 | The init handler is called with the prompt, strings formatted by 113 | `frog-menu-format-strings-function' actions formatted by 114 | `frog-menu-format-actions-function'. It should initialize the 115 | display buffer (which is current when called). After init the 116 | hook `frog-menu-after-init-hook' gets executed." 117 | :type '(alist :key-type symbol 118 | :value-type function)) 119 | 120 | (defcustom frog-menu-display-handler-alist 121 | '((avy-posframe . frog-menu-display-posframe) 122 | (avy-side-window . frog-menu-display-side-window)) 123 | "Maps variable `frog-menu-type' to a display handler. 124 | 125 | The display handler receives the buffer to display as an argument 126 | and should return the window of the displayed buffer." 127 | :type '(alist :key-type symbol 128 | :value-type function)) 129 | 130 | (defcustom frog-menu-display-option-alist 131 | '((avy-posframe . posframe-poshandler-point-bottom-left-corner) 132 | (avy-side-window . (display-buffer-in-side-window (side . bottom)))) 133 | "Maps variable `frog-menu-type' to a display option. 134 | 135 | The display option is passed to the display handler as second argument." 136 | :type '(alist :key-type symbol 137 | :value-type function)) 138 | 139 | (defcustom frog-menu-query-handler-alist 140 | '((avy-posframe . frog-menu-query-with-avy) 141 | (avy-side-window . frog-menu-query-with-avy)) 142 | "Maps variable `frog-menu-type' to a query handler. 143 | 144 | The query handler receives four arguments. 145 | 146 | The first is the displayed buffer. The second the window where 147 | the buffer is displayed. The last one is the actions argument 148 | passed to `frog-menu-read'. 149 | 150 | This function should return the chosen string or action return 151 | value. If the user exited the query return nil." 152 | :type '(alist :key-type symbol 153 | :value-type function)) 154 | 155 | (defcustom frog-menu-cleanup-handler-alist 156 | '((avy-posframe . frog-menu-posframe-hide) 157 | (avy-side-window . frog-menu-side-window-hide)) 158 | "Maps variable `frog-menu-type' to a cleanup handler. 159 | 160 | The cleanup handler receives the displayed buffer and the window 161 | as arguments and is called after the query handler returns or 162 | exits through an error." 163 | :type '(alist :key-type symbol 164 | :value-type function)) 165 | 166 | (defcustom frog-menu-avy-padding nil 167 | "If non-nil use padding between avy hints and candidates." 168 | :type 'boolean) 169 | 170 | (defcustom frog-menu-posframe-border-width 1 171 | "Border width to use for the posframe `frog-menu' creates." 172 | :type 'integer) 173 | 174 | (defcustom frog-menu-posframe-parameters nil 175 | "Explicit frame parameters to be used by the posframe `frog-menu' creates." 176 | :type 'list) 177 | 178 | (defcustom frog-menu-format-actions-function #'frog-menu-action-format 179 | "Function used to format the actions passed to `frog-menu-read'." 180 | :type 'function) 181 | 182 | (defcustom frog-menu-format-strings-function #'frog-menu-grid-format 183 | "Function used to format the strings passed to `frog-menu-read'." 184 | :type 'function) 185 | 186 | (defcustom frog-menu-min-col-padding 2 187 | "Minimal padding between columns of grid." 188 | :type 'integer) 189 | 190 | (defcustom frog-menu-grid-width-function 191 | (lambda () (cond ((eq (funcall frog-menu-type-function) 'avy-posframe) 192 | (/ (frame-width) 2)) 193 | ((eq (funcall frog-menu-type-function) 'avy-side-window) 194 | (* 2 (/ (frame-width) 3))) 195 | (t (frame-width)))) 196 | "Returns the width that should be used for menu grid. 197 | 198 | Used by `frog-menu-grid-format'." 199 | :type 'function) 200 | 201 | (defcustom frog-menu-grid-column-function 202 | (lambda () 203 | (/ (funcall frog-menu-grid-width-function) 204 | 8)) 205 | "Returns the number of columns for the menu grid. 206 | 207 | Less columns are used automatically if the grid width is not big 208 | enough to contain that many columns. 209 | 210 | Used by `frog-menu-grid-format' and `frog-menu-action-format'." 211 | :type 'function) 212 | 213 | (defcustom frog-menu-avy-keys (append (string-to-list "asdflkjgh") 214 | (string-to-list "qwerpoiuty") 215 | (string-to-list "zxcvmnb") 216 | (string-to-list (upcase "asdflkjgh")) 217 | (string-to-list (upcase "qwerpoiuty")) 218 | (string-to-list (upcase "zxcvmnb")) 219 | (number-sequence ?, ?@)) 220 | "Frog menu keys used for `avy-keys'. 221 | 222 | By default uses a large collection of keys, so that the hints can 223 | be drawn by single characters." 224 | :type '(repeat character)) 225 | 226 | (defvar frog-menu-sort-function nil 227 | "A function to sort displayed strings for `frog-menu-read'. 228 | 229 | If this variable is bound to a function `frog-menu-read' will 230 | pass the strings to be displayed and the function to `sort': 231 | 232 | (let ((frog-menu-sort-function #'string<)) 233 | (frog-menu-read \"Example\" '(\"z\" \"a\")))") 234 | 235 | (defvar frog-menu-format completions-format 236 | "Defines in which order strings for `frog-menu-read' are displayed. 237 | 238 | If the value is `vertical', strings are ordered vertically. If 239 | the value is `horizontal', strings are ordered horizontally. This 240 | variable does not define sorting, see `frog-menu-sort-function' 241 | for this.") 242 | 243 | (defface frog-menu-border '((((background dark)) . (:background "white")) 244 | (((background light)) . (:background "black"))) 245 | "The face defining the border for the posframe.") 246 | 247 | (defface frog-menu-prompt-face 248 | '((t (:inherit default))) 249 | "Face used for menu promp") 250 | 251 | (defface frog-menu-candidates-face 252 | '((t (:inherit default))) 253 | "Face used for menu candidates.") 254 | 255 | (defface frog-menu-actions-face 256 | '((t (:inherit default))) 257 | "Face used for menu actions.") 258 | 259 | (defface frog-menu-action-keybinding-face 260 | '((t (:inherit default))) 261 | "Face used for menu action keybindings.") 262 | 263 | (defface frog-menu-posframe-background-face 264 | '((t :background "old lace")) 265 | "Face used for the background color of the posframe.") 266 | 267 | (defvar frog-menu--buffer " *frog-menu-menu*" 268 | "Buffer used for the frog menu.") 269 | 270 | (defun frog-menu-type () 271 | "Return variable `frog-menu-type' to use." 272 | (cond ((display-graphic-p) 273 | 'avy-posframe) 274 | (t 275 | 'avy-side-window))) 276 | 277 | 278 | ;; * Init 279 | 280 | (defun frog-menu--init-buffer (buffer prompt strings actions) 281 | "Initialize the menu BUFFER and return it. 282 | 283 | PROMPT, STRINGS and ACTIONS are the args from `frog-menu-read'." 284 | (with-current-buffer buffer 285 | (erase-buffer) 286 | (let ((formats (and strings 287 | (funcall frog-menu-format-strings-function 288 | strings))) 289 | (formata (and actions 290 | (funcall frog-menu-format-actions-function 291 | actions)))) 292 | (funcall (cdr (assq frog-menu-type 293 | frog-menu-init-handler-alist)) 294 | prompt 295 | formats 296 | formata) 297 | (run-hooks 'frog-menu-after-init-hook) 298 | buffer))) 299 | 300 | (defun frog-menu-posframe-hide (buf _window) 301 | "Hide the posframe buffer BUF." 302 | (posframe-hide buf)) 303 | 304 | (defun frog-menu-side-window-hide (_buf window) 305 | "Hide the BUF side window WINDOW." 306 | (delete-window window)) 307 | 308 | 309 | (defun frog-menu-init-display-buffer (prompt 310 | formatted-strings 311 | formatted-actions) 312 | "Init handler for avy-posframe. 313 | 314 | PROMPT, FORMATTED-STRINGS and FORMATTED-ACTIONS are the args from 315 | `frog-menu-read'. 316 | 317 | Fills the buffer with a grid of FORMATTED-STRINGS followed by PROMPT and 318 | ACTIONS." 319 | (when formatted-strings 320 | (insert formatted-strings)) 321 | (unless (string-empty-p prompt) 322 | (when formatted-strings 323 | (insert "\n\n")) 324 | (add-text-properties 325 | (point) 326 | (progn 327 | (insert prompt) 328 | (point)) 329 | '(face frog-menu-prompt-face)) 330 | (insert "\n")) 331 | (when formatted-actions 332 | (when (and formatted-strings 333 | (string-empty-p prompt)) 334 | (insert "\n\n")) 335 | (insert formatted-actions)) 336 | ;; posframe needs point at start, 337 | ;; otherwise it fails on first init 338 | (goto-char (point-min))) 339 | 340 | 341 | ;; * Formatting 342 | 343 | (defun frog-menu-grid-format (strings) 344 | "Format STRINGS to a grid." 345 | (frog-menu--grid-format 346 | (mapcar (lambda (str) 347 | (concat (propertize 348 | "_" 349 | 'face (list :foreground 350 | (if (eq (funcall frog-menu-type-function) 351 | 'avy-posframe) 352 | (face-background 353 | 'frog-menu-posframe-background-face nil t) 354 | (face-background 'default)))) 355 | (if frog-menu-avy-padding " " "") 356 | str)) strings) 357 | (funcall frog-menu-grid-column-function) 358 | (funcall frog-menu-grid-width-function))) 359 | 360 | (defun frog-menu-action-format (actions) 361 | "Format ACTIONS for menu display." 362 | (when actions 363 | (with-temp-buffer 364 | (let ((header-pos (point))) 365 | (dolist (action actions) 366 | (add-text-properties 367 | (point) 368 | (progn 369 | (insert (car action)) 370 | (point)) 371 | '(face frog-menu-action-keybinding-face)) 372 | (add-text-properties 373 | (point) 374 | (progn 375 | (insert "_" 376 | (replace-regexp-in-string " " "_" 377 | (cadr action)) 378 | " ") 379 | (point)) 380 | '(face frog-menu-actions-face))) 381 | (insert "\n") 382 | (let ((fill-column (1+ (funcall frog-menu-grid-width-function)))) 383 | (fill-region header-pos (point)) 384 | (align-regexp header-pos (point) "\\(\\s-*\\) " 1 1 nil) 385 | (while (re-search-backward "_" header-pos t) 386 | (replace-match " ")))) 387 | (buffer-string)))) 388 | 389 | ;; Taken partly from `completion--insert-strings' 390 | (defun frog-menu--grid-format (strings cols &optional width) 391 | "Return grid string built with STRINGS. 392 | 393 | The grid will be segmented into columns. COLS is the maximum 394 | number of columns to use. The columns have WIDTH space in 395 | horizontal direction which default to frame width. 396 | 397 | Returns the formatted grid string." 398 | (with-temp-buffer 399 | (let* ((length (apply #'max 400 | (mapcar #'string-width strings))) 401 | (wwidth (or width (frame-width))) 402 | (columns (max 1 (min cols 403 | (/ wwidth 404 | (+ frog-menu-min-col-padding length))))) 405 | (colwidth (/ wwidth columns)) 406 | (column 0) 407 | (first t) 408 | (rows (/ (length strings) columns)) 409 | (row 0)) 410 | (dolist (str strings) 411 | (let ((length (string-width str))) 412 | (cond ((eq frog-menu-format 'vertical) 413 | ;; Vertical format 414 | (when (> row rows) 415 | (forward-line (- -1 rows)) 416 | (setq row 0 column (+ column colwidth))) 417 | (when (> column 0) 418 | (end-of-line) 419 | (while (> (current-column) column) 420 | (if (eobp) 421 | (insert "\n") 422 | (forward-line 1) 423 | (end-of-line))) 424 | (insert " \t") 425 | (set-text-properties (1- (point)) (point) 426 | `(display (space :align-to ,column)))) 427 | 428 | (add-text-properties (point) 429 | (progn (insert str) 430 | (point)) 431 | '(face frog-menu-candidates-face)) 432 | 433 | (if (> column 0) 434 | (forward-line) 435 | (insert "\n")) 436 | (setq row (1+ row))) 437 | (t 438 | ;; horizontal 439 | (unless first 440 | (if (or (< wwidth (+ (max colwidth length) column)) 441 | (zerop length)) 442 | (progn 443 | (insert "\n" (if (zerop length) "\n" "")) 444 | (setq column 0)) 445 | (insert " \t") 446 | (set-text-properties 447 | (1- (point)) 448 | (point) 449 | `(display (space :align-to ,column))))) 450 | (setq first (zerop length)) 451 | (add-text-properties (point) 452 | (progn (insert str) 453 | (point)) 454 | '(face frog-menu-candidates-face)) 455 | (setq column (+ column 456 | (* colwidth (ceiling length colwidth)))))))) 457 | (buffer-string)))) 458 | 459 | 460 | ;; * Display 461 | 462 | (defun frog-menu-display-posframe (buf &optional display-option) 463 | "Display posframe showing buffer BUF. 464 | 465 | If given, DISPLAY-OPTION is passed as :poshandler to 466 | `posframe-show'. 467 | 468 | Returns window of displayed buffer." 469 | (posframe-show buf 470 | :poshandler(or display-option 471 | #'posframe-poshandler-point-bottom-left-corner) 472 | :internal-border-width frog-menu-posframe-border-width 473 | :background-color (face-attribute 474 | 'frog-menu-posframe-background-face 475 | :background) 476 | :override-parameters frog-menu-posframe-parameters) 477 | (set-face-attribute 'internal-border 478 | (buffer-local-value 'posframe--frame buf) 479 | :inherit 'frog-menu-border) 480 | (frame-selected-window 481 | (buffer-local-value 'posframe--frame buf))) 482 | 483 | (defun frog-menu-display-side-window (buf &optional display-option) 484 | "Display posframe showing buffer BUF. 485 | 486 | If given DISPLAY-OPTION is passed as action argument to 487 | `display-buffer'. 488 | 489 | Returns window of displayed buffer." 490 | (let ((window (display-buffer 491 | buf 492 | (or display-option 493 | '(display-buffer-in-side-window (side . bottom)))))) 494 | (prog1 window 495 | (with-selected-window window 496 | (with-current-buffer buf 497 | ;; see transient/lv 498 | (set-window-hscroll window 0) 499 | (set-window-dedicated-p window t) 500 | (set-window-parameter window 'no-other-window t) 501 | (setq window-size-fixed t) 502 | (setq cursor-type nil) 503 | (setq display-line-numbers nil) 504 | (setq show-trailing-whitespace nil) 505 | (setq mode-line-format nil) 506 | (let ((window-resize-pixelwise t) 507 | (window-size-fixed nil)) 508 | (fit-window-to-buffer nil nil 1)) 509 | (goto-char (point-min))))))) 510 | 511 | 512 | (defun frog-menu--get-avy-candidates (&optional b w start end) 513 | "Return candidates to be passed to `avy-process'. 514 | 515 | B is the buffer of the candidates and defaults to the current 516 | one. W is the window where the candidates can be found and 517 | defaults to the currently selected one. START and END are the 518 | buffer positions containing the candidates and default to 519 | ‘point-min’ and ‘point-max’." 520 | (let ((w (or w (selected-window))) 521 | (b (or b (current-buffer))) 522 | (candidates ())) 523 | (with-current-buffer b 524 | (let ((start (or start (point-min))) 525 | (end (or end (point-max)))) 526 | (save-excursion 527 | (save-restriction 528 | (narrow-to-region start end) 529 | (goto-char (point-min)) 530 | (when (eq (get-char-property (point) 'face) 531 | 'frog-menu-candidates-face) 532 | (push (cons (point) w) candidates)) 533 | (goto-char 534 | (or (next-single-property-change 535 | (point) 'face) 536 | (point-max))) 537 | (while (< (point) (point-max)) 538 | (unless (or (looking-at "[[:blank:]\r\n]\\|\\'") 539 | (not (eq (get-char-property (point) 'face) 540 | 'frog-menu-candidates-face))) 541 | 542 | (push (cons (point) w) 543 | candidates)) 544 | (goto-char 545 | (or (next-single-property-change 546 | (point) 547 | 'face) 548 | (point-max)))))))) 549 | (nreverse candidates))) 550 | 551 | ;; * Query handler functions 552 | 553 | (defvar frog-menu--avy-action-map nil 554 | "Internal keymap saving the actions for the avy handler.") 555 | 556 | (defun frog-menu--posframe-ace-handler (char) 557 | "Execute menu action for CHAR." 558 | (cond ((memq char '(?\e ?\C-g)) 559 | ;; exit silently 560 | (throw 'done 'exit)) 561 | ((mouse-event-p char) 562 | (signal 'user-error (list "Mouse event not handled" char))) 563 | (t 564 | (let* ((key (kbd (key-description (vector char)))) 565 | (f (lookup-key frog-menu--avy-action-map key))) 566 | (if (functionp f) 567 | (throw 'done (list f)) 568 | (message "No such candidate, hit `C-g' to quit.") 569 | (throw 'done 'restart)))))) 570 | 571 | (defun frog-menu--init-avy-action-map (actions) 572 | "Initialize `frog-menu--action-map'. 573 | 574 | Each action of ACTIONS is bound to a command which returns the 575 | action result. ACTIONS is the argument of `frog-menu-read'." 576 | (setq frog-menu--avy-action-map (make-sparse-keymap)) 577 | (dolist (action actions) 578 | (define-key frog-menu--avy-action-map (kbd (car action)) 579 | (lambda () (car (cddr action))))) 580 | ;; space must not be used by actions 581 | (define-key frog-menu--avy-action-map "\t" 'frog-menu--complete)) 582 | 583 | (defun frog-menu-query-with-avy (buffer window actions) 584 | "Query handler for avy-posframe. 585 | 586 | Uses `avy' to query for candidates in BUFFER showing in WINDOW. 587 | 588 | ACTIONS is the argument of `frog-menu-read'." 589 | (let ((candidates (frog-menu--get-avy-candidates 590 | buffer window))) 591 | ;; init map which passes actions info to avy handler 592 | (frog-menu--init-avy-action-map actions) 593 | ;; FIXME: These aren't found in my copy of avy! 594 | (defvar avy-single-candidate-jump) (defvar avy-pre-action) 595 | (if candidates 596 | (let* ((avy-keys frog-menu-avy-keys) 597 | (avy-single-candidate-jump (null actions)) 598 | (avy-handler-function #'frog-menu--posframe-ace-handler) 599 | (avy-pre-action #'ignore) 600 | (avy-all-windows nil) 601 | (avy-style 'at-full) 602 | (avy-action #'identity) 603 | (pos (with-selected-window window 604 | (avy-process 605 | candidates 606 | (avy--style-fn avy-style))))) 607 | (cond ((number-or-marker-p pos) 608 | ;; string 609 | (with-current-buffer buffer 610 | (let* ((start pos) 611 | (end (or (next-single-property-change start 'face) 612 | (point-max)))) 613 | ;; get rid of the padding 614 | (replace-regexp-in-string 615 | "\\`_ *" "" (buffer-substring start end))))) 616 | ((eq pos 'frog-menu--complete) 617 | ;; switch to completion from `frog-menu-read' 618 | pos) 619 | ((functionp pos) 620 | ;; action 621 | (funcall pos)))) 622 | (let ((f nil)) 623 | (while (not f) 624 | (unless (setq f (lookup-key frog-menu--avy-action-map 625 | (vector (read-char)))) 626 | (message "No such action, hit C-g to quit."))) 627 | (funcall f))))) 628 | 629 | 630 | ;; * Entry point 631 | 632 | (defun frog-menu--complete (prompt collection &rest args) 633 | "PROMPT for `completing-read' COLLECTION. 634 | 635 | Remaining ARGS are passed to `completing-read'. PROMPT and 636 | COLLECTION are the arguments from `frog-menu-read'." 637 | (apply #'completing-read 638 | ;; make sure prompt is "completing readable" 639 | (if (string-empty-p prompt) 640 | ": " 641 | (replace-regexp-in-string "\\(: ?\\)?\\'" ": " prompt)) 642 | collection args)) 643 | 644 | (defun frog-menu-completing-read-function (prompt collection predicate &rest _) 645 | "Can be used as `completing-read-function'. 646 | 647 | PROMPT, COLLECTION and PREDICATE are of format as specified by 648 | `completing-read'." 649 | (let ((strings (frog-menu--collection-to-strings collection predicate))) 650 | (frog-menu-read prompt strings))) 651 | 652 | 653 | ;;;###autoload 654 | (defun frog-menu-call (cmds &optional prompt) 655 | "Read a command from CMDS and execute it. 656 | 657 | CMDS is of format as specified by `completing-read' 658 | collections. If PROMPT is given it should be a string with prompt 659 | information for the user." 660 | (let ((cmd (intern-soft (frog-menu-read 661 | (or prompt "") 662 | (frog-menu--collection-to-strings cmds))))) 663 | (command-execute cmd))) 664 | 665 | 666 | (defun frog-menu--collection-to-strings (collection &optional predicate) 667 | "Return list of strings representing COLLECTION. 668 | COLLECTION and PREDICATE should have the format as specified by 669 | `completing-read'." 670 | (cond ((functionp collection) 671 | (let ((cands (funcall collection "" predicate t))) 672 | (if (stringp (car-safe cands)) 673 | (copy-sequence cands) 674 | (mapcar #'symbol-name cands)))) 675 | ((listp collection) 676 | (let ((strings ())) 677 | (dolist (el collection (nreverse strings)) 678 | (unless (and predicate 679 | (funcall predicate el)) 680 | (let ((cand (or (car-safe el) el))) 681 | (push (if (symbolp cand) 682 | (symbol-name cand) 683 | cand) 684 | strings)))))) 685 | ((hash-table-p collection) 686 | (let ((strings ())) 687 | (maphash 688 | (lambda (key val) 689 | (unless (and predicate 690 | (funcall predicate key val)) 691 | (push (if (symbolp key) 692 | (symbol-name key) 693 | key) 694 | strings))) 695 | collection) 696 | (nreverse strings))) 697 | ((vectorp collection) 698 | (let ((strings ())) 699 | (mapatoms 700 | (lambda (el) 701 | (unless (and predicate 702 | (funcall predicate el)) 703 | (push (symbol-name el) strings)))) 704 | (nreverse strings))))) 705 | 706 | 707 | ;;;###autoload 708 | (defun frog-menu-read (prompt collection &optional actions) 709 | "Read from a menu of variable `frog-menu-type'. 710 | 711 | PROMPT is a string with prompt information for the user. 712 | 713 | COLLECTION is a list from which the user can choose an item. It 714 | can be a list of strings or an alist mapping strings to return 715 | values. Users can switch to `completing-read' from COLLECTION 716 | using the TAB key. For sorting the displayed strings see 717 | `frog-menu-sort-function'. 718 | 719 | ACTIONS is an additional list of actions that can be given to let 720 | the user choose an action instead an item from COLLECTION. 721 | 722 | Each ACTION is a list of the form: 723 | 724 | (KEY DESCRIPTION RETURN) 725 | 726 | Where KEY is a string to be interpreted as spelled-out 727 | keystrokes, using the same format as for `kbd'. 728 | 729 | DESCRIPTION is a string to be displayed along with KEY to 730 | describe the action. 731 | 732 | RETURN will be the returned value if KEY is pressed." 733 | (let* ((frog-menu-type (funcall frog-menu-type-function)) 734 | (convf (and collection (consp (car collection)) 735 | #'car)) 736 | (strings (if convf 737 | (mapcar convf collection) 738 | collection)) 739 | (strings (if frog-menu-sort-function 740 | (sort strings frog-menu-sort-function) 741 | strings)) 742 | (buf (frog-menu--init-buffer (get-buffer-create frog-menu--buffer) 743 | prompt 744 | strings 745 | actions)) 746 | (dhandler (cdr (assq frog-menu-type 747 | frog-menu-display-handler-alist))) 748 | (doption (cdr (assq frog-menu-type 749 | frog-menu-display-option-alist))) 750 | (window (funcall dhandler buf doption)) 751 | (qhandler (cdr (assq frog-menu-type 752 | frog-menu-query-handler-alist))) 753 | (cuhandler (cdr (assq frog-menu-type 754 | frog-menu-cleanup-handler-alist))) 755 | (res nil)) 756 | (unwind-protect 757 | (setq res (funcall qhandler buf window actions)) 758 | (when cuhandler 759 | (funcall cuhandler buf window))) 760 | (when (eq res 'frog-menu--complete) 761 | (setq res (frog-menu--complete prompt strings))) 762 | (cond ((and (eq convf #'car) 763 | (stringp res) 764 | (eq (get-text-property 0 'face res) 765 | 'frog-menu-candidates-face)) 766 | (cdr (assoc res collection))) 767 | (t res)))) 768 | 769 | 770 | 771 | (provide 'frog-menu) 772 | ;;; frog-menu.el ends here 773 | 774 | 775 | 776 | 777 | -------------------------------------------------------------------------------- /images/spellcheck.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clemera/frog-menu/2b8d04c1a03b339e2eaf031eacd0d9d615a21322/images/spellcheck.png -------------------------------------------------------------------------------- /images/spellcheck2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clemera/frog-menu/2b8d04c1a03b339e2eaf031eacd0d9d615a21322/images/spellcheck2.png -------------------------------------------------------------------------------- /stub/.nosearch: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clemera/frog-menu/2b8d04c1a03b339e2eaf031eacd0d9d615a21322/stub/.nosearch -------------------------------------------------------------------------------- /stub/avy.el: -------------------------------------------------------------------------------- 1 | ;;; stub/avy.el --- ??? -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2019 Free Software Foundation, Inc. 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | (defvar avy-keys nil) 19 | (defvar avy-single-candidate-jump nil) 20 | (defvar avy-handler-function nil) 21 | (defvar avy-pre-action nil) 22 | (defvar avy-all-windows nil) 23 | (defvar avy-style nil) 24 | (defvar avy-action nil) 25 | 26 | (defun avy-process (candidates overlay-fn)) 27 | (defun avy--process (candidates overlay-fn)) 28 | (defun avy--style-fn (style)) 29 | 30 | (provide 'avy) ;; FIXME: Really? 31 | ;;; stub/posframe.el ends here 32 | -------------------------------------------------------------------------------- /stub/posframe.el: -------------------------------------------------------------------------------- 1 | ;;; stub/posframe.el --- ??? -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2019 Free Software Foundation, Inc. 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | (require 'cl-lib) 19 | 20 | (defvar posframe--frame nil) 21 | 22 | (cl-defun posframe-show (posframe-buffer 23 | &key 24 | string 25 | position 26 | poshandler 27 | width 28 | height 29 | min-width 30 | min-height 31 | x-pixel-offset 32 | y-pixel-offset 33 | left-fringe 34 | right-fringe 35 | internal-border-width 36 | internal-border-color 37 | font 38 | foreground-color 39 | background-color 40 | respect-header-line 41 | respect-mode-line 42 | initialize 43 | no-properties 44 | keep-ratio 45 | override-parameters 46 | timeout 47 | refresh 48 | &allow-other-keys)) 49 | 50 | (defun posframe-hide (posframe-buffer)) 51 | (defun posframe-poshandler-point-bottom-left-corner (info &optional font-height)) 52 | 53 | (provide 'posframe) ;; FIXME: Really? 54 | ;;; stub/posframe.el ends here 55 | -------------------------------------------------------------------------------- /test/frog-menu-test.el: -------------------------------------------------------------------------------- 1 | (require 'ert) 2 | (require 'frog-menu) 3 | 4 | 5 | ;; TODO: test grid creation as non interactive test: 6 | ;; all items in it? correctly ordered? respecting dimensions? 7 | 8 | 9 | ;; tests for interactive usage 10 | ;; load tests and run ert 11 | (unless noninteractive 12 | (require 'with-simulated-input) 13 | (ert-deftest frog-menu-test-stub () 14 | (should (string= (with-simulated-input "a" 15 | (frog-menu-read "Check: " '("this" "that" "more"))) 16 | "this"))) 17 | (ert-deftest frog-menu-test-stub () 18 | (should (string= (with-simulated-input "s" 19 | (frog-menu-read "Check: " '("this" "that" "more"))) 20 | "that"))) 21 | (when load-file-name 22 | (ert-run-tests-batch nil))) 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | --------------------------------------------------------------------------------