ruby_learner 1.1.2 → 1.1.3

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (94) hide show
  1. checksums.yaml +4 -4
  2. data/Gemfile.lock +1 -1
  3. data/docs/thesis/competing_services.org +21 -0
  4. data/docs/thesis/manual.org +55 -0
  5. data/docs/thesis/mid_term.pptx +0 -0
  6. data/lib/ruby_learner/common.rb +45 -0
  7. data/lib/ruby_learner/ruby_learner.rb +9 -17
  8. data/lib/ruby_learner/sequential_main.rb +146 -0
  9. data/lib/ruby_learner/typing_practice.rb +82 -10
  10. data/lib/ruby_learner/version.rb +1 -1
  11. data/workshop/emacs.d/init.el +1 -76
  12. data/workshop/emacs.d/ruby_learner_init.el +0 -76
  13. metadata +7 -83
  14. data/lib/ruby_learner/methods.rb +0 -290
  15. data/workshop/emacs.d/#init# +0 -1
  16. data/workshop/emacs.d/ac-comphist.dat +0 -50
  17. data/workshop/emacs.d/cp5022x.el +0 -156
  18. data/workshop/emacs.d/elpa/archives/gnu/archive-contents +0 -1240
  19. data/workshop/emacs.d/elpa/archives/melpa/archive-contents +0 -2
  20. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-autoloads.el +0 -65
  21. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-config.el +0 -551
  22. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-config.elc +0 -0
  23. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-pkg.el +0 -6
  24. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete.el +0 -2164
  25. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete.elc +0 -0
  26. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ada-mode +0 -72
  27. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/c++-mode +0 -99
  28. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/c-mode +0 -55
  29. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/caml-mode +0 -231
  30. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/clojure-mode +0 -580
  31. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/clojurescript-mode +0 -475
  32. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/coq-mode +0 -278
  33. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/css-mode +0 -874
  34. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/erlang-mode +0 -216
  35. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ess-julia-mode +0 -37
  36. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/go-mode +0 -25
  37. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/haskell-mode +0 -679
  38. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/java-mode +0 -53
  39. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/js-mode +0 -148
  40. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/julia-mode +0 -37
  41. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/lua-mode +0 -21
  42. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/nim-mode +0 -70
  43. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/objc-mode +0 -161
  44. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/octave-mode +0 -46
  45. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/php-mode +0 -6144
  46. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/python-mode +0 -379
  47. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/qml-mode +0 -183
  48. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ruby-mode +0 -181
  49. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/scala-mode +0 -1347
  50. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/scheme-mode +0 -216
  51. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/sclang-mode +0 -1481
  52. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/sh-mode +0 -182
  53. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/swift-mode +0 -87
  54. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/tcl-mode +0 -172
  55. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ts-mode +0 -797
  56. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/tuareg-mode +0 -231
  57. data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/verilog-mode +0 -313
  58. data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults-autoloads.el +0 -16
  59. data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults-pkg.el +0 -2
  60. data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults.el +0 -90
  61. data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults.elc +0 -0
  62. data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode-autoloads.el +0 -26
  63. data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode-pkg.el +0 -2
  64. data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode.el +0 -877
  65. data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode.elc +0 -0
  66. data/workshop/emacs.d/elpa/haml-mode-readme.txt +0 -8
  67. data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-light-theme.el +0 -918
  68. data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-light-theme.elc +0 -0
  69. data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme-autoloads.el +0 -32
  70. data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme-pkg.el +0 -8
  71. data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme.el +0 -912
  72. data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme.elc +0 -0
  73. data/workshop/emacs.d/elpa/ox-bibtex-chinese-readme.txt +0 -21
  74. data/workshop/emacs.d/elpa/popup-20160709.729/popup-autoloads.el +0 -15
  75. data/workshop/emacs.d/elpa/popup-20160709.729/popup-pkg.el +0 -2
  76. data/workshop/emacs.d/elpa/popup-20160709.729/popup.el +0 -1432
  77. data/workshop/emacs.d/elpa/popup-20160709.729/popup.elc +0 -0
  78. data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode-autoloads.el +0 -33
  79. data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode-pkg.el +0 -2
  80. data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode.el +0 -470
  81. data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode.elc +0 -0
  82. data/workshop/emacs.d/elpa/yaml-mode-readme.txt +0 -25
  83. data/workshop/emacs.d/haml-mode-master/.gitignore +0 -1
  84. data/workshop/emacs.d/haml-mode-master/.mailmap +0 -2
  85. data/workshop/emacs.d/haml-mode-master/MIT-LICENSE +0 -20
  86. data/workshop/emacs.d/haml-mode-master/README.md +0 -47
  87. data/workshop/emacs.d/haml-mode-master/haml-mode.el +0 -887
  88. data/workshop/emacs.d/iceberg_theme.el +0 -202
  89. data/workshop/emacs.d/init-open-recentf.el +0 -133
  90. data/workshop/emacs.d/install-elisp.el +0 -366
  91. data/workshop/emacs.d/notes +0 -12
  92. data/workshop/emacs.d/processing-mode/processing-mode.el +0 -275
  93. data/workshop/emacs.d/recentf +0 -31
  94. data/workshop/emacs.d/wiki-mode/wiki.el +0 -976
@@ -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,2 +0,0 @@
1
- ;;; -*- no-byte-compile: t -*-
2
- (define-package "popup" "20160709.729" "Visual Popup User Interface" '((cl-lib "0.5")) :commit "80829dd46381754639fb764da11c67235fe63282" :keywords '("lisp"))
@@ -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