1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
;;; avy-menu.el --- Library providing avy-powered popup menu -*- lexical-binding: t; -*-
;;
;; Copyright © 2016–2017 Mark Karpov <markkarpov92@gmail.com>
;;
;; Author: Mark Karpov <markkarpov92@gmail.com>
;; URL: https://github.com/mrkkrp/avy-menu
;; Version: 0.1.1
;; Package-Requires: ((emacs "24.3") (avy "0.3.0"))
;; Keywords: popup, menu
;;
;; This file is not part of GNU Emacs.
;;
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The library provides Avy-powered popup menu that allows to quickly choose
;; from available options. This is used in (at least) the following
;; packages:
;;
;; * `ace-popup-menu'
;; * `char-menu'
;; * `hasky-extensions'
;;
;; You can use it directly for your custom needs as well.
;;; Code:
(require 'avy)
(require 'cl-lib)
(defgroup avy-menu nil
"Avy-powered popup menu."
:group 'convenience
:tag "Avy Menu"
:prefix "avy-menu-"
:link '(url-link :tag "GitHub" "https://github.com/mrkkrp/avy-menu"))
(defface avy-menu-title
'((t (:inherit font-lock-function-name-face)))
"Face used to print title of entire menu.")
(defface avy-menu-pane-header
'((t (:inherit underline)))
"Face used to print pane headers.")
(defface avy-menu-inactive
'((t (:inherit shadow)))
"Face used to print inactive menu items.")
;;;###autoload
(defun avy-menu (buffer-or-name menu &optional show-pane-header)
"Show a popup menu in a temporary window and return user's selection.
BUFFER-OR-NAME specifies name of the buffer (or buffer itself)
that hosts menu options. MENU itself should be a list of the
form (TITLE PANE1 PANE2 …), where each pane is a list of
form (TITLE ITEM1 ITEM2 …). Each item is normally a cons
cell (STRING . VALUE), but a string can appear as an item—that
makes a non-selectable item in the menu. Also, empty strings
start a new sub-section.
If SHOW-PANE-HEADER is not NIL, show pane headers (titles),
otherwise hide them.
Returned value is VALUE if user has selected something and NIL if
he has cancelled the whole menu or pressed key that does not
correspond to any available option."
(let ((buffer (get-buffer-create buffer-or-name))
menu-item-alist
(first-pane t))
(with-current-buffer buffer
(with-current-buffer-window
;; buffer or name
buffer
;; action (for `display-buffer')
(cons 'display-buffer-below-selected
'((window-height . fit-window-to-buffer)
(preserve-size . (nil . t))))
;; quit-function
(lambda (window _value)
(with-selected-window window
(unwind-protect
(cdr
(assq
(avy-with avy-menu
(avy--process (mapcar #'car menu-item-alist)
#'avy--overlay-pre))
menu-item-alist))
(when (window-live-p window)
(quit-restore-window window 'kill)))))
;; menu generation
(setq cursor-type nil)
(cl-destructuring-bind (title . panes) menu
(insert (propertize title 'face 'avy-menu-title)
"\n\n")
(dolist (pane panes)
(cl-destructuring-bind (title . items) pane
(if first-pane
(setq first-pane nil)
(insert "\n\n"))
(when show-pane-header
(insert (propertize title 'face 'avy-menu-pane-header)
"\n\n"))
(let ((pane-alist (avy-menu--insert-strings items)))
(if menu-item-alist
(nconc menu-item-alist pane-alist)
(setq menu-item-alist pane-alist))))))))))
(defun avy-menu--insert-strings (items)
"Insert ITEMS much like `completion--insert-strings' in current buffer.
ITEMS should be a list, where every element is a cons of
form (STRING . VALUE), where STRING is the string to be printed
in current buffer and VALUE is used to construct result value of
this function. ITEMS can contain plain strings, in this case
they are printed with inactive face. Empty strings are not
printed, instead they begin new sub-section.
Return alist of values (POS . VALUE), where POS indicates
position of STRING in the buffer and VALUE is its associated
value according to ITEMS."
(when (consp items)
(let* ((strings (mapcar (lambda (x) (if (consp x) (car x) x))
items))
(length (apply 'max
(mapcar #'string-width strings)))
(window (get-buffer-window (current-buffer) 0))
(wwidth (if window (1- (window-width window)) 79))
(columns (min (max 2 (/ wwidth (+ 2 length)))
(max 1 (/ (length strings) 2))))
(colwidth (/ wwidth columns))
(column 0)
(first t)
laststring
result)
(dolist (str strings)
(unless (equal laststring str)
(setq laststring str)
(let ((length (string-width str))
(value (cdr (assq str items))))
(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))
(when value
(push (cons (point) value) result))
(insert (if value
str
(propertize str 'face 'avy-menu-inactive)))
(setq column (+ column
(* colwidth (ceiling length colwidth)))))))
(reverse result))))
(provide 'avy-menu)
;;; avy-menu.el ends here
|
