ruby_learner 1.1.2 → 1.1.3
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/Gemfile.lock +1 -1
- data/docs/thesis/competing_services.org +21 -0
- data/docs/thesis/manual.org +55 -0
- data/docs/thesis/mid_term.pptx +0 -0
- data/lib/ruby_learner/common.rb +45 -0
- data/lib/ruby_learner/ruby_learner.rb +9 -17
- data/lib/ruby_learner/sequential_main.rb +146 -0
- data/lib/ruby_learner/typing_practice.rb +82 -10
- data/lib/ruby_learner/version.rb +1 -1
- data/workshop/emacs.d/init.el +1 -76
- data/workshop/emacs.d/ruby_learner_init.el +0 -76
- metadata +7 -83
- data/lib/ruby_learner/methods.rb +0 -290
- data/workshop/emacs.d/#init# +0 -1
- data/workshop/emacs.d/ac-comphist.dat +0 -50
- data/workshop/emacs.d/cp5022x.el +0 -156
- data/workshop/emacs.d/elpa/archives/gnu/archive-contents +0 -1240
- data/workshop/emacs.d/elpa/archives/melpa/archive-contents +0 -2
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-autoloads.el +0 -65
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-config.el +0 -551
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-config.elc +0 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-pkg.el +0 -6
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete.el +0 -2164
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete.elc +0 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ada-mode +0 -72
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/c++-mode +0 -99
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/c-mode +0 -55
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/caml-mode +0 -231
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/clojure-mode +0 -580
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/clojurescript-mode +0 -475
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/coq-mode +0 -278
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/css-mode +0 -874
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/erlang-mode +0 -216
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ess-julia-mode +0 -37
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/go-mode +0 -25
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/haskell-mode +0 -679
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/java-mode +0 -53
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/js-mode +0 -148
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/julia-mode +0 -37
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/lua-mode +0 -21
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/nim-mode +0 -70
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/objc-mode +0 -161
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/octave-mode +0 -46
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/php-mode +0 -6144
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/python-mode +0 -379
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/qml-mode +0 -183
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ruby-mode +0 -181
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/scala-mode +0 -1347
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/scheme-mode +0 -216
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/sclang-mode +0 -1481
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/sh-mode +0 -182
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/swift-mode +0 -87
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/tcl-mode +0 -172
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ts-mode +0 -797
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/tuareg-mode +0 -231
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/verilog-mode +0 -313
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults-autoloads.el +0 -16
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults-pkg.el +0 -2
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults.el +0 -90
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults.elc +0 -0
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode-autoloads.el +0 -26
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode-pkg.el +0 -2
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode.el +0 -877
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode.elc +0 -0
- data/workshop/emacs.d/elpa/haml-mode-readme.txt +0 -8
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-light-theme.el +0 -918
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-light-theme.elc +0 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme-autoloads.el +0 -32
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme-pkg.el +0 -8
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme.el +0 -912
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme.elc +0 -0
- data/workshop/emacs.d/elpa/ox-bibtex-chinese-readme.txt +0 -21
- data/workshop/emacs.d/elpa/popup-20160709.729/popup-autoloads.el +0 -15
- data/workshop/emacs.d/elpa/popup-20160709.729/popup-pkg.el +0 -2
- data/workshop/emacs.d/elpa/popup-20160709.729/popup.el +0 -1432
- data/workshop/emacs.d/elpa/popup-20160709.729/popup.elc +0 -0
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode-autoloads.el +0 -33
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode-pkg.el +0 -2
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode.el +0 -470
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode.elc +0 -0
- data/workshop/emacs.d/elpa/yaml-mode-readme.txt +0 -25
- data/workshop/emacs.d/haml-mode-master/.gitignore +0 -1
- data/workshop/emacs.d/haml-mode-master/.mailmap +0 -2
- data/workshop/emacs.d/haml-mode-master/MIT-LICENSE +0 -20
- data/workshop/emacs.d/haml-mode-master/README.md +0 -47
- data/workshop/emacs.d/haml-mode-master/haml-mode.el +0 -887
- data/workshop/emacs.d/iceberg_theme.el +0 -202
- data/workshop/emacs.d/init-open-recentf.el +0 -133
- data/workshop/emacs.d/install-elisp.el +0 -366
- data/workshop/emacs.d/notes +0 -12
- data/workshop/emacs.d/processing-mode/processing-mode.el +0 -275
- data/workshop/emacs.d/recentf +0 -31
- data/workshop/emacs.d/wiki-mode/wiki.el +0 -976
Binary file
|
@@ -1,21 +0,0 @@
|
|
1
|
-
* README :README:
|
2
|
-
ox-bibtex-chinese is an extension of ox-bibtex, which can help chinese user
|
3
|
-
to export bibliography to html.
|
4
|
-
|
5
|
-
[[./snapshots/ox-bibtex-chinese.gif]]
|
6
|
-
|
7
|
-
** Installation
|
8
|
-
ox-bibtex-chinese is now available from the famous Emacs package repo
|
9
|
-
[[http://melpa.milkbox.net/][melpa]], so the recommended way is to install it
|
10
|
-
through Emacs package management system.
|
11
|
-
|
12
|
-
** Usage
|
13
|
-
1. Install bibtex2html to your system
|
14
|
-
2. Configure Emacs
|
15
|
-
#+BEGIN_EXAMPLE
|
16
|
-
(require 'org)
|
17
|
-
(require 'ox-bibtex)
|
18
|
-
(require 'ox-bibtex-chinese)
|
19
|
-
(ox-bibtex-chinese-enable)
|
20
|
-
#+END_EXAMPLE
|
21
|
-
3. See the format of "example/thesis.org" and try export it to html file.
|
@@ -1,15 +0,0 @@
|
|
1
|
-
;;; popup-autoloads.el --- automatically extracted autoloads
|
2
|
-
;;
|
3
|
-
;;; Code:
|
4
|
-
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
|
5
|
-
|
6
|
-
;;;### (autoloads nil nil ("popup.el") (23223 10761 175831 496000))
|
7
|
-
|
8
|
-
;;;***
|
9
|
-
|
10
|
-
;; Local Variables:
|
11
|
-
;; version-control: never
|
12
|
-
;; no-byte-compile: t
|
13
|
-
;; no-update-autoloads: t
|
14
|
-
;; End:
|
15
|
-
;;; popup-autoloads.el ends here
|
@@ -1,1432 +0,0 @@
|
|
1
|
-
;;; popup.el --- Visual Popup User Interface
|
2
|
-
|
3
|
-
;; Copyright (C) 2009-2015 Tomohiro Matsuyama
|
4
|
-
|
5
|
-
;; Author: Tomohiro Matsuyama <m2ym.pub@gmail.com>
|
6
|
-
;; Keywords: lisp
|
7
|
-
;; Package-Version: 20160709.729
|
8
|
-
;; Version: 0.5.3
|
9
|
-
;; Package-Requires: ((cl-lib "0.5"))
|
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 <http://www.gnu.org/licenses/>.
|
23
|
-
|
24
|
-
;;; Commentary:
|
25
|
-
|
26
|
-
;; popup.el is a visual popup user interface library for Emacs. This
|
27
|
-
;; provides a basic API and common UI widgets such as popup tooltips
|
28
|
-
;; and popup menus.
|
29
|
-
;; See README.markdown for more information.
|
30
|
-
|
31
|
-
;;; Code:
|
32
|
-
|
33
|
-
(require 'cl-lib)
|
34
|
-
|
35
|
-
(defconst popup-version "0.5.3")
|
36
|
-
|
37
|
-
|
38
|
-
|
39
|
-
;;; Utilities
|
40
|
-
|
41
|
-
(defun popup-calculate-max-width (max-width)
|
42
|
-
"Determines whether the width desired is
|
43
|
-
character or window proportion based, And returns the result."
|
44
|
-
(cl-typecase max-width
|
45
|
-
(integer max-width)
|
46
|
-
(float (* (ceiling (/ (round (* max-width (window-width))) 10.0)) 10))))
|
47
|
-
|
48
|
-
(defvar popup-use-optimized-column-computation t
|
49
|
-
"Use the optimized column computation routine.
|
50
|
-
If there is a problem, please set it nil.")
|
51
|
-
|
52
|
-
(defmacro popup-aif (test then &rest else)
|
53
|
-
"Anaphoric if."
|
54
|
-
(declare (indent 2))
|
55
|
-
`(let ((it ,test))
|
56
|
-
(if it ,then ,@else)))
|
57
|
-
|
58
|
-
(defmacro popup-awhen (test &rest body)
|
59
|
-
"Anaphoric when."
|
60
|
-
(declare (indent 1))
|
61
|
-
`(let ((it ,test))
|
62
|
-
(when it ,@body)))
|
63
|
-
|
64
|
-
(defun popup-x-to-string (x)
|
65
|
-
"Convert any object to string effeciently.
|
66
|
-
This is faster than `prin1-to-string' in many cases."
|
67
|
-
(cl-typecase x
|
68
|
-
(string x)
|
69
|
-
(symbol (symbol-name x))
|
70
|
-
(integer (number-to-string x))
|
71
|
-
(float (number-to-string x))
|
72
|
-
(t (format "%s" x))))
|
73
|
-
|
74
|
-
(defun popup-substring-by-width (string width)
|
75
|
-
"Return a cons cell of substring and remaining string by
|
76
|
-
splitting with WIDTH."
|
77
|
-
;; Expand tabs into 4 spaces
|
78
|
-
(setq string (replace-regexp-in-string "\t" " " string))
|
79
|
-
(cl-loop with len = (length string)
|
80
|
-
with w = 0
|
81
|
-
for l from 0
|
82
|
-
for c in (append string nil)
|
83
|
-
while (<= (cl-incf w (char-width c)) width)
|
84
|
-
finally return
|
85
|
-
(if (< l len)
|
86
|
-
(cons (substring string 0 l) (substring string l))
|
87
|
-
(list string))))
|
88
|
-
|
89
|
-
(defun popup-fill-string (string &optional width max-width justify squeeze)
|
90
|
-
"Split STRING into fixed width strings and return a cons cell
|
91
|
-
like \(WIDTH . ROWS). Here, the car WIDTH indicates the actual
|
92
|
-
maxim width of ROWS.
|
93
|
-
|
94
|
-
The argument WIDTH specifies the width of filling each
|
95
|
-
paragraph. WIDTH nil means don't perform any justification and
|
96
|
-
word wrap. Note that this function doesn't add any padding
|
97
|
-
characters at the end of each row.
|
98
|
-
|
99
|
-
MAX-WIDTH, if WIDTH is nil, specifies the maximum number of
|
100
|
-
columns.
|
101
|
-
|
102
|
-
The optional fourth argument JUSTIFY specifies which kind of
|
103
|
-
justification to do: `full', `left', `right', `center', or
|
104
|
-
`none' (equivalent to nil). A value of t means handle each
|
105
|
-
paragraph as specified by its text properties.
|
106
|
-
|
107
|
-
SQUEEZE nil means leave whitespaces other than line breaks
|
108
|
-
untouched."
|
109
|
-
(if (eq width 0)
|
110
|
-
(error "Can't fill string with 0 width"))
|
111
|
-
(if width
|
112
|
-
(setq max-width width))
|
113
|
-
(with-temp-buffer
|
114
|
-
(let ((tab-width 4)
|
115
|
-
(fill-column width)
|
116
|
-
(left-margin 0)
|
117
|
-
(kinsoku-limit 1)
|
118
|
-
indent-tabs-mode
|
119
|
-
row rows)
|
120
|
-
(insert string)
|
121
|
-
(untabify (point-min) (point-max))
|
122
|
-
(if width
|
123
|
-
(fill-region (point-min) (point-max) justify (not squeeze)))
|
124
|
-
(goto-char (point-min))
|
125
|
-
(setq width 0)
|
126
|
-
(while (prog2
|
127
|
-
(let ((line (buffer-substring
|
128
|
-
(point) (progn (end-of-line) (point)))))
|
129
|
-
(if max-width
|
130
|
-
(while (progn
|
131
|
-
(setq row (truncate-string-to-width line max-width)
|
132
|
-
width (max width (string-width row)))
|
133
|
-
(push row rows)
|
134
|
-
(if (not (= (length row) (length line)))
|
135
|
-
(setq line (substring line (length row))))))
|
136
|
-
(setq width (max width (string-width line)))
|
137
|
-
(push line rows)))
|
138
|
-
(< (point) (point-max))
|
139
|
-
(beginning-of-line 2)))
|
140
|
-
(cons width (nreverse rows)))))
|
141
|
-
|
142
|
-
(defmacro popup-save-buffer-state (&rest body)
|
143
|
-
(declare (indent 0))
|
144
|
-
`(save-excursion
|
145
|
-
(let ((buffer-undo-list t)
|
146
|
-
(inhibit-read-only t)
|
147
|
-
(modified (buffer-modified-p)))
|
148
|
-
(unwind-protect
|
149
|
-
(progn ,@body)
|
150
|
-
(set-buffer-modified-p modified)))))
|
151
|
-
|
152
|
-
(defun popup-vertical-motion (column direction)
|
153
|
-
"A portable version of `vertical-motion'."
|
154
|
-
(if (>= emacs-major-version 23)
|
155
|
-
(vertical-motion (cons column direction))
|
156
|
-
(vertical-motion direction)
|
157
|
-
(move-to-column (+ (current-column) column))))
|
158
|
-
|
159
|
-
(defun popup-last-line-of-buffer-p ()
|
160
|
-
"Return non-nil if the cursor is at the last line of the
|
161
|
-
buffer."
|
162
|
-
(save-excursion (end-of-line) (/= (forward-line) 0)))
|
163
|
-
|
164
|
-
(defun popup-lookup-key-by-event (function event)
|
165
|
-
(or (funcall function (vector event))
|
166
|
-
(if (symbolp event)
|
167
|
-
(popup-aif (get event 'event-symbol-element-mask)
|
168
|
-
(funcall function
|
169
|
-
(vector (logior (or (get (car it) 'ascii-character)
|
170
|
-
0)
|
171
|
-
(cadr it))))))))
|
172
|
-
|
173
|
-
|
174
|
-
|
175
|
-
;;; Core
|
176
|
-
|
177
|
-
(defgroup popup nil
|
178
|
-
"Visual Popup User Interface"
|
179
|
-
:group 'lisp
|
180
|
-
:prefix "popup-")
|
181
|
-
|
182
|
-
(defface popup-face
|
183
|
-
'((t (:inherit default :background "lightgray" :foreground "black")))
|
184
|
-
"Face for popup."
|
185
|
-
:group 'popup)
|
186
|
-
|
187
|
-
(defface popup-summary-face
|
188
|
-
'((t (:inherit popup-face :foreground "dimgray")))
|
189
|
-
"Face for popup summary."
|
190
|
-
:group 'popup)
|
191
|
-
|
192
|
-
(defface popup-scroll-bar-foreground-face
|
193
|
-
'((t (:background "black")))
|
194
|
-
"Foreground face for scroll-bar."
|
195
|
-
:group 'popup)
|
196
|
-
|
197
|
-
(defface popup-scroll-bar-background-face
|
198
|
-
'((t (:background "gray")))
|
199
|
-
"Background face for scroll-bar."
|
200
|
-
:group 'popup)
|
201
|
-
|
202
|
-
(defvar popup-instances nil
|
203
|
-
"Popup instances.")
|
204
|
-
|
205
|
-
(defvar popup-scroll-bar-foreground-char
|
206
|
-
(propertize " " 'face 'popup-scroll-bar-foreground-face)
|
207
|
-
"Foreground character for scroll-bar.")
|
208
|
-
|
209
|
-
(defvar popup-scroll-bar-background-char
|
210
|
-
(propertize " " 'face 'popup-scroll-bar-background-face)
|
211
|
-
"Background character for scroll-bar.")
|
212
|
-
|
213
|
-
(cl-defstruct popup
|
214
|
-
point row column width height min-height direction overlays keymap
|
215
|
-
parent depth
|
216
|
-
face mouse-face selection-face summary-face
|
217
|
-
margin-left margin-right margin-left-cancel scroll-bar symbol
|
218
|
-
cursor offset scroll-top current-height list newlines
|
219
|
-
pattern original-list invis-overlays)
|
220
|
-
|
221
|
-
(defun popup-item-propertize (item &rest properties)
|
222
|
-
"Same as `propertize' except that this avoids overriding
|
223
|
-
existed value with `nil' property."
|
224
|
-
(cl-loop for (k v) on properties by 'cddr
|
225
|
-
if v append (list k v) into props
|
226
|
-
finally return
|
227
|
-
(apply 'propertize
|
228
|
-
(popup-x-to-string item)
|
229
|
-
props)))
|
230
|
-
|
231
|
-
(defun popup-item-property (item property)
|
232
|
-
"Same as `get-text-property' except that this returns nil if
|
233
|
-
ITEM is not string."
|
234
|
-
(if (stringp item)
|
235
|
-
(get-text-property 0 property item)))
|
236
|
-
|
237
|
-
(cl-defun popup-make-item (name
|
238
|
-
&key
|
239
|
-
value
|
240
|
-
face
|
241
|
-
mouse-face
|
242
|
-
selection-face
|
243
|
-
sublist
|
244
|
-
document
|
245
|
-
symbol
|
246
|
-
summary)
|
247
|
-
"Utility function to make popup item. See also
|
248
|
-
`popup-item-propertize'."
|
249
|
-
(popup-item-propertize name
|
250
|
-
'value value
|
251
|
-
'popup-face face
|
252
|
-
'popup-mouse-face mouse-face
|
253
|
-
'selection-face selection-face
|
254
|
-
'document document
|
255
|
-
'symbol symbol
|
256
|
-
'summary summary
|
257
|
-
'sublist sublist))
|
258
|
-
|
259
|
-
(defsubst popup-item-value (item) (popup-item-property item 'value))
|
260
|
-
(defsubst popup-item-value-or-self (item) (or (popup-item-value item) item))
|
261
|
-
(defsubst popup-item-face (item) (popup-item-property item 'popup-face))
|
262
|
-
(defsubst popup-item-mouse-face (item) (popup-item-property item 'popup-mouse-face))
|
263
|
-
(defsubst popup-item-selection-face (item) (popup-item-property item 'selection-face))
|
264
|
-
(defsubst popup-item-document (item) (popup-item-property item 'document))
|
265
|
-
(defsubst popup-item-summary (item) (popup-item-property item 'summary))
|
266
|
-
(defsubst popup-item-symbol (item) (popup-item-property item 'symbol))
|
267
|
-
(defsubst popup-item-sublist (item) (popup-item-property item 'sublist))
|
268
|
-
|
269
|
-
(defun popup-item-documentation (item)
|
270
|
-
(let ((doc (popup-item-document item)))
|
271
|
-
(if (functionp doc)
|
272
|
-
(setq doc (funcall doc (popup-item-value-or-self item))))
|
273
|
-
doc))
|
274
|
-
|
275
|
-
(defun popup-item-show-help-1 (item)
|
276
|
-
(let ((doc (popup-item-documentation item)))
|
277
|
-
(when doc
|
278
|
-
(with-current-buffer (get-buffer-create " *Popup Help*")
|
279
|
-
(erase-buffer)
|
280
|
-
(insert doc)
|
281
|
-
(goto-char (point-min))
|
282
|
-
(display-buffer (current-buffer)))
|
283
|
-
t)))
|
284
|
-
|
285
|
-
(defun popup-item-show-help-with-event-loop (item)
|
286
|
-
(save-window-excursion
|
287
|
-
(when (popup-item-show-help-1 item)
|
288
|
-
(cl-loop do (clear-this-command-keys)
|
289
|
-
for key = (read-key-sequence-vector nil)
|
290
|
-
do
|
291
|
-
(cl-case (key-binding key)
|
292
|
-
(scroll-other-window
|
293
|
-
(scroll-other-window))
|
294
|
-
(scroll-other-window-down
|
295
|
-
(scroll-other-window-down nil))
|
296
|
-
(otherwise
|
297
|
-
(setq unread-command-events (append key unread-command-events))
|
298
|
-
(cl-return)))))))
|
299
|
-
|
300
|
-
(defun popup-item-show-help (item &optional persist)
|
301
|
-
"Display the documentation of ITEM with `display-buffer'. If
|
302
|
-
PERSIST is nil, the documentation buffer will be closed
|
303
|
-
automatically, meaning interal event loop ensures the buffer to
|
304
|
-
be closed. Otherwise, the buffer will be just displayed as
|
305
|
-
usual."
|
306
|
-
(when item
|
307
|
-
(if (not persist)
|
308
|
-
(popup-item-show-help-with-event-loop item)
|
309
|
-
(popup-item-show-help-1 item))))
|
310
|
-
|
311
|
-
(defun popup-set-list (popup list)
|
312
|
-
(popup-set-filtered-list popup list)
|
313
|
-
(setf (popup-pattern popup) nil)
|
314
|
-
(setf (popup-original-list popup) list))
|
315
|
-
|
316
|
-
(defun popup-set-filtered-list (popup list)
|
317
|
-
(let ((offset
|
318
|
-
(if (> (popup-direction popup) 0)
|
319
|
-
0
|
320
|
-
(max (- (popup-height popup) (length list)) 0))))
|
321
|
-
(setf (popup-list popup) list
|
322
|
-
(popup-offset popup) offset)))
|
323
|
-
|
324
|
-
(defun popup-selected-item (popup)
|
325
|
-
(nth (popup-cursor popup) (popup-list popup)))
|
326
|
-
|
327
|
-
(defun popup-selected-line (popup)
|
328
|
-
(- (popup-cursor popup) (popup-scroll-top popup)))
|
329
|
-
|
330
|
-
(defun popup-line-overlay (popup line)
|
331
|
-
(aref (popup-overlays popup) line))
|
332
|
-
|
333
|
-
(defun popup-selected-line-overlay (popup)
|
334
|
-
(popup-line-overlay popup (popup-selected-line popup)))
|
335
|
-
|
336
|
-
(defun popup-hide-line (popup line)
|
337
|
-
(let ((overlay (popup-line-overlay popup line)))
|
338
|
-
(overlay-put overlay 'display nil)
|
339
|
-
(overlay-put overlay 'after-string nil)))
|
340
|
-
|
341
|
-
(defun popup-line-hidden-p (popup line)
|
342
|
-
(let ((overlay (popup-line-overlay popup line)))
|
343
|
-
(and (eq (overlay-get overlay 'display) nil)
|
344
|
-
(eq (overlay-get overlay 'after-string) nil))))
|
345
|
-
|
346
|
-
(cl-defun popup-set-line-item (popup
|
347
|
-
line
|
348
|
-
&key
|
349
|
-
item
|
350
|
-
face
|
351
|
-
mouse-face
|
352
|
-
margin-left
|
353
|
-
margin-right
|
354
|
-
scroll-bar-char
|
355
|
-
symbol
|
356
|
-
summary
|
357
|
-
summary-face
|
358
|
-
keymap)
|
359
|
-
(let* ((overlay (popup-line-overlay popup line))
|
360
|
-
(content (popup-create-line-string popup (popup-x-to-string item)
|
361
|
-
:margin-left margin-left
|
362
|
-
:margin-right margin-right
|
363
|
-
:symbol symbol
|
364
|
-
:summary summary
|
365
|
-
:summary-face summary-face))
|
366
|
-
(start 0)
|
367
|
-
(prefix (overlay-get overlay 'prefix))
|
368
|
-
(postfix (overlay-get overlay 'postfix))
|
369
|
-
end)
|
370
|
-
(put-text-property 0 (length content) 'popup-item item content)
|
371
|
-
(put-text-property 0 (length content) 'keymap keymap content)
|
372
|
-
;; Overlap face properties
|
373
|
-
(when (get-text-property start 'face content)
|
374
|
-
(setq start (next-single-property-change start 'face content)))
|
375
|
-
(while (and start (setq end (next-single-property-change start 'face content)))
|
376
|
-
(put-text-property start end 'face face content)
|
377
|
-
(setq start (next-single-property-change end 'face content)))
|
378
|
-
(when start
|
379
|
-
(put-text-property start (length content) 'face face content))
|
380
|
-
(when mouse-face
|
381
|
-
(put-text-property 0 (length content) 'mouse-face mouse-face content))
|
382
|
-
(let ((prop (if (overlay-get overlay 'dangle)
|
383
|
-
'after-string
|
384
|
-
'display)))
|
385
|
-
(overlay-put overlay
|
386
|
-
prop
|
387
|
-
(concat prefix
|
388
|
-
content
|
389
|
-
scroll-bar-char
|
390
|
-
postfix)))))
|
391
|
-
|
392
|
-
(cl-defun popup-create-line-string (popup
|
393
|
-
string
|
394
|
-
&key
|
395
|
-
margin-left
|
396
|
-
margin-right
|
397
|
-
symbol
|
398
|
-
summary
|
399
|
-
summary-face)
|
400
|
-
(let* ((popup-width (popup-width popup))
|
401
|
-
(summary-width (string-width summary))
|
402
|
-
(content-width (max
|
403
|
-
(min popup-width (string-width string))
|
404
|
-
(- popup-width
|
405
|
-
(if (> summary-width 0)
|
406
|
-
(+ summary-width 2)
|
407
|
-
0))))
|
408
|
-
(string (car (popup-substring-by-width string content-width)))
|
409
|
-
(string-width (string-width string))
|
410
|
-
(spacing (max (- popup-width string-width summary-width)
|
411
|
-
(if (> popup-width string-width) 1 0)))
|
412
|
-
(truncated-summary
|
413
|
-
(car (popup-substring-by-width
|
414
|
-
summary (max (- popup-width string-width spacing) 0)))))
|
415
|
-
(when summary-face
|
416
|
-
(put-text-property 0 (length truncated-summary)
|
417
|
-
'face summary-face truncated-summary))
|
418
|
-
(concat margin-left
|
419
|
-
string
|
420
|
-
(make-string spacing ? )
|
421
|
-
truncated-summary
|
422
|
-
symbol
|
423
|
-
margin-right)))
|
424
|
-
|
425
|
-
(defun popup-live-p (popup)
|
426
|
-
"Return non-nil if POPUP is alive."
|
427
|
-
(and popup (popup-overlays popup) t))
|
428
|
-
|
429
|
-
(defun popup-child-point (popup &optional offset)
|
430
|
-
(overlay-end
|
431
|
-
(popup-line-overlay
|
432
|
-
popup
|
433
|
-
(or offset
|
434
|
-
(popup-selected-line popup)))))
|
435
|
-
|
436
|
-
(defun popup-calculate-direction (height row)
|
437
|
-
"Return a proper direction when displaying a popup on this
|
438
|
-
window. HEIGHT is the a height of the popup, and ROW is a line
|
439
|
-
number at the point."
|
440
|
-
(let* ((remaining-rows (- (max 1 (- (window-height)
|
441
|
-
(if mode-line-format 1 0)
|
442
|
-
(if header-line-format 1 0)))
|
443
|
-
(count-lines (window-start) (point))))
|
444
|
-
(enough-space-above (> row height))
|
445
|
-
(enough-space-below (<= height remaining-rows)))
|
446
|
-
(if (and enough-space-above
|
447
|
-
(not enough-space-below))
|
448
|
-
-1
|
449
|
-
1)))
|
450
|
-
|
451
|
-
(cl-defun popup-create (point
|
452
|
-
width
|
453
|
-
height
|
454
|
-
&key
|
455
|
-
min-height
|
456
|
-
max-width
|
457
|
-
around
|
458
|
-
(face 'popup-face)
|
459
|
-
mouse-face
|
460
|
-
(selection-face face)
|
461
|
-
(summary-face 'popup-summary-face)
|
462
|
-
scroll-bar
|
463
|
-
margin-left
|
464
|
-
margin-right
|
465
|
-
symbol
|
466
|
-
parent
|
467
|
-
parent-offset
|
468
|
-
keymap)
|
469
|
-
"Create a popup instance at POINT with WIDTH and HEIGHT.
|
470
|
-
|
471
|
-
MIN-HEIGHT is a minimal height of the popup. The default value is
|
472
|
-
0.
|
473
|
-
|
474
|
-
MAX-WIDTH is the maximum width of the popup. The default value is
|
475
|
-
nil (no limit). If a floating point, the value refers to the ratio of
|
476
|
-
the window. If an integer, limit is in characters.
|
477
|
-
|
478
|
-
If AROUND is non-nil, the popup will be displayed around the
|
479
|
-
point but not at the point.
|
480
|
-
|
481
|
-
FACE is a background face of the popup. The default value is POPUP-FACE.
|
482
|
-
|
483
|
-
SELECTION-FACE is a foreground (selection) face of the popup The
|
484
|
-
default value is POPUP-FACE.
|
485
|
-
|
486
|
-
If SCROLL-BAR is non-nil, the popup will have a scroll bar at the
|
487
|
-
right.
|
488
|
-
|
489
|
-
If MARGIN-LEFT is non-nil, the popup will have a margin at the
|
490
|
-
left.
|
491
|
-
|
492
|
-
If MARGIN-RIGHT is non-nil, the popup will have a margin at the
|
493
|
-
right.
|
494
|
-
|
495
|
-
SYMBOL is a single character which indicates a kind of the item.
|
496
|
-
|
497
|
-
PARENT is a parent popup instance. If PARENT is omitted, the
|
498
|
-
popup will be a root instance.
|
499
|
-
|
500
|
-
PARENT-OFFSET is a row offset from the parent popup.
|
501
|
-
|
502
|
-
KEYMAP is a keymap that will be put on the popup contents."
|
503
|
-
(or margin-left (setq margin-left 0))
|
504
|
-
(or margin-right (setq margin-right 0))
|
505
|
-
(unless point
|
506
|
-
(setq point
|
507
|
-
(if parent (popup-child-point parent parent-offset) (point))))
|
508
|
-
(when max-width
|
509
|
-
(setq width (min width (popup-calculate-max-width max-width))))
|
510
|
-
(save-excursion
|
511
|
-
(goto-char point)
|
512
|
-
(let* ((col-row (posn-col-row (posn-at-point)))
|
513
|
-
(row (cdr col-row))
|
514
|
-
(column (car col-row))
|
515
|
-
(overlays (make-vector height nil))
|
516
|
-
(popup-width (+ width
|
517
|
-
(if scroll-bar 1 0)
|
518
|
-
margin-left
|
519
|
-
margin-right
|
520
|
-
(if symbol 2 0)))
|
521
|
-
margin-left-cancel
|
522
|
-
(window (selected-window))
|
523
|
-
(window-start (window-start))
|
524
|
-
(window-hscroll (window-hscroll))
|
525
|
-
(window-width (window-width))
|
526
|
-
(right (+ column popup-width))
|
527
|
-
(overflow (and (> right window-width)
|
528
|
-
(>= right popup-width)))
|
529
|
-
(foldable (and (null parent)
|
530
|
-
(>= column popup-width)))
|
531
|
-
(direction (or
|
532
|
-
;; Currently the direction of cascade popup won't be changed
|
533
|
-
(and parent (popup-direction parent))
|
534
|
-
|
535
|
-
;; Calculate direction
|
536
|
-
(popup-calculate-direction height row)))
|
537
|
-
(depth (if parent (1+ (popup-depth parent)) 0))
|
538
|
-
(newlines (max 0 (+ (- height (count-lines point (point-max))) (if around 1 0))))
|
539
|
-
invis-overlays
|
540
|
-
current-column)
|
541
|
-
;; Case: no newlines at the end of the buffer
|
542
|
-
(when (> newlines 0)
|
543
|
-
(popup-save-buffer-state
|
544
|
-
(goto-char (point-max))
|
545
|
-
(insert (make-string newlines ?\n))))
|
546
|
-
|
547
|
-
;; Case: the popup overflows
|
548
|
-
(if overflow
|
549
|
-
(if foldable
|
550
|
-
(progn
|
551
|
-
(cl-decf column (- popup-width margin-left margin-right))
|
552
|
-
(unless around (move-to-column column)))
|
553
|
-
(when (not truncate-lines)
|
554
|
-
;; Truncate.
|
555
|
-
(let ((d (1+ (- popup-width (- window-width column)))))
|
556
|
-
(cl-decf popup-width d)
|
557
|
-
(cl-decf width d)))
|
558
|
-
(cl-decf column margin-left))
|
559
|
-
(cl-decf column margin-left))
|
560
|
-
|
561
|
-
;; Case: no space at the left
|
562
|
-
(when (and (null parent)
|
563
|
-
(< column 0))
|
564
|
-
;; Cancel margin left
|
565
|
-
(setq column 0)
|
566
|
-
(cl-decf popup-width margin-left)
|
567
|
-
(setq margin-left-cancel t))
|
568
|
-
|
569
|
-
(dotimes (i height)
|
570
|
-
(let (overlay begin w (dangle t) (prefix "") (postfix ""))
|
571
|
-
(when around
|
572
|
-
(popup-vertical-motion column direction))
|
573
|
-
(cl-loop for ov in (overlays-in (save-excursion
|
574
|
-
(beginning-of-visual-line)
|
575
|
-
(point))
|
576
|
-
(save-excursion
|
577
|
-
(end-of-visual-line)
|
578
|
-
(point)))
|
579
|
-
when (and (not (overlay-get ov 'popup))
|
580
|
-
(not (overlay-get ov 'popup-item))
|
581
|
-
(or (overlay-get ov 'invisible)
|
582
|
-
(overlay-get ov 'display)))
|
583
|
-
do (progn
|
584
|
-
(push (list ov (overlay-get ov 'display)) invis-overlays)
|
585
|
-
(overlay-put ov 'display "")))
|
586
|
-
(setq around t)
|
587
|
-
(setq current-column (car (posn-col-row (posn-at-point))))
|
588
|
-
|
589
|
-
(when (< current-column column)
|
590
|
-
;; Extend short buffer lines by popup prefix (line of spaces)
|
591
|
-
(setq prefix (make-string
|
592
|
-
(+ (if (= current-column 0)
|
593
|
-
(- window-hscroll current-column)
|
594
|
-
0)
|
595
|
-
(- column current-column))
|
596
|
-
? )))
|
597
|
-
|
598
|
-
(setq begin (point))
|
599
|
-
(setq w (+ popup-width (length prefix)))
|
600
|
-
(while (and (not (eolp)) (> w 0))
|
601
|
-
(setq dangle nil)
|
602
|
-
(cl-decf w (char-width (char-after)))
|
603
|
-
(forward-char))
|
604
|
-
(if (< w 0)
|
605
|
-
(setq postfix (make-string (- w) ? )))
|
606
|
-
|
607
|
-
(setq overlay (make-overlay begin (point)))
|
608
|
-
(overlay-put overlay 'popup t)
|
609
|
-
(overlay-put overlay 'window window)
|
610
|
-
(overlay-put overlay 'dangle dangle)
|
611
|
-
(overlay-put overlay 'prefix prefix)
|
612
|
-
(overlay-put overlay 'postfix postfix)
|
613
|
-
(overlay-put overlay 'width width)
|
614
|
-
(aset overlays
|
615
|
-
(if (> direction 0) i (- height i 1))
|
616
|
-
overlay)))
|
617
|
-
(cl-loop for p from (- 10000 (* depth 1000))
|
618
|
-
for overlay in (nreverse (append overlays nil))
|
619
|
-
do (overlay-put overlay 'priority p))
|
620
|
-
(let ((it (make-popup :point point
|
621
|
-
:row row
|
622
|
-
:column column
|
623
|
-
:width width
|
624
|
-
:height height
|
625
|
-
:min-height min-height
|
626
|
-
:direction direction
|
627
|
-
:parent parent
|
628
|
-
:depth depth
|
629
|
-
:face face
|
630
|
-
:mouse-face mouse-face
|
631
|
-
:selection-face selection-face
|
632
|
-
:summary-face summary-face
|
633
|
-
:margin-left margin-left
|
634
|
-
:margin-right margin-right
|
635
|
-
:margin-left-cancel margin-left-cancel
|
636
|
-
:scroll-bar scroll-bar
|
637
|
-
:symbol symbol
|
638
|
-
:cursor 0
|
639
|
-
:offset 0
|
640
|
-
:scroll-top 0
|
641
|
-
:current-height 0
|
642
|
-
:list nil
|
643
|
-
:newlines newlines
|
644
|
-
:overlays overlays
|
645
|
-
:invis-overlays invis-overlays
|
646
|
-
:keymap keymap)))
|
647
|
-
(push it popup-instances)
|
648
|
-
it))))
|
649
|
-
|
650
|
-
(defun popup-delete (popup)
|
651
|
-
"Delete POPUP instance."
|
652
|
-
(when (popup-live-p popup)
|
653
|
-
(popup-hide popup)
|
654
|
-
(mapc 'delete-overlay (popup-overlays popup))
|
655
|
-
(setf (popup-overlays popup) nil)
|
656
|
-
(setq popup-instances (delq popup popup-instances))
|
657
|
-
;; Restore newlines state
|
658
|
-
(let ((newlines (popup-newlines popup)))
|
659
|
-
(when (> newlines 0)
|
660
|
-
(popup-save-buffer-state
|
661
|
-
(goto-char (point-max))
|
662
|
-
(dotimes (i newlines)
|
663
|
-
(if (and (char-before)
|
664
|
-
(= (char-before) ?\n))
|
665
|
-
(delete-char -1)))))))
|
666
|
-
nil)
|
667
|
-
|
668
|
-
(defun popup-draw (popup)
|
669
|
-
"Draw POPUP."
|
670
|
-
(cl-loop for (ov olddisplay) in (popup-invis-overlays popup)
|
671
|
-
do (overlay-put ov 'display ""))
|
672
|
-
|
673
|
-
(cl-loop with height = (popup-height popup)
|
674
|
-
with min-height = (popup-min-height popup)
|
675
|
-
with popup-face = (popup-face popup)
|
676
|
-
with mouse-face = (popup-mouse-face popup)
|
677
|
-
with selection-face = (popup-selection-face popup)
|
678
|
-
with summary-face-0 = (popup-summary-face popup)
|
679
|
-
with list = (popup-list popup)
|
680
|
-
with length = (length list)
|
681
|
-
with thum-size = (max (/ (* height height) (max length 1)) 1)
|
682
|
-
with page-size = (/ (+ 0.0 (max length 1)) height)
|
683
|
-
with scroll-bar = (popup-scroll-bar popup)
|
684
|
-
with margin-left = (make-string (if (popup-margin-left-cancel popup) 0 (popup-margin-left popup)) ? )
|
685
|
-
with margin-right = (make-string (popup-margin-right popup) ? )
|
686
|
-
with symbol = (popup-symbol popup)
|
687
|
-
with cursor = (popup-cursor popup)
|
688
|
-
with scroll-top = (popup-scroll-top popup)
|
689
|
-
with offset = (popup-offset popup)
|
690
|
-
with keymap = (popup-keymap popup)
|
691
|
-
for o from offset
|
692
|
-
for i from scroll-top
|
693
|
-
while (< o height)
|
694
|
-
for item in (nthcdr scroll-top list)
|
695
|
-
for page-index = (* thum-size (/ o thum-size))
|
696
|
-
for face = (if (= i cursor)
|
697
|
-
(or (popup-item-selection-face item) selection-face)
|
698
|
-
(or (popup-item-face item) popup-face))
|
699
|
-
for summary-face = (unless (= i cursor) summary-face-0)
|
700
|
-
for empty-char = (propertize " " 'face face)
|
701
|
-
for scroll-bar-char = (if scroll-bar
|
702
|
-
(cond
|
703
|
-
((and (not (eq scroll-bar :always))
|
704
|
-
(<= page-size 1))
|
705
|
-
empty-char)
|
706
|
-
((and (> page-size 1)
|
707
|
-
(>= cursor (* page-index page-size))
|
708
|
-
(< cursor (* (+ page-index thum-size) page-size)))
|
709
|
-
popup-scroll-bar-foreground-char)
|
710
|
-
(t
|
711
|
-
popup-scroll-bar-background-char))
|
712
|
-
"")
|
713
|
-
for sym = (if symbol
|
714
|
-
(concat " " (or (popup-item-symbol item) " "))
|
715
|
-
"")
|
716
|
-
for summary = (or (popup-item-summary item) "")
|
717
|
-
|
718
|
-
do
|
719
|
-
;; Show line and set item to the line
|
720
|
-
(popup-set-line-item popup o
|
721
|
-
:item item
|
722
|
-
:face face
|
723
|
-
:mouse-face mouse-face
|
724
|
-
:margin-left margin-left
|
725
|
-
:margin-right margin-right
|
726
|
-
:scroll-bar-char scroll-bar-char
|
727
|
-
:symbol sym
|
728
|
-
:summary summary
|
729
|
-
:summary-face summary-face
|
730
|
-
:keymap keymap)
|
731
|
-
|
732
|
-
finally
|
733
|
-
;; Remember current height
|
734
|
-
(setf (popup-current-height popup) (- o offset))
|
735
|
-
|
736
|
-
;; Hide remaining lines
|
737
|
-
(let ((scroll-bar-char (if scroll-bar (propertize " " 'face popup-face) ""))
|
738
|
-
(symbol (if symbol " " "")))
|
739
|
-
(if (> (popup-direction popup) 0)
|
740
|
-
(progn
|
741
|
-
(when min-height
|
742
|
-
(while (< o min-height)
|
743
|
-
(popup-set-line-item popup o
|
744
|
-
:item ""
|
745
|
-
:face popup-face
|
746
|
-
:margin-left margin-left
|
747
|
-
:margin-right margin-right
|
748
|
-
:scroll-bar-char scroll-bar-char
|
749
|
-
:symbol symbol
|
750
|
-
:summary "")
|
751
|
-
(cl-incf o)))
|
752
|
-
(while (< o height)
|
753
|
-
(popup-hide-line popup o)
|
754
|
-
(cl-incf o)))
|
755
|
-
(cl-loop with h = (if min-height (- height min-height) offset)
|
756
|
-
for o from 0 below offset
|
757
|
-
if (< o h)
|
758
|
-
do (popup-hide-line popup o)
|
759
|
-
if (>= o h)
|
760
|
-
do (popup-set-line-item popup o
|
761
|
-
:item ""
|
762
|
-
:face popup-face
|
763
|
-
:margin-left margin-left
|
764
|
-
:margin-right margin-right
|
765
|
-
:scroll-bar-char scroll-bar-char
|
766
|
-
:symbol symbol
|
767
|
-
:summary ""))))))
|
768
|
-
|
769
|
-
(defun popup-hide (popup)
|
770
|
-
"Hide POPUP."
|
771
|
-
(cl-loop for (ov olddisplay) in (popup-invis-overlays popup)
|
772
|
-
do (overlay-put ov 'display olddisplay))
|
773
|
-
(dotimes (i (popup-height popup))
|
774
|
-
(popup-hide-line popup i)))
|
775
|
-
|
776
|
-
(defun popup-hidden-p (popup)
|
777
|
-
"Return non-nil if POPUP is hidden."
|
778
|
-
(let ((hidden t))
|
779
|
-
(when (popup-live-p popup)
|
780
|
-
(dotimes (i (popup-height popup))
|
781
|
-
(unless (popup-line-hidden-p popup i)
|
782
|
-
(setq hidden nil))))
|
783
|
-
hidden))
|
784
|
-
|
785
|
-
(defun popup-jump (popup cursor)
|
786
|
-
"Jump to a position specified by CURSOR of POPUP and draw."
|
787
|
-
(let ((scroll-top (popup-scroll-top popup)))
|
788
|
-
;; Do not change page as much as possible.
|
789
|
-
(unless (and (<= scroll-top cursor)
|
790
|
-
(< cursor (+ scroll-top (popup-height popup))))
|
791
|
-
(setf (popup-scroll-top popup) cursor))
|
792
|
-
(setf (popup-cursor popup) cursor)
|
793
|
-
(popup-draw popup)))
|
794
|
-
|
795
|
-
(defun popup-select (popup i)
|
796
|
-
"Select the item at I of POPUP and draw."
|
797
|
-
(setq i (+ i (popup-offset popup)))
|
798
|
-
(when (and (<= 0 i) (< i (popup-height popup)))
|
799
|
-
(setf (popup-cursor popup) i)
|
800
|
-
(popup-draw popup)
|
801
|
-
t))
|
802
|
-
|
803
|
-
(defun popup-next (popup)
|
804
|
-
"Select the next item of POPUP and draw."
|
805
|
-
(let ((height (popup-height popup))
|
806
|
-
(cursor (1+ (popup-cursor popup)))
|
807
|
-
(scroll-top (popup-scroll-top popup))
|
808
|
-
(length (length (popup-list popup))))
|
809
|
-
(cond
|
810
|
-
((>= cursor length)
|
811
|
-
;; Back to first page
|
812
|
-
(setq cursor 0
|
813
|
-
scroll-top 0))
|
814
|
-
((= cursor (+ scroll-top height))
|
815
|
-
;; Go to next page
|
816
|
-
(setq scroll-top (min (1+ scroll-top) (max (- length height) 0)))))
|
817
|
-
(setf (popup-cursor popup) cursor
|
818
|
-
(popup-scroll-top popup) scroll-top)
|
819
|
-
(popup-draw popup)))
|
820
|
-
|
821
|
-
(defun popup-previous (popup)
|
822
|
-
"Select the previous item of POPUP and draw."
|
823
|
-
(let ((height (popup-height popup))
|
824
|
-
(cursor (1- (popup-cursor popup)))
|
825
|
-
(scroll-top (popup-scroll-top popup))
|
826
|
-
(length (length (popup-list popup))))
|
827
|
-
(cond
|
828
|
-
((< cursor 0)
|
829
|
-
;; Go to last page
|
830
|
-
(setq cursor (1- length)
|
831
|
-
scroll-top (max (- length height) 0)))
|
832
|
-
((= cursor (1- scroll-top))
|
833
|
-
;; Go to previous page
|
834
|
-
(cl-decf scroll-top)))
|
835
|
-
(setf (popup-cursor popup) cursor
|
836
|
-
(popup-scroll-top popup) scroll-top)
|
837
|
-
(popup-draw popup)))
|
838
|
-
|
839
|
-
(defun popup-page-next (popup)
|
840
|
-
"Select next item of POPUP per `popup-height' range.
|
841
|
-
Pages down through POPUP."
|
842
|
-
(dotimes (counter (1- (popup-height popup)))
|
843
|
-
(popup-next popup)))
|
844
|
-
|
845
|
-
(defun popup-page-previous (popup)
|
846
|
-
"Select previous item of POPUP per `popup-height' range.
|
847
|
-
Pages up through POPUP."
|
848
|
-
(dotimes (counter (1- (popup-height popup)))
|
849
|
-
(popup-previous popup)))
|
850
|
-
|
851
|
-
(defun popup-scroll-down (popup &optional n)
|
852
|
-
"Scroll down N of POPUP and draw."
|
853
|
-
(let ((scroll-top (min (+ (popup-scroll-top popup) (or n 1))
|
854
|
-
(- (length (popup-list popup)) (popup-height popup)))))
|
855
|
-
(setf (popup-cursor popup) scroll-top
|
856
|
-
(popup-scroll-top popup) scroll-top)
|
857
|
-
(popup-draw popup)))
|
858
|
-
|
859
|
-
(defun popup-scroll-up (popup &optional n)
|
860
|
-
"Scroll up N of POPUP and draw."
|
861
|
-
(let ((scroll-top (max (- (popup-scroll-top popup) (or n 1))
|
862
|
-
0)))
|
863
|
-
(setf (popup-cursor popup) scroll-top
|
864
|
-
(popup-scroll-top popup) scroll-top)
|
865
|
-
(popup-draw popup)))
|
866
|
-
|
867
|
-
|
868
|
-
|
869
|
-
;;; Popup Incremental Search
|
870
|
-
|
871
|
-
(defface popup-isearch-match
|
872
|
-
'((t (:inherit default :background "sky blue")))
|
873
|
-
"Popup isearch match face."
|
874
|
-
:group 'popup)
|
875
|
-
|
876
|
-
(defvar popup-isearch-cursor-color "blue")
|
877
|
-
|
878
|
-
(defvar popup-isearch-keymap
|
879
|
-
(let ((map (make-sparse-keymap)))
|
880
|
-
;(define-key map "\r" 'popup-isearch-done)
|
881
|
-
(define-key map "\C-g" 'popup-isearch-cancel)
|
882
|
-
(define-key map "\C-b" 'popup-isearch-close)
|
883
|
-
(define-key map [left] 'popup-isearch-close)
|
884
|
-
(define-key map "\C-h" 'popup-isearch-delete)
|
885
|
-
(define-key map (kbd "DEL") 'popup-isearch-delete)
|
886
|
-
(define-key map (kbd "C-y") 'popup-isearch-yank)
|
887
|
-
map))
|
888
|
-
|
889
|
-
(defvar popup-menu-show-quick-help-function 'popup-menu-show-quick-help
|
890
|
-
"Function used for showing quick help by `popup-menu*'.")
|
891
|
-
|
892
|
-
(defcustom popup-isearch-regexp-builder-function #'regexp-quote
|
893
|
-
"Function used to construct a regexp from a pattern. You may for instance
|
894
|
-
provide a function that replaces spaces by '.+' if you like helm or ivy style
|
895
|
-
of completion."
|
896
|
-
:type 'function)
|
897
|
-
|
898
|
-
(defsubst popup-isearch-char-p (char)
|
899
|
-
(and (integerp char)
|
900
|
-
(<= 32 char)
|
901
|
-
(<= char 126)))
|
902
|
-
|
903
|
-
(defun popup-isearch-filter-list (pattern list)
|
904
|
-
(cl-loop with regexp = (funcall popup-isearch-regexp-builder-function pattern)
|
905
|
-
for item in list
|
906
|
-
do
|
907
|
-
(unless (stringp item)
|
908
|
-
(setq item (popup-item-propertize (popup-x-to-string item)
|
909
|
-
'value item)))
|
910
|
-
if (string-match regexp item)
|
911
|
-
collect
|
912
|
-
(let ((beg (match-beginning 0))
|
913
|
-
(end (match-end 0)))
|
914
|
-
(alter-text-property 0 (length item) 'face
|
915
|
-
(lambda (prop)
|
916
|
-
(unless (eq prop 'popup-isearch-match)
|
917
|
-
prop))
|
918
|
-
item)
|
919
|
-
(put-text-property beg end
|
920
|
-
'face 'popup-isearch-match
|
921
|
-
item)
|
922
|
-
item)))
|
923
|
-
|
924
|
-
(defun popup-isearch-prompt (popup pattern)
|
925
|
-
(format "Pattern: %s" (if (= (length (popup-list popup)) 0)
|
926
|
-
(propertize pattern 'face 'isearch-fail)
|
927
|
-
pattern)))
|
928
|
-
|
929
|
-
(defun popup-isearch-update (popup filter pattern &optional callback)
|
930
|
-
(setf (popup-cursor popup) 0
|
931
|
-
(popup-scroll-top popup) 0
|
932
|
-
(popup-pattern popup) pattern)
|
933
|
-
(let ((list (funcall filter pattern (popup-original-list popup))))
|
934
|
-
(popup-set-filtered-list popup list)
|
935
|
-
(if callback
|
936
|
-
(funcall callback list)))
|
937
|
-
(popup-draw popup))
|
938
|
-
|
939
|
-
(cl-defun popup-isearch (popup
|
940
|
-
&key
|
941
|
-
(filter 'popup-isearch-filter-list)
|
942
|
-
(cursor-color popup-isearch-cursor-color)
|
943
|
-
(keymap popup-isearch-keymap)
|
944
|
-
callback
|
945
|
-
help-delay)
|
946
|
-
"Start isearch on POPUP. This function is synchronized, meaning
|
947
|
-
event loop waits for quiting of isearch.
|
948
|
-
|
949
|
-
FILTER is function with two argumenst to perform popup items filtering.
|
950
|
-
|
951
|
-
CURSOR-COLOR is a cursor color during isearch. The default value
|
952
|
-
is `popup-isearch-cursor-color'.
|
953
|
-
|
954
|
-
KEYMAP is a keymap which is used when processing events during
|
955
|
-
event loop. The default value is `popup-isearch-keymap'.
|
956
|
-
|
957
|
-
CALLBACK is a function taking one argument. `popup-isearch' calls
|
958
|
-
CALLBACK, if specified, after isearch finished or isearch
|
959
|
-
canceled. The arguments is whole filtered list of items.
|
960
|
-
|
961
|
-
HELP-DELAY is a delay of displaying helps."
|
962
|
-
(let ((list (popup-original-list popup))
|
963
|
-
(pattern (or (popup-pattern popup) ""))
|
964
|
-
(old-cursor-color (frame-parameter (selected-frame) 'cursor-color))
|
965
|
-
prompt key binding)
|
966
|
-
(unwind-protect
|
967
|
-
(cl-block nil
|
968
|
-
(if cursor-color
|
969
|
-
(set-cursor-color cursor-color))
|
970
|
-
(while t
|
971
|
-
(setq prompt (popup-isearch-prompt popup pattern))
|
972
|
-
(setq key (popup-menu-read-key-sequence keymap prompt help-delay))
|
973
|
-
(if (null key)
|
974
|
-
(unless (funcall popup-menu-show-quick-help-function popup nil :prompt prompt)
|
975
|
-
(clear-this-command-keys)
|
976
|
-
(push (read-event prompt) unread-command-events))
|
977
|
-
(setq binding (lookup-key keymap key))
|
978
|
-
(cond
|
979
|
-
((and (stringp key)
|
980
|
-
(popup-isearch-char-p (aref key 0)))
|
981
|
-
(setq pattern (concat pattern key)))
|
982
|
-
((eq binding 'popup-isearch-done)
|
983
|
-
(cl-return nil))
|
984
|
-
((eq binding 'popup-isearch-cancel)
|
985
|
-
(popup-isearch-update popup filter "" callback)
|
986
|
-
(cl-return t))
|
987
|
-
((eq binding 'popup-isearch-close)
|
988
|
-
(popup-isearch-update popup filter "" callback)
|
989
|
-
(setq unread-command-events
|
990
|
-
(append (listify-key-sequence key) unread-command-events))
|
991
|
-
(cl-return nil))
|
992
|
-
((eq binding 'popup-isearch-delete)
|
993
|
-
(if (> (length pattern) 0)
|
994
|
-
(setq pattern (substring pattern 0 (1- (length pattern))))))
|
995
|
-
((eq binding 'popup-isearch-yank)
|
996
|
-
(popup-isearch-update popup filter (car kill-ring) callback)
|
997
|
-
(cl-return nil))
|
998
|
-
(t
|
999
|
-
(setq unread-command-events
|
1000
|
-
(append (listify-key-sequence key) unread-command-events))
|
1001
|
-
(cl-return nil)))
|
1002
|
-
(popup-isearch-update popup filter pattern callback))))
|
1003
|
-
(if old-cursor-color
|
1004
|
-
(set-cursor-color old-cursor-color)))))
|
1005
|
-
|
1006
|
-
|
1007
|
-
|
1008
|
-
;;; Popup Tip
|
1009
|
-
|
1010
|
-
(defface popup-tip-face
|
1011
|
-
'((t (:background "khaki1" :foreground "black")))
|
1012
|
-
"Face for popup tip."
|
1013
|
-
:group 'popup)
|
1014
|
-
|
1015
|
-
(defvar popup-tip-max-width 80)
|
1016
|
-
|
1017
|
-
(cl-defun popup-tip (string
|
1018
|
-
&key
|
1019
|
-
point
|
1020
|
-
(around t)
|
1021
|
-
width
|
1022
|
-
(height 15)
|
1023
|
-
min-height
|
1024
|
-
max-width
|
1025
|
-
truncate
|
1026
|
-
margin
|
1027
|
-
margin-left
|
1028
|
-
margin-right
|
1029
|
-
scroll-bar
|
1030
|
-
parent
|
1031
|
-
parent-offset
|
1032
|
-
nowait
|
1033
|
-
nostrip
|
1034
|
-
prompt
|
1035
|
-
&aux tip lines)
|
1036
|
-
"Show a tooltip of STRING at POINT. This function is
|
1037
|
-
synchronized unless NOWAIT specified. Almost all arguments are
|
1038
|
-
the same as in `popup-create', except for TRUNCATE, NOWAIT, and
|
1039
|
-
PROMPT.
|
1040
|
-
|
1041
|
-
If TRUNCATE is non-nil, the tooltip can be truncated.
|
1042
|
-
|
1043
|
-
If NOWAIT is non-nil, this function immediately returns the
|
1044
|
-
tooltip instance without entering event loop.
|
1045
|
-
|
1046
|
-
If `NOSTRIP` is non-nil, `STRING` properties are not stripped.
|
1047
|
-
|
1048
|
-
PROMPT is a prompt string when reading events during event loop."
|
1049
|
-
(if (bufferp string)
|
1050
|
-
(setq string (with-current-buffer string (buffer-string))))
|
1051
|
-
|
1052
|
-
(unless nostrip
|
1053
|
-
;; TODO strip text (mainly face) properties
|
1054
|
-
(setq string (substring-no-properties string)))
|
1055
|
-
|
1056
|
-
(and (eq margin t) (setq margin 1))
|
1057
|
-
(or margin-left (setq margin-left margin))
|
1058
|
-
(or margin-right (setq margin-right margin))
|
1059
|
-
|
1060
|
-
(let ((it (popup-fill-string string width popup-tip-max-width)))
|
1061
|
-
(setq width (car it)
|
1062
|
-
lines (cdr it)))
|
1063
|
-
|
1064
|
-
(setq tip (popup-create point width height
|
1065
|
-
:min-height min-height
|
1066
|
-
:max-width max-width
|
1067
|
-
:around around
|
1068
|
-
:margin-left margin-left
|
1069
|
-
:margin-right margin-right
|
1070
|
-
:scroll-bar scroll-bar
|
1071
|
-
:face 'popup-tip-face
|
1072
|
-
:parent parent
|
1073
|
-
:parent-offset parent-offset))
|
1074
|
-
|
1075
|
-
(unwind-protect
|
1076
|
-
(when (> (popup-width tip) 0) ; not to be corrupted
|
1077
|
-
(when (and (not (eq width (popup-width tip))) ; truncated
|
1078
|
-
(not truncate))
|
1079
|
-
;; Refill once again to lines be fitted to popup width
|
1080
|
-
(setq width (popup-width tip))
|
1081
|
-
(setq lines (cdr (popup-fill-string string width width))))
|
1082
|
-
|
1083
|
-
(popup-set-list tip lines)
|
1084
|
-
(popup-draw tip)
|
1085
|
-
(if nowait
|
1086
|
-
tip
|
1087
|
-
(clear-this-command-keys)
|
1088
|
-
(push (read-event prompt) unread-command-events)
|
1089
|
-
t))
|
1090
|
-
(unless nowait
|
1091
|
-
(popup-delete tip))))
|
1092
|
-
|
1093
|
-
|
1094
|
-
|
1095
|
-
;;; Popup Menu
|
1096
|
-
|
1097
|
-
(defface popup-menu-face
|
1098
|
-
'((t (:inherit popup-face)))
|
1099
|
-
"Face for popup menu."
|
1100
|
-
:group 'popup)
|
1101
|
-
|
1102
|
-
(defface popup-menu-mouse-face
|
1103
|
-
'((t (:background "blue" :foreground "white")))
|
1104
|
-
"Face for popup menu."
|
1105
|
-
:group 'popup)
|
1106
|
-
|
1107
|
-
(defface popup-menu-selection-face
|
1108
|
-
'((t (:inherit default :background "steelblue" :foreground "white")))
|
1109
|
-
"Face for popup menu selection."
|
1110
|
-
:group 'popup)
|
1111
|
-
|
1112
|
-
(defface popup-menu-summary-face
|
1113
|
-
'((t (:inherit popup-summary-face)))
|
1114
|
-
"Face for popup summary."
|
1115
|
-
:group 'popup)
|
1116
|
-
|
1117
|
-
(defvar popup-menu-show-tip-function 'popup-tip
|
1118
|
-
"Function used for showing tooltip by `popup-menu-show-quick-help'.")
|
1119
|
-
|
1120
|
-
(defun popup-menu-show-help (menu &optional persist item)
|
1121
|
-
(popup-item-show-help (or item (popup-selected-item menu)) persist))
|
1122
|
-
|
1123
|
-
(defun popup-menu-documentation (menu &optional item)
|
1124
|
-
(popup-item-documentation (or item (popup-selected-item menu))))
|
1125
|
-
|
1126
|
-
(defun popup-menu-show-quick-help (menu &optional item &rest args)
|
1127
|
-
(let* ((point (plist-get args :point))
|
1128
|
-
(height (or (plist-get args :height) (popup-height menu)))
|
1129
|
-
(min-height (min height (popup-current-height menu)))
|
1130
|
-
(around nil)
|
1131
|
-
(parent-offset (popup-offset menu))
|
1132
|
-
(doc (popup-menu-documentation menu item)))
|
1133
|
-
(when (stringp doc)
|
1134
|
-
(if (popup-hidden-p menu)
|
1135
|
-
(setq around t
|
1136
|
-
menu nil
|
1137
|
-
parent-offset nil)
|
1138
|
-
(setq point nil))
|
1139
|
-
(let ((popup-use-optimized-column-computation nil)) ; To avoid wrong positioning
|
1140
|
-
(apply popup-menu-show-tip-function
|
1141
|
-
doc
|
1142
|
-
:point point
|
1143
|
-
:height height
|
1144
|
-
:min-height min-height
|
1145
|
-
:around around
|
1146
|
-
:parent menu
|
1147
|
-
:parent-offset parent-offset
|
1148
|
-
args)))))
|
1149
|
-
|
1150
|
-
(defun popup-menu-item-of-mouse-event (event)
|
1151
|
-
(when (and (consp event)
|
1152
|
-
(memq (cl-first event) '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)))
|
1153
|
-
(let* ((position (cl-second event))
|
1154
|
-
(object (elt position 4)))
|
1155
|
-
(when (consp object)
|
1156
|
-
(get-text-property (cdr object) 'popup-item (car object))))))
|
1157
|
-
|
1158
|
-
(defun popup-menu-read-key-sequence (keymap &optional prompt timeout)
|
1159
|
-
(catch 'timeout
|
1160
|
-
(let ((timer (and timeout
|
1161
|
-
(run-with-timer timeout nil
|
1162
|
-
(lambda ()
|
1163
|
-
(if (zerop (length (this-command-keys)))
|
1164
|
-
(throw 'timeout nil))))))
|
1165
|
-
(old-global-map (current-global-map))
|
1166
|
-
(temp-global-map (make-sparse-keymap))
|
1167
|
-
(overriding-terminal-local-map (make-sparse-keymap)))
|
1168
|
-
(substitute-key-definition 'keyboard-quit 'keyboard-quit
|
1169
|
-
temp-global-map old-global-map)
|
1170
|
-
(define-key temp-global-map [menu-bar] (lookup-key old-global-map [menu-bar]))
|
1171
|
-
(define-key temp-global-map [tool-bar] (lookup-key old-global-map [tool-bar]))
|
1172
|
-
(set-keymap-parent overriding-terminal-local-map keymap)
|
1173
|
-
(if (current-local-map)
|
1174
|
-
(define-key overriding-terminal-local-map [menu-bar]
|
1175
|
-
(lookup-key (current-local-map) [menu-bar])))
|
1176
|
-
(unwind-protect
|
1177
|
-
(progn
|
1178
|
-
(use-global-map temp-global-map)
|
1179
|
-
(clear-this-command-keys)
|
1180
|
-
(with-temp-message prompt
|
1181
|
-
(read-key-sequence nil)))
|
1182
|
-
(use-global-map old-global-map)
|
1183
|
-
(if timer (cancel-timer timer))))))
|
1184
|
-
|
1185
|
-
(defun popup-menu-fallback (event default))
|
1186
|
-
|
1187
|
-
(cl-defun popup-menu-event-loop (menu
|
1188
|
-
keymap
|
1189
|
-
fallback
|
1190
|
-
&key
|
1191
|
-
prompt
|
1192
|
-
help-delay
|
1193
|
-
isearch
|
1194
|
-
isearch-filter
|
1195
|
-
isearch-cursor-color
|
1196
|
-
isearch-keymap
|
1197
|
-
isearch-callback
|
1198
|
-
&aux key binding)
|
1199
|
-
(cl-block nil
|
1200
|
-
(while (popup-live-p menu)
|
1201
|
-
(and isearch
|
1202
|
-
(popup-isearch menu
|
1203
|
-
:filter isearch-filter
|
1204
|
-
:cursor-color isearch-cursor-color
|
1205
|
-
:keymap isearch-keymap
|
1206
|
-
:callback isearch-callback
|
1207
|
-
:help-delay help-delay)
|
1208
|
-
(keyboard-quit))
|
1209
|
-
(setq key (popup-menu-read-key-sequence keymap prompt help-delay))
|
1210
|
-
(setq binding (and key (lookup-key keymap key)))
|
1211
|
-
(cond
|
1212
|
-
((or (null key) (zerop (length key)))
|
1213
|
-
(unless (funcall popup-menu-show-quick-help-function menu nil :prompt prompt)
|
1214
|
-
(clear-this-command-keys)
|
1215
|
-
(push (read-event prompt) unread-command-events)))
|
1216
|
-
((eq (lookup-key (current-global-map) key) 'keyboard-quit)
|
1217
|
-
(keyboard-quit)
|
1218
|
-
(cl-return))
|
1219
|
-
((eq binding 'popup-close)
|
1220
|
-
(if (popup-parent menu)
|
1221
|
-
(cl-return)))
|
1222
|
-
((memq binding '(popup-select popup-open))
|
1223
|
-
(let* ((item (or (popup-menu-item-of-mouse-event (elt key 0))
|
1224
|
-
(popup-selected-item menu)))
|
1225
|
-
(index (cl-position item (popup-list menu)))
|
1226
|
-
(sublist (popup-item-sublist item)))
|
1227
|
-
(unless index (cl-return))
|
1228
|
-
(if sublist
|
1229
|
-
(popup-aif (let (popup-use-optimized-column-computation)
|
1230
|
-
(popup-cascade-menu sublist
|
1231
|
-
:around nil
|
1232
|
-
:margin-left (popup-margin-left menu)
|
1233
|
-
:margin-right (popup-margin-right menu)
|
1234
|
-
:scroll-bar (popup-scroll-bar menu)
|
1235
|
-
:parent menu
|
1236
|
-
:parent-offset index
|
1237
|
-
:help-delay help-delay
|
1238
|
-
:isearch isearch
|
1239
|
-
:isearch-filter isearch-filter
|
1240
|
-
:isearch-cursor-color isearch-cursor-color
|
1241
|
-
:isearch-keymap isearch-keymap
|
1242
|
-
:isearch-callback isearch-callback))
|
1243
|
-
(and it (cl-return it)))
|
1244
|
-
(if (eq binding 'popup-select)
|
1245
|
-
(cl-return (popup-item-value-or-self item))))))
|
1246
|
-
((eq binding 'popup-next)
|
1247
|
-
(popup-next menu))
|
1248
|
-
((eq binding 'popup-previous)
|
1249
|
-
(popup-previous menu))
|
1250
|
-
((eq binding 'popup-page-next)
|
1251
|
-
(popup-page-next menu))
|
1252
|
-
((eq binding 'popup-page-previous)
|
1253
|
-
(popup-page-previous menu))
|
1254
|
-
((eq binding 'popup-help)
|
1255
|
-
(popup-menu-show-help menu))
|
1256
|
-
((eq binding 'popup-isearch)
|
1257
|
-
(popup-isearch menu
|
1258
|
-
:filter isearch-filter
|
1259
|
-
:cursor-color isearch-cursor-color
|
1260
|
-
:keymap isearch-keymap
|
1261
|
-
:callback isearch-callback
|
1262
|
-
:help-delay help-delay))
|
1263
|
-
((commandp binding)
|
1264
|
-
(call-interactively binding))
|
1265
|
-
(t
|
1266
|
-
(funcall fallback key (key-binding key)))))))
|
1267
|
-
|
1268
|
-
(defun popup-preferred-width (list)
|
1269
|
-
"Return the preferred width to show LIST beautifully."
|
1270
|
-
(cl-loop with tab-width = 4
|
1271
|
-
for item in list
|
1272
|
-
for summary = (popup-item-summary item)
|
1273
|
-
maximize (string-width (popup-x-to-string item)) into width
|
1274
|
-
if (stringp summary)
|
1275
|
-
maximize (+ (string-width summary) 2) into summary-width
|
1276
|
-
finally return
|
1277
|
-
(let ((total (+ (or width 0) (or summary-width 0))))
|
1278
|
-
(* (ceiling (/ total 10.0)) 10))))
|
1279
|
-
|
1280
|
-
(defvar popup-menu-keymap
|
1281
|
-
(let ((map (make-sparse-keymap)))
|
1282
|
-
(define-key map "\r" 'popup-select)
|
1283
|
-
(define-key map "\C-f" 'popup-open)
|
1284
|
-
(define-key map [right] 'popup-open)
|
1285
|
-
(define-key map "\C-b" 'popup-close)
|
1286
|
-
(define-key map [left] 'popup-close)
|
1287
|
-
|
1288
|
-
(define-key map "\C-n" 'popup-next)
|
1289
|
-
(define-key map [down] 'popup-next)
|
1290
|
-
(define-key map "\C-p" 'popup-previous)
|
1291
|
-
(define-key map [up] 'popup-previous)
|
1292
|
-
|
1293
|
-
(define-key map [next] 'popup-page-next)
|
1294
|
-
(define-key map [prior] 'popup-page-previous)
|
1295
|
-
|
1296
|
-
(define-key map [f1] 'popup-help)
|
1297
|
-
(define-key map (kbd "\C-?") 'popup-help)
|
1298
|
-
|
1299
|
-
(define-key map "\C-s" 'popup-isearch)
|
1300
|
-
|
1301
|
-
(define-key map [mouse-1] 'popup-select)
|
1302
|
-
(define-key map [mouse-4] 'popup-previous)
|
1303
|
-
(define-key map [mouse-5] 'popup-next)
|
1304
|
-
map))
|
1305
|
-
|
1306
|
-
(cl-defun popup-menu* (list
|
1307
|
-
&key
|
1308
|
-
point
|
1309
|
-
(around t)
|
1310
|
-
(width (popup-preferred-width list))
|
1311
|
-
(height 15)
|
1312
|
-
max-width
|
1313
|
-
margin
|
1314
|
-
margin-left
|
1315
|
-
margin-right
|
1316
|
-
scroll-bar
|
1317
|
-
symbol
|
1318
|
-
parent
|
1319
|
-
parent-offset
|
1320
|
-
cursor
|
1321
|
-
(keymap popup-menu-keymap)
|
1322
|
-
(fallback 'popup-menu-fallback)
|
1323
|
-
help-delay
|
1324
|
-
nowait
|
1325
|
-
prompt
|
1326
|
-
isearch
|
1327
|
-
(isearch-filter 'popup-isearch-filter-list)
|
1328
|
-
(isearch-cursor-color popup-isearch-cursor-color)
|
1329
|
-
(isearch-keymap popup-isearch-keymap)
|
1330
|
-
isearch-callback
|
1331
|
-
initial-index
|
1332
|
-
&aux menu event)
|
1333
|
-
"Show a popup menu of LIST at POINT. This function returns a
|
1334
|
-
value of the selected item. Almost all arguments are the same as in
|
1335
|
-
`popup-create', except for KEYMAP, FALLBACK, HELP-DELAY, PROMPT,
|
1336
|
-
ISEARCH, ISEARCH-FILTER, ISEARCH-CURSOR-COLOR, ISEARCH-KEYMAP, and
|
1337
|
-
ISEARCH-CALLBACK.
|
1338
|
-
|
1339
|
-
If KEYMAP is a keymap which is used when processing events during
|
1340
|
-
event loop.
|
1341
|
-
|
1342
|
-
If FALLBACK is a function taking two arguments; a key and a
|
1343
|
-
command. FALLBACK is called when no special operation is found on
|
1344
|
-
the key. The default value is `popup-menu-fallback', which does
|
1345
|
-
nothing.
|
1346
|
-
|
1347
|
-
HELP-DELAY is a delay of displaying helps.
|
1348
|
-
|
1349
|
-
If NOWAIT is non-nil, this function immediately returns the menu
|
1350
|
-
instance without entering event loop.
|
1351
|
-
|
1352
|
-
PROMPT is a prompt string when reading events during event loop.
|
1353
|
-
|
1354
|
-
If ISEARCH is non-nil, do isearch as soon as displaying the popup
|
1355
|
-
menu.
|
1356
|
-
|
1357
|
-
ISEARCH-FILTER is a filtering function taking two arguments:
|
1358
|
-
search pattern and list of items. Returns a list of matching items.
|
1359
|
-
|
1360
|
-
ISEARCH-CURSOR-COLOR is a cursor color during isearch. The
|
1361
|
-
default value is `popup-isearch-cursor-color'.
|
1362
|
-
|
1363
|
-
ISEARCH-KEYMAP is a keymap which is used when processing events
|
1364
|
-
during event loop. The default value is `popup-isearch-keymap'.
|
1365
|
-
|
1366
|
-
ISEARCH-CALLBACK is a function taking one argument. `popup-menu'
|
1367
|
-
calls ISEARCH-CALLBACK, if specified, after isearch finished or
|
1368
|
-
isearch canceled. The arguments is whole filtered list of items.
|
1369
|
-
|
1370
|
-
If `INITIAL-INDEX' is non-nil, this is an initial index value for
|
1371
|
-
`popup-select'. Only positive integer is valid."
|
1372
|
-
(and (eq margin t) (setq margin 1))
|
1373
|
-
(or margin-left (setq margin-left margin))
|
1374
|
-
(or margin-right (setq margin-right margin))
|
1375
|
-
(if (and scroll-bar
|
1376
|
-
(integerp margin-right)
|
1377
|
-
(> margin-right 0))
|
1378
|
-
;; Make scroll-bar space as margin-right
|
1379
|
-
(cl-decf margin-right))
|
1380
|
-
(setq menu (popup-create point width height
|
1381
|
-
:max-width max-width
|
1382
|
-
:around around
|
1383
|
-
:face 'popup-menu-face
|
1384
|
-
:mouse-face 'popup-menu-mouse-face
|
1385
|
-
:selection-face 'popup-menu-selection-face
|
1386
|
-
:summary-face 'popup-menu-summary-face
|
1387
|
-
:margin-left margin-left
|
1388
|
-
:margin-right margin-right
|
1389
|
-
:scroll-bar scroll-bar
|
1390
|
-
:symbol symbol
|
1391
|
-
:parent parent
|
1392
|
-
:parent-offset parent-offset))
|
1393
|
-
(unwind-protect
|
1394
|
-
(progn
|
1395
|
-
(popup-set-list menu list)
|
1396
|
-
(if cursor
|
1397
|
-
(popup-jump menu cursor)
|
1398
|
-
(popup-draw menu))
|
1399
|
-
(when initial-index
|
1400
|
-
(dotimes (_i (min (- (length list) 1) initial-index))
|
1401
|
-
(popup-next menu)))
|
1402
|
-
(if nowait
|
1403
|
-
menu
|
1404
|
-
(popup-menu-event-loop menu keymap fallback
|
1405
|
-
:prompt prompt
|
1406
|
-
:help-delay help-delay
|
1407
|
-
:isearch isearch
|
1408
|
-
:isearch-filter isearch-filter
|
1409
|
-
:isearch-cursor-color isearch-cursor-color
|
1410
|
-
:isearch-keymap isearch-keymap
|
1411
|
-
:isearch-callback isearch-callback)))
|
1412
|
-
(unless nowait
|
1413
|
-
(popup-delete menu))))
|
1414
|
-
|
1415
|
-
(defun popup-cascade-menu (list &rest args)
|
1416
|
-
"Same as `popup-menu' except that an element of LIST can be
|
1417
|
-
also a sub-menu if the element is a cons cell formed (ITEM
|
1418
|
-
. SUBLIST) where ITEM is an usual item and SUBLIST is a list of
|
1419
|
-
the sub menu."
|
1420
|
-
(apply 'popup-menu*
|
1421
|
-
(mapcar (lambda (item)
|
1422
|
-
(if (consp item)
|
1423
|
-
(popup-make-item (car item)
|
1424
|
-
:sublist (cdr item)
|
1425
|
-
:symbol ">")
|
1426
|
-
item))
|
1427
|
-
list)
|
1428
|
-
:symbol t
|
1429
|
-
args))
|
1430
|
-
|
1431
|
-
(provide 'popup)
|
1432
|
-
;;; popup.el ends here
|