[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/frog-menu ebb5f3c 01/43: Initial commit
From: |
Clemens Radermacher |
Subject: |
[elpa] externals/frog-menu ebb5f3c 01/43: Initial commit |
Date: |
Sun, 24 Mar 2019 05:14:42 -0400 (EDT) |
branch: externals/frog-menu
commit ebb5f3cbb85ce0997d5ad9b28a39ce848bb55b0b
Author: Clemens Radermacher <address@hidden>
Commit: Clemens Radermacher <address@hidden>
Initial commit
---
README.org | 47 ++++++
frog-menu.el | 412 ++++++++++++++++++++++++++++++++++++++++++++++++++
images/spellcheck.png | Bin 0 -> 27999 bytes
3 files changed, 459 insertions(+)
diff --git a/README.org b/README.org
new file mode 100644
index 0000000..ed4fab9
--- /dev/null
+++ b/README.org
@@ -0,0 +1,47 @@
+* Description
+
+This package lets you quickly pick strings from ad hoc menus. Just like a frog
+would catch a fly. The menu is built "on the fly" from a collection of
+strings. It's presented to the user to choose one of them. One example where
+this kind of menu is useful are spelling correction suggestions:
+
+[[./images/spellcheck.png]]
+
+
+* Example
+
+To invoke the menu users can call `frog-menu-read'. How items are displayed
+and choosen depends on `frog-menu-type'. The default type `avy-posframe' uses
+`avy' and `posframe'. Their handler functions can be used as reference if you
+want to define a new `frog-menu-type'.
+
+Here is an example how you could use `frog-menu-read' to implement a
+`flyspell-correct-interface':
+
+#+begin_src elisp
+(require 'flyspell-correct)
+
+(defun frog-menu-flyspell-correct (candidates word)
+ "Run `frog-menu-read' for the given CANDIDATES.
+
+List of CANDIDATES is given by flyspell for the WORD.
+
+Return selected word to use as a replacement or a tuple
+of (command . word) to be used by `flyspell-do-correct'."
+ (let* ((corrects (if flyspell-sort-corrections
+ (sort candidates 'string<)
+ candidates))
+ (actions `(("C-s" "Save word" (save . ,word))
+ ("C-a" "Accept (session)" (session . ,word))
+ ("C-b" "Accept (buffer)" (buffer . ,word))
+ ("C-c" "Skip" (skip . ,word))))
+ (prompt (format "Dictionary: [%s]" (or ispell-local-dictionary
+ ispell-dictionary
+ "default")))
+ (res (frog-menu-read prompt corrects actions)))
+ (unless res
+ (error "Quit"))
+ res))
+
+(setq flyspell-correct-interface #'frog-menu-flyspell-correct)
+#+end_src
diff --git a/frog-menu.el b/frog-menu.el
new file mode 100644
index 0000000..56a86e2
--- /dev/null
+++ b/frog-menu.el
@@ -0,0 +1,412 @@
+;;; frog-menu.el --- Quickly pick items from ad hoc menus -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2019 Clemens Radermacher
+
+;; Author: Clemens Radermacher <address@hidden>
+;; URL: https://github.com/clemera/frog-menu
+;; Version: 0.1
+;; Package-Requires: ((emacs "26") (avy) (posframe))
+;; Keywords: convenience
+
+;; This program 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package lets you quickly pick strings from ad hoc menus. Just like a
+;; frog would catch a fly. The menu is built "on the fly" from a collection of
+;; strings. It's presented to the user to choose one of them. One example
+;; where this kind of menu is useful are spelling correction suggestions.
+;;
+;; To invoke the menu users can call `frog-menu-read'. How items are displayed
+;; and chosen depends on `frog-menu-type'. The default type `avy-posframe'
+;; uses `avy' and `posframe'. Their handler functions can be used as reference
+;; if you want to define a new `frog-menu-type'.
+;;
+;; Here is an example how you would use `frog-menu-read' to implement a
+;; `flyspell-correct-interface':
+;;
+;; (defun frog-menu-flyspell-correct (candidates word)
+;; "Run `frog-menu-read' for the given CANDIDATES.
+;;
+;; List of CANDIDATES is given by flyspell for the WORD.
+;;
+;; Return selected word to use as a replacement or a tuple
+;; of (command . word) to be used by `flyspell-do-correct'."
+;; (let* ((corrects (if flyspell-sort-corrections
+;; (sort candidates 'string<)
+;; candidates))
+;; (actions `(("C-s" "Save word" (save . ,word))
+;; ("C-a" "Accept (session)" (session . ,word))
+;; ("C-b" "Accept (buffer)" (buffer . ,word))
+;; ("C-c" "Skip" (skip . ,word))))
+;; (prompt (format "Dictionary: [%s]" (or ispell-local-dictionary
+;; ispell-dictionary
+;; "default")))
+;; (res (frog-menu-read prompt corrects actions)))
+;; (unless res
+;; (error "Quit"))
+;; res))
+;;
+;; (setq flyspell-correct-interface #'frog-menu-flyspell-correct)
+;;
+;;; Code:
+
+(require 'avy)
+(require 'posframe)
+
+(defgroup frog-menu nil
+ "Quickly pick items from ad hoc menus."
+ :group 'convenience
+ :prefix "frog-menu-")
+
+(defcustom frog-menu-type 'avy-posframe
+ "The type of menu to be used.
+
+When defining a new menu type, handlers need to be added for
+
+`frog-menu-init-handler-alist'
+
+`frog-menu-display-handler-alist'
+
+`frog-menu-query-handler-alist'."
+ :type 'symbol)
+
+
+(defcustom frog-menu-init-handler-alist
+ '((avy-posframe . frog-menu-init-avy-posframe))
+ "Maps `frog-menu-type' to an init handler.
+
+The init handler is called with prompt, strings and actions
+arguments of `frog-menu-read'. It should initialize the buffer for
+display and return it. Afterwards the hook
+`frog-menu-after-init-hook' gets executed."
+ :type '(alist :key-type symbol
+ :value-type function))
+
+(defcustom frog-menu-display-handler-alist
+ '((avy-posframe . frog-menu-display-posframe))
+ "Maps `frog-menu-type' to a display handler.
+
+The display handler receives the buffer to display as an argument
+and should return the candidates to pass as first argument to the
+query handler."
+ :type '(alist :key-type symbol
+ :value-type function))
+
+(defcustom frog-menu-query-handler-alist
+ '((avy-posframe . frog-menu-avy-posframe))
+ "Maps `frog-menu-type' to a query handler.
+
+The query handler receives two arguments.
+
+The first are the candidates passed from the return value of the
+display handler. The second one is the actions argument passed to
+`frog-menu-read'.
+
+This function should return the chosen string or action return
+value. If the user exited the query return nil."
+ :type '(alist :key-type symbol
+ :value-type function))
+
+(defcustom frog-menu-after-init-hook '()
+ "Frog menu init hook.
+
+Runs after menu buffer is initialized by its init handler. The
+menu buffer is set current when this hook runs."
+ :type '(repeat function))
+
+(defcustom frog-menu-grid-width-function
+ (lambda () (/ (frame-width) 2))
+ "Returns the width that should be used for menu grid."
+ :type 'function)
+
+(defcustom frog-menu-grid-column-function
+ (lambda ()
+ (/ (funcall frog-menu-grid-width-function)
+ 8))
+ "Returns the number of columns for the menu grid.
+
+Less columns are used automatically if the grid width is not big
+enough to contain that many columns."
+ :type 'function)
+
+(defcustom frog-menu-avy-keys (append (number-sequence ?a ?z)
+ (number-sequence ?A ?Z)
+ (number-sequence ?, ?@))
+ "Frog menu keys used for `avy-keys'.
+
+By default uses a large collection of keys, so that the hints can
+be drawn by single characters."
+ :type '(repeat character))
+
+(defface frog-menu-border '((((background dark)) . (:background "white"))
+ (((background light)) . (:background "black")))
+ "The border color for the posframe.")
+
+(defface frog-menu-candidate-face
+ '((t (:inherit default)))
+ "Face used for menu candidates.")
+
+(defvar frog-menu--buffer " *frog-menu-menu*"
+ "Buffer used for the frog menu.")
+
+;; * Init
+
+(defun frog-menu--init-buffer (prompt strings actions)
+ "Initialize the menu buffer and return it.
+
+PROMPT STRINGS and ACTIONS are the args from `frog-menu-read'."
+ (with-current-buffer (get-buffer-create frog-menu--buffer)
+ (erase-buffer)
+ (funcall (cdr (assq frog-menu-type
+ frog-menu-init-handler-alist))
+ prompt strings actions)
+ (run-hooks 'frog-menu-after-init-hook)
+ (get-buffer frog-menu--buffer)))
+
+(defun frog-menu-init-avy-posframe (prompt strings actions)
+ "Init handler for avy-posframe.
+
+PROMPT, STRINGS and ACTIONS are the args from `frog-menu-read'.
+
+Fills the buffer with a grid of STRINGS followed by PROMPT and
+ACTIONS."
+ (insert
+ (frog-menu--grid-format
+ strings
+ (funcall frog-menu-grid-column-function)
+ (funcall frog-menu-grid-width-function)))
+ (insert "\n\n")
+ (insert (frog-menu--prompt-format prompt actions)))
+
+
+;; * Formatting
+
+(defun frog-menu--grid-format (strings cols &optional width)
+ "Return grid string built with STRINGS.
+
+The grid will be segmented into columns. COLS is the maximum
+number of columns to use. The columns have WIDTH space in
+horizontal direction which default to frame width.
+
+Returns the buffer containing the formatted grid."
+ (with-temp-buffer
+ (let* ((length (apply 'max
+ (mapcar #'string-width strings)))
+ (wwidth (or width (frame-width)))
+ (columns (min cols (/ wwidth (+ 2 length))))
+ (colwidth (/ wwidth columns))
+ (column 0)
+ (first t)
+ laststring)
+ (dolist (str strings)
+ (unless (equal laststring str)
+ (setq laststring str)
+ (let ((length (string-width str)))
+ (unless first
+ (if (or (< wwidth (+ (max colwidth length) column))
+ (zerop length))
+ (progn
+ (insert "\n" (if (zerop length) "\n" ""))
+ (setq column 0))
+ (insert " \t")
+ (set-text-properties (1- (point)) (point)
+ `(display (space :align-to ,column)))))
+ (setq first (zerop length))
+ (add-text-properties (point)
+ (progn (insert str)
+ (point))
+ '(face frog-menu-candidate-face))
+ (setq column (+ column
+ (* colwidth (ceiling length colwidth)))))))
+ (buffer-string))))
+
+
+(defun frog-menu--prompt-format (prompt actions)
+ "Return string containing formatted PROMPT and ACTIONS.
+
+PROMPT and ACTIONS are the arguments of `frog-menu-read'."
+ (with-temp-buffer
+ (insert prompt "\n")
+ (let ((header-pos (point)))
+ (dolist (action actions)
+ (insert (car action)
+ "_"
+ (replace-regexp-in-string " " "_" (cadr action))
+ " "))
+ (insert "\n")
+ (let ((fill-column (1+ (funcall frog-menu-grid-width-function))))
+ (fill-region header-pos (point))
+ (align-regexp header-pos (point) "\\(\\s-*\\) " 1 1 nil)
+ (while (re-search-backward "_" nil t)
+ (replace-match " "))))
+ (goto-char (point-min))
+ ;; one more for the avy char
+ (while (not (eobp))
+ (goto-char (line-end-position))
+ (insert " ")
+ (forward-line 1))
+ (buffer-string)))
+
+;; * Display
+
+(defun frog-menu-display-posframe (buf)
+ "Display posframe showing buffer BUF.
+
+Returns candidates to be handled by query handler."
+ (posframe-show buf
+ :poshandler #'posframe-poshandler-point-bottom-left-corner
+ :internal-border-width 1)
+ (set-face-attribute 'internal-border
+ (buffer-local-value 'posframe--frame buf)
+ :inherit 'frog-menu-border)
+ (frog-menu--get-avy-candidates
+ (frame-selected-window
+ (buffer-local-value 'posframe--frame buf))
+ buf))
+
+(defun frog-menu--get-avy-candidates (&optional w b start end)
+ "Return candidates to be passed to `avy--process'.
+
+W is the window where the candidates can be found and defaults to
+the currently selected one. B is the buffer of the candidates and
+defaults to the current one. START and END are the buffer
+positions containing the candidates and default to point-min and
+point-max."
+ (let ((w (or w (selected-window)))
+ (b (or b (current-buffer)))
+ (candidates ()))
+ (with-current-buffer b
+ (let ((start (or start (point-min)))
+ (end (or end (point-max))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (push (cons (point) w) candidates)
+ (goto-char
+ (or (next-single-property-change
+ (point) 'face)
+ (point-max)))
+ (while (< (point) (point-max))
+ (unless (looking-at "[[:blank:]\r\n]\\|\\'")
+ (push (cons (point) w)
+ candidates))
+ (goto-char
+ (or (next-single-property-change
+ (point)
+ 'face)
+ (point-max))))))))
+ (nreverse candidates)))
+
+;; * Query handler functions
+
+(defvar frog-menu--avy-action-map nil
+ "Internal keymap saving the actions for the avy handler.")
+
+(defun frog-menu--posframe-ace-handler (char)
+ "Execute menu action for CHAR."
+ (cond ((memq char '(27 ?\C-g))
+ ;; exit silently
+ (throw 'done 'exit))
+ ((mouse-event-p char)
+ (signal 'user-error (list "Mouse event not handled" char)))
+ (t
+ (require 'edmacro)
+ (let* ((key (kbd (edmacro-format-keys (vector char))))
+ (cmd (lookup-key frog-menu--avy-action-map key)))
+ (if (commandp cmd)
+ (throw 'done (list (list cmd)))
+ (message "No such candidate: %s, hit `C-g' to quit."
+ (if (characterp char) (string char) char))
+ (throw 'done 'restart))))))
+
+(defun frog-menu--init-avy-action-map (actions)
+ "Initialize `frog-menu--action-map'.
+
+Each action of ACTIONS is bound to a command which returns the
+action result. ACTIONS is the argument of `frog-menu-read'."
+ (setq frog-menu--avy-action-map (make-sparse-keymap))
+ (dolist (action actions)
+ (define-key frog-menu--avy-action-map (kbd (car action))
+ (lambda () (interactive) (car (cddr action))))))
+
+(defun frog-menu-avy-posframe (candidates actions buffer)
+ "Query handler for avy-posframe.
+
+CANDIDATES are the candidates for `avy--process'. ACTIONS is the
+argument of `frog-menu-read'. BUFFER is the menu buffer which
+gets hidden after the query."
+ ;; uses a global keymap var to pass info to avy handler
+ (frog-menu--init-avy-action-map actions)
+ (let* ((avy-keys frog-menu-avy-keys)
+ (avy-handler-function #'frog-menu--posframe-ace-handler)
+ (avy-pre-action #'ignore)
+ (avy-all-windows nil)
+ (avy-style 'pre)
+ (avy-action #'identity)
+ (pos (avy--process
+ candidates
+ (avy--style-fn avy-style))))
+ (posframe-hide buffer)
+ (cond ((number-or-marker-p pos)
+ ;; string
+ (with-current-buffer buffer
+ (let* ((start pos)
+ (end (or (next-single-property-change start 'face)
+ (point-max))))
+ (buffer-substring start end))))
+ ((commandp pos)
+ ;; action
+ (call-interactively pos)))))
+
+
+;; * Entry point
+
+
+(defun frog-menu-read (prompt strings &optional actions)
+ "Read from a menu of `frog-menu-type'.
+
+PROMPT is a string with prompt information for the user.
+
+STRINGS is a list of strings from which the user is expected to
+choose one.
+
+ACTIONS is an additional list of actions that can be given to let
+the user choose an action instead of returning a chosen string.
+
+Each ACTION is a list of the form:
+
+ (KEY DESCRIPTION RETURN)
+
+Where KEY is a string to be interpreted as spelled-out
+keystrokes, using the same format as for `kbd'.
+
+DESCRIPTION is a string to be displayed along with KEY to
+describe the action.
+
+RETURN will be the returned value if KEY is pressed."
+ (let* ((buf (frog-menu--init-buffer prompt strings actions))
+ (dhandler (cdr (assq frog-menu-type
+ frog-menu-display-handler-alist)))
+ (candidates (funcall dhandler buf))
+ (qhandler (cdr (assq frog-menu-type
+ frog-menu-query-handler-alist)))
+ (res (funcall qhandler candidates actions buf)))
+ res))
+
+
+
+(provide 'frog-menu)
+;;; frog-menu.el ends here
diff --git a/images/spellcheck.png b/images/spellcheck.png
new file mode 100644
index 0000000..67931ed
Binary files /dev/null and b/images/spellcheck.png differ
- [elpa] externals/frog-menu 2460b67 06/43: Add gitignore, (continued)
- [elpa] externals/frog-menu 2460b67 06/43: Add gitignore, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 20cd2dc 04/43: Add links, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 1af5653 05/43: Checkdoc fixes, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu eedd690 09/43: Fix menu format, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu a5f31be 07/43: Add another example, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu ca08068 13/43: Add cleanup handler option, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 864ff1b 14/43: Improve docstring, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 8e81080 17/43: Fix first init error for posframe, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 5846f71 16/43: Allow single candidate jump if no actions, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 9ea2c24 23/43: Change default grid format function to adjust width based on type, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu ebb5f3c 01/43: Initial commit,
Clemens Radermacher <=
- [elpa] externals/frog-menu 77155d9 28/43: Update docstring, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 72aa25b 22/43: Fix docstring, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu c91a373 26/43: Adjust grid width default for avy-side-window, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 8f58de5 24/43: Update description for new frog-menu-type avy-side-window, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 5c7d9f4 31/43: Remove scrollbar from screenshot, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu dcca698 33/43: Allow passing no actions, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 0d8141a 18/43: Restrucure data flow, refactoring, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 625165e 40/43: Add autoload cookie for frog-menu-read, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 6596627 20/43: Add prompt face, Clemens Radermacher, 2019/03/24
- [elpa] externals/frog-menu 0d4d9f2 25/43: Update description for new frog-menu-type avy-side-window, Clemens Radermacher, 2019/03/24