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.
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