ruby_learner 1.0.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +7 -0
- data/.gitignore +11 -0
- data/.rspec +3 -0
- data/.travis.yml +5 -0
- data/CODE_OF_CONDUCT.md +74 -0
- data/Gemfile +6 -0
- data/Gemfile.lock +58 -0
- data/LICENSE.txt +21 -0
- data/README.md +65 -0
- data/Rakefile +6 -0
- data/bin/console +14 -0
- data/bin/new_terminal +25 -0
- data/bin/setup +8 -0
- data/docs/happy_ruby/RussOlsen_EloquentRuby_c1.pdf +0 -0
- data/docs/happy_ruby/RussOlsen_EloquentRuby_c5.pdf +0 -0
- data/docs/happy_ruby/TanoshiiRuby_v3_c23.pdf +0 -0
- data/docs/happy_ruby/TanoshiiRuby_v5_c1.pdf +0 -0
- data/docs/happy_ruby/TanoshiiRuby_v5_c2-3.pdf +0 -0
- data/docs/happy_ruby/c2.ipynb +479 -0
- data/docs/happy_ruby/c3_4.ipynb +237 -0
- data/docs/seminar/8-1.org +18 -0
- data/exe/ruby_learner +5 -0
- data/lib/ruby_learner/h.rb +14 -0
- data/lib/ruby_learner/methods.rb +131 -0
- data/lib/ruby_learner/random_h.rb +16 -0
- data/lib/ruby_learner/ruby_learner.rb +43 -0
- data/lib/ruby_learner/sequential_h.rb +15 -0
- data/lib/ruby_learner/typing_practice.rb +21 -0
- data/lib/ruby_learner/version.rb +3 -0
- data/questions/random_check/.rspec +1 -0
- data/questions/random_check/random_h.rb +16 -0
- data/questions/random_check/section_1/.rspec +1 -0
- data/questions/random_check/section_1/lib/answer.rb +15 -0
- data/questions/random_check/section_1/lib/sentence.org +9 -0
- data/questions/random_check/section_1/lib/workplace.rb +5 -0
- data/questions/random_check/section_1/spec/spec_helper.rb +100 -0
- data/questions/random_check/section_1/spec/workplace_spec.rb +10 -0
- data/questions/random_check/section_2/.rspec +1 -0
- data/questions/random_check/section_2/lib/answer.rb +17 -0
- data/questions/random_check/section_2/lib/sentence.org +12 -0
- data/questions/random_check/section_2/lib/workplace.rb +5 -0
- data/questions/random_check/section_2/spec/.rspec +1 -0
- data/questions/random_check/section_2/spec/spec_helper.rb +100 -0
- data/questions/random_check/section_2/spec/workplace_spec.rb +11 -0
- data/questions/sequential_check/section_1/part_1/lib/answer.rb +9 -0
- data/questions/sequential_check/section_1/part_1/lib/sentence.org +9 -0
- data/questions/sequential_check/section_1/part_1/lib/workplace.rb +5 -0
- data/questions/sequential_check/section_1/part_1/spec/spec_helper.rb +100 -0
- data/questions/sequential_check/section_1/part_1/spec/workplace_spec.rb +10 -0
- data/questions/sequential_check/section_1/part_2/lib/answer.rb +16 -0
- data/questions/sequential_check/section_1/part_2/lib/sentence.org +12 -0
- data/questions/sequential_check/section_1/part_2/lib/workplace.rb +5 -0
- data/questions/sequential_check/section_1/part_2/spec/.rspec +1 -0
- data/questions/sequential_check/section_1/part_2/spec/spec_helper.rb +100 -0
- data/questions/sequential_check/section_1/part_2/spec/workplace_spec.rb +11 -0
- data/ruby_learner.gemspec +41 -0
- data/takahashi/docs/README.org +139 -0
- data/takahashi/docs/drill.html +875 -0
- data/takahashi/docs/drill.html~ +877 -0
- data/takahashi/docs/drill.org +446 -0
- data/takahashi/docs/ruby_for_beginner.html +2642 -0
- data/takahashi/docs/ruby_for_beginner.org +1430 -0
- data/takahashi/sample_prog/answer/10_1.rb +5 -0
- data/takahashi/sample_prog/answer/11_1.rb +5 -0
- data/takahashi/sample_prog/answer/11_2.rb +4 -0
- data/takahashi/sample_prog/answer/1_1.rb +1 -0
- data/takahashi/sample_prog/answer/1_2.rb +1 -0
- data/takahashi/sample_prog/answer/1_3.rb +1 -0
- data/takahashi/sample_prog/answer/2_1.rb +5 -0
- data/takahashi/sample_prog/answer/2_2.rb +12 -0
- data/takahashi/sample_prog/answer/3_1.rb +10 -0
- data/takahashi/sample_prog/answer/4_1.rb +7 -0
- data/takahashi/sample_prog/answer/5_1.rb +6 -0
- data/takahashi/sample_prog/answer/5_2.rb +3 -0
- data/takahashi/sample_prog/answer/6_1.rb +3 -0
- data/takahashi/sample_prog/answer/6_2.rb +5 -0
- data/takahashi/sample_prog/answer/6_3.rb +5 -0
- data/takahashi/sample_prog/answer/6_4.rb +7 -0
- data/takahashi/sample_prog/answer/7_1.rb +3 -0
- data/takahashi/sample_prog/answer/7_2.rb +8 -0
- data/takahashi/sample_prog/answer/9_1.rb +3 -0
- data/takahashi/sample_prog/answer/9_2.rb +5 -0
- data/takahashi/sample_prog/answer/9_3.rb +10 -0
- data/takahashi/sample_prog/answer/hello.rb +3 -0
- data/workshop/.rspec +1 -0
- data/workshop/emacs.d/ac-comphist.dat +50 -0
- data/workshop/emacs.d/cp5022x.el +156 -0
- data/workshop/emacs.d/elpa/archives/gnu/archive-contents +1240 -0
- data/workshop/emacs.d/elpa/archives/melpa/archive-contents +2 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-autoloads.el +65 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-config.el +551 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-config.elc +0 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete-pkg.el +6 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete.el +2164 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/auto-complete.elc +0 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ada-mode +72 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/c++-mode +99 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/c-mode +55 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/caml-mode +231 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/clojure-mode +580 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/clojurescript-mode +475 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/coq-mode +278 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/css-mode +874 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/erlang-mode +216 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ess-julia-mode +37 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/go-mode +25 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/haskell-mode +679 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/java-mode +53 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/js-mode +148 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/julia-mode +37 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/lua-mode +21 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/nim-mode +70 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/objc-mode +161 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/octave-mode +46 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/php-mode +6144 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/python-mode +379 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/qml-mode +183 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ruby-mode +181 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/scala-mode +1347 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/scheme-mode +216 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/sclang-mode +1481 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/sh-mode +182 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/swift-mode +87 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/tcl-mode +172 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/ts-mode +797 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/tuareg-mode +231 -0
- data/workshop/emacs.d/elpa/auto-complete-20170124.1845/dict/verilog-mode +313 -0
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults-autoloads.el +16 -0
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults-pkg.el +2 -0
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults.el +90 -0
- data/workshop/emacs.d/elpa/better-defaults-20170613.2104/better-defaults.elc +0 -0
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode-autoloads.el +26 -0
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode-pkg.el +2 -0
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode.el +877 -0
- data/workshop/emacs.d/elpa/haml-mode-20170923.2153/haml-mode.elc +0 -0
- data/workshop/emacs.d/elpa/haml-mode-readme.txt +8 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-light-theme.el +918 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-light-theme.elc +0 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme-autoloads.el +32 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme-pkg.el +8 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme.el +912 -0
- data/workshop/emacs.d/elpa/material-theme-20171123.1040/material-theme.elc +0 -0
- data/workshop/emacs.d/elpa/ox-bibtex-chinese-readme.txt +21 -0
- data/workshop/emacs.d/elpa/popup-20160709.729/popup-autoloads.el +15 -0
- data/workshop/emacs.d/elpa/popup-20160709.729/popup-pkg.el +2 -0
- data/workshop/emacs.d/elpa/popup-20160709.729/popup.el +1432 -0
- data/workshop/emacs.d/elpa/popup-20160709.729/popup.elc +0 -0
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode-autoloads.el +33 -0
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode-pkg.el +2 -0
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode.el +470 -0
- data/workshop/emacs.d/elpa/yaml-mode-20180212.1556/yaml-mode.elc +0 -0
- data/workshop/emacs.d/elpa/yaml-mode-readme.txt +25 -0
- data/workshop/emacs.d/haml-mode-master/.gitignore +1 -0
- data/workshop/emacs.d/haml-mode-master/.mailmap +2 -0
- data/workshop/emacs.d/haml-mode-master/MIT-LICENSE +20 -0
- data/workshop/emacs.d/haml-mode-master/README.md +47 -0
- data/workshop/emacs.d/haml-mode-master/haml-mode.el +887 -0
- data/workshop/emacs.d/iceberg_theme.el +202 -0
- data/workshop/emacs.d/init-open-recentf.el +133 -0
- data/workshop/emacs.d/init.el +229 -0
- data/workshop/emacs.d/inits/line-num.el +264 -0
- data/workshop/emacs.d/install-elisp.el +366 -0
- data/workshop/emacs.d/markdown-mode/markdown-mode.el +5978 -0
- data/workshop/emacs.d/notes +12 -0
- data/workshop/emacs.d/processing-mode/processing-mode.el +275 -0
- data/workshop/emacs.d/recentf +31 -0
- data/workshop/emacs.d/ruby-mode/inf-ruby.el +416 -0
- data/workshop/emacs.d/ruby-mode/rdoc-mode.el +130 -0
- data/workshop/emacs.d/ruby-mode/ruby-electric.el +205 -0
- data/workshop/emacs.d/ruby-mode/ruby-mode.el +1496 -0
- data/workshop/emacs.d/ruby-mode/ruby-style.el +78 -0
- data/workshop/emacs.d/ruby-mode/rubydb2x.el +104 -0
- data/workshop/emacs.d/ruby-mode/rubydb3x.el +115 -0
- data/workshop/emacs.d/ruby_learner_init.el +244 -0
- data/workshop/emacs.d/themes/dracula-theme.el +431 -0
- data/workshop/emacs.d/themes/iceberg-theme.el +205 -0
- data/workshop/emacs.d/themes/my-misterioso-theme.el +109 -0
- data/workshop/emacs.d/themes/my-wombat-theme.el +121 -0
- data/workshop/emacs.d/wiki-mode/wiki.el +976 -0
- data/workshop/emacs_help.org +34 -0
- data/workshop/lib/answer.rb +1 -0
- data/workshop/lib/sentence.org +1 -0
- data/workshop/lib/workplace.rb +1 -0
- data/workshop/restore/empty.rb +0 -0
- data/workshop/spec/spec_helper.rb +100 -0
- data/workshop/spec/workplace_spec.rb +1 -0
- data/workshop/training_data.txt +3 -0
- metadata +343 -0
@@ -0,0 +1,1432 @@
|
|
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
|