mirror of
https://github.com/vale981/emacs-ipython-notebook
synced 2025-03-06 17:41:40 -05:00
Merge commit 'ab71b0be808bb0fb6199d7ca6433f6ac2bbc4cff' as 'lib/popup'
This commit is contained in:
John Miller
commit
1fbcb40897
12 changed files with 2656 additions and 0 deletions
2
lib/popup/.gitignore
vendored
Normal file
2
lib/popup/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
/.cask/
|
||||
*.elc
|
||||
13
lib/popup/.travis.yml
Normal file
13
lib/popup/.travis.yml
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
language: generic
|
||||
sudo: false
|
||||
before_install:
|
||||
- curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > x.sh && source ./x.sh
|
||||
- evm install $EVM_EMACS --use --skip
|
||||
- cask
|
||||
env:
|
||||
- EVM_EMACS=emacs-24.3-travis
|
||||
- EVM_EMACS=emacs-24.4-travis
|
||||
- EVM_EMACS=emacs-24.5-travis
|
||||
script:
|
||||
- emacs --version
|
||||
- make travis-ci
|
||||
7
lib/popup/Cask
Normal file
7
lib/popup/Cask
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(source gnu)
|
||||
(source melpa)
|
||||
|
||||
(package-file "popup.el")
|
||||
|
||||
(development
|
||||
(depends-on "ert"))
|
||||
27
lib/popup/Makefile
Normal file
27
lib/popup/Makefile
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
EMACS ?= emacs
|
||||
CASK ?= cask
|
||||
EMACS23=emacs23
|
||||
|
||||
ELPA_DIR = $(shell EMACS=$(EMACS) $(CASK) package-directory)
|
||||
|
||||
.PHONY: test test-nw test-emacs23 test-emacs23-nw travis-ci
|
||||
|
||||
test:
|
||||
$(CASK) exec $(EMACS) -Q -L . -l tests/run-test.el
|
||||
|
||||
test-nw:
|
||||
$(CASK) exec $(EMACS) -Q -nw -L . -l tests/run-test.el
|
||||
|
||||
test-emacs23: tests/ert.el
|
||||
${EMACS23} -Q -L . -l test/ert.el -l tests/run-test.el
|
||||
|
||||
test-emacs23-nw: tests/ert.el
|
||||
$(EMACS23) -Q -nw -L . -l test/ert.el -l tests/run-test.el
|
||||
|
||||
travis-ci: elpa
|
||||
$(CASK) exec $(EMACS) -batch -Q -l tests/run-test.el
|
||||
|
||||
elpa: $(ELPA_DIR)
|
||||
$(ELPA_DIR): Cask
|
||||
$(CASK) install
|
||||
touch $@
|
||||
356
lib/popup/README.md
Normal file
356
lib/popup/README.md
Normal file
|
|
@ -0,0 +1,356 @@
|
|||
popup.el
|
||||
========
|
||||
|
||||
[](http://travis-ci.org/auto-complete/popup-el) [![melpa badge][melpa-badge]][melpa-link] [![melpa stable badge][melpa-stable-badge]][melpa-stable-link]
|
||||
|
||||
Overview
|
||||
--------
|
||||
|
||||
popup.el is a visual popup user interface library for Emacs. This
|
||||
provides a basic API and common UI widgets such as popup tooltips and
|
||||
popup menus.
|
||||
|
||||
Screenshots
|
||||
-----------
|
||||
|
||||
**Tooltip**
|
||||
|
||||
|
||||
|
||||
**Popup Menu**
|
||||
|
||||
|
||||
|
||||
**Popup Cascade Menu**
|
||||
|
||||
|
||||
|
||||
Installation
|
||||
------------
|
||||
|
||||
You can install `popup.el` from [MELPA](https://melpa.org/) with package.el.
|
||||
popwin is tested under GNU Emacs 24 or later.
|
||||
|
||||
Alternatively, users of Debian 9 or later or Ubuntu 16.04 or later may
|
||||
simply `apt-get install elpa-popup`.
|
||||
|
||||
Popup Items
|
||||
-----------
|
||||
|
||||
Elements of `popup-list` have to be popup items. A popup item is
|
||||
substantially a string but it may involve some text-properties. There
|
||||
are two ways to make popup items. One is just using strings. Another
|
||||
is to use the `popup-make-item` function, which just returns the string
|
||||
after adding text-properties of its keywords. Effective text-properties
|
||||
are:
|
||||
|
||||
* `value` -- This represents the **real** value of the item. This will
|
||||
be used when returning the value but not the item (or string) from
|
||||
some synchronous functions such as `popup-menu*`.
|
||||
* `face` -- The background face of the item. The value of `popup-face`
|
||||
will be overridden.
|
||||
* `selection-face` -- The selection face of the item. The value of
|
||||
`popup-selection-face` will be overridden.
|
||||
* `document` -- The documentation string or function of the item.
|
||||
* `summary` -- The summary string of the item. This will be shown
|
||||
inline with the item.
|
||||
* `symbol` -- The symbol character of the item.
|
||||
* `sublist` -- The sublist of the item. This is effective only with
|
||||
`popup-cascade-menu`.
|
||||
|
||||
All of properties can be accessed by `popup-item-<property>` utility function.
|
||||
|
||||
### Function: `popup-item-propertize`
|
||||
|
||||
popup-item-propertize item &rest properties => item
|
||||
|
||||
Same as `propertize` except that this avoids overriding existed value
|
||||
with `nil` property.
|
||||
|
||||
### Function: `popup-make-item`
|
||||
|
||||
popup-make-item name &key value popup-face selection-face sublist
|
||||
document symbol summary => item
|
||||
|
||||
The utility function of `popup-item-propertize`.
|
||||
|
||||
Popups
|
||||
------
|
||||
|
||||
This section describes the basic data structures and operations of
|
||||
popups.
|
||||
|
||||
### Struct: `popup`
|
||||
|
||||
Any instance of `popup` structure has the following fields (some
|
||||
unimportant fields are not listed):
|
||||
|
||||
* `point`
|
||||
* `row` -- The line number.
|
||||
* `column`
|
||||
* `width` -- Max width of `popup` instance.
|
||||
* `height` -- Max height of `popup` instance.
|
||||
* `min-height`
|
||||
* `current-height`
|
||||
* `direction` -- Positive number means forward, negative number means
|
||||
backward.
|
||||
* `parent` -- The parent of `popup` instance.
|
||||
* `face` -- The background face.
|
||||
* `selection-face`
|
||||
* `margin-left`
|
||||
* `margin-right`
|
||||
* `scroll-bar` -- Non-nil means `popup` instance has a scroll bar.
|
||||
* `symbol` -- Non-nil means `popup` instance has a space for
|
||||
displaying symbols of item.
|
||||
* `cursor` -- The current position of `list`.
|
||||
* `scroll-top` -- The offset of scrolling.
|
||||
* `list` -- The contents of `popup` instance in a list of items
|
||||
(strings).
|
||||
* `original-list` -- Same as `list` except that this is not filtered.
|
||||
|
||||
All of these fields can be accessed by `popup-<field>` function.
|
||||
|
||||
### Function: `popup-create`
|
||||
|
||||
popup-create point width height &key min-height max-width around face
|
||||
selection-face scroll-bar margin-left margin-right symbol parent
|
||||
parent-offset => popup
|
||||
|
||||
Create a popup instance at `POINT` with `WIDTH` and `HEIGHT`.
|
||||
|
||||
`MIN-HEIGHT` is the minimal height of the popup. The default value is 0.
|
||||
|
||||
`MAX-WIDTH` is the maximum width of the popup. The default value is
|
||||
nil (no limit). If a floating point, the value refers to the ratio of
|
||||
the window. If an integer, limit is in characters.
|
||||
|
||||
If `AROUND` is non-nil, the popup will be displayed around the point
|
||||
but not at the point.
|
||||
|
||||
`FACE` is the background face of the popup. The default value is
|
||||
`popup-face`.
|
||||
|
||||
`SELECTION-FACE` is the foreground (selection) face of the popup The
|
||||
default value is `popup-face`.
|
||||
|
||||
If `SCROLL-BAR` is non-nil, the popup will have a scroll bar at the
|
||||
right.
|
||||
|
||||
If `MARGIN-LEFT` is non-nil, the popup will have a margin at the left.
|
||||
|
||||
If `MARGIN-RIGHT` is non-nil, the popup will have a margin at the
|
||||
right.
|
||||
|
||||
`SYMBOL` is a single character which indicates the kind of the item.
|
||||
|
||||
`PARENT` is the parent popup instance. If `PARENT` is omitted, the popup
|
||||
will be a root instance.
|
||||
|
||||
`PARENT-OFFSET` is a row offset from the parent popup.
|
||||
|
||||
Here is an example:
|
||||
|
||||
(setq popup (popup-create (point) 10 10))
|
||||
(popup-set-list popup '("Foo" "Bar" "Baz"))
|
||||
(popup-draw popup)
|
||||
;; do something here
|
||||
(popup-delete popup)
|
||||
|
||||
### Function: `popup-delete`
|
||||
|
||||
popup-delete popup
|
||||
|
||||
Delete the `POPUP`.
|
||||
|
||||
### Function: `popup-live-p`
|
||||
|
||||
popup-live-p popup => boolean
|
||||
|
||||
### Function: `popup-set-list`
|
||||
|
||||
popup-set-list popup list
|
||||
|
||||
Set the contents of the `POPUP`. `LIST` has to be popup items.
|
||||
|
||||
### Function: `popup-draw`
|
||||
|
||||
popup-draw popup
|
||||
|
||||
Draw the contents of the `POPUP`.
|
||||
|
||||
### Function: `popup-hide`
|
||||
|
||||
popup-hide popup
|
||||
|
||||
Hide the `POPUP`. To show again, call `popup-draw`.
|
||||
|
||||
### Function: `popup-hidden-p`
|
||||
|
||||
popup-hidden-p popup
|
||||
|
||||
Return non-nil if the `POPUP` is hidden.
|
||||
|
||||
### Function: `popup-select`
|
||||
|
||||
popup-select popup index
|
||||
|
||||
Select the item of `INDEX` of the `POPUP`.
|
||||
|
||||
### Function: `popup-selected-item`
|
||||
|
||||
popup-selected-item popup => item
|
||||
|
||||
Return the selected item of the `POPUP`.
|
||||
|
||||
Return non-nil if the `POPUP` is still alive.
|
||||
|
||||
### Function: `popup-next`
|
||||
|
||||
popup-next popup
|
||||
|
||||
Select the next item of the `POPUP`.
|
||||
|
||||
### Function: `popup-previous`
|
||||
|
||||
popup-previous popup
|
||||
|
||||
Select the next item of the `POPUP`.
|
||||
|
||||
### Function: `popup-scroll-down`
|
||||
|
||||
popup-scroll-down popup n
|
||||
|
||||
Scroll down `N` items of the `POPUP`. This won't wrap.
|
||||
|
||||
### Function: `popup-scroll-up`
|
||||
|
||||
popup-scroll-up popup n
|
||||
|
||||
Scroll up `N` items of the `POPUP`. This won't wrap.
|
||||
|
||||
### Function: `popup-isearch`
|
||||
|
||||
popup-isearch popup &key cursor-color keymap callback help-delay
|
||||
=> boolean
|
||||
|
||||
Enter incremental search event loop of `POPUP`.
|
||||
|
||||
Tooltips
|
||||
--------
|
||||
|
||||
A tooltip is an useful visual UI widget for displaying information
|
||||
something about what cursor points to.
|
||||
|
||||
### Function: `popup-tip`
|
||||
|
||||
popup-tip string &key point around width height min-height max-width
|
||||
truncate margin margin-left margin-right scroll-bar parent
|
||||
parent-offset nowait nostrip prompt
|
||||
|
||||
Show a tooltip with message `STRING` at `POINT`. This function is
|
||||
synchronized unless `NOWAIT` specified. Almost all arguments are same as
|
||||
`popup-create` except for `TRUNCATE`, `NOWAIT`, `NOSTRIP` and `PROMPT`.
|
||||
|
||||
If `TRUNCATE` is non-nil, the tooltip can be truncated.
|
||||
|
||||
If `NOWAIT` is non-nil, this function immediately returns the tooltip
|
||||
instance without entering event loop.
|
||||
|
||||
If `NOSTRIP` is non-nil, `STRING` properties are not stripped.
|
||||
|
||||
`PROMPT` is a prompt string used when reading events during the event
|
||||
loop.
|
||||
|
||||
Here is an example:
|
||||
|
||||
(popup-tip "Hello, World!")
|
||||
;; reach here after the tooltip disappeared
|
||||
|
||||
Popup Menus
|
||||
-----------
|
||||
|
||||
Popup menu is an useful visual UI widget for prompting users to
|
||||
select an item of a list.
|
||||
|
||||
### Function: `popup-menu*`
|
||||
|
||||
popup-menu* list &key point around width height margin margin-left
|
||||
margin-right scroll-bar symbol parent parent-offset keymap
|
||||
fallback help-delay nowait prompt isearch isearch-filter isearch-cursor-color
|
||||
isearch-keymap isearch-callback initial-index => selected-value
|
||||
|
||||
Show a popup menu of `LIST` at `POINT`. This function returns the value
|
||||
of the selected item. Almost all arguments are same as `popup-create`
|
||||
except for `KEYMAP`, `FALLBACK`, `HELP-DELAY`, `PROMPT`, `ISEARCH`,
|
||||
`ISEARCH-FILTER`, `ISEARCH-CURSOR-COLOR`, `ISEARCH-KEYMAP`
|
||||
and `ISEARCH-CALLBACK`.
|
||||
|
||||
If `KEYMAP` is provided, it is a keymap which is used when processing
|
||||
events during event loop.
|
||||
|
||||
If `FALLBACK` is provided, it is a function taking two arguments; a key
|
||||
and a command. `FALLBACK` is called when no special operation is found
|
||||
on the key. The default value is `popup-menu-fallback`, which does
|
||||
nothing.
|
||||
|
||||
`HELP-DELAY` is a delay of displaying helps.
|
||||
|
||||
If `NOWAIT` is non-nil, this function immediately returns the menu
|
||||
instance without entering event loop.
|
||||
|
||||
`PROMPT` is a prompt string when reading events during event loop.
|
||||
|
||||
If `ISEARCH` is non-nil, do isearch as soon as displaying the popup
|
||||
menu.
|
||||
|
||||
`ISEARCH-FILTER` is a filtering function taking two arguments:
|
||||
search pattern and list of items. Returns a list of matching items.
|
||||
|
||||
`ISEARCH-CURSOR-COLOR` is a cursor color during isearch. The default
|
||||
value is `popup-isearch-cursor-color'.
|
||||
|
||||
`ISEARCH-KEYMAP` is a keymap which is used when processing events
|
||||
during event loop. The default value is `popup-isearch-keymap`.
|
||||
|
||||
`ISEARCH-CALLBACK` is a function taking one argument. `popup-menu`
|
||||
calls `ISEARCH-CALLBACK`, if specified, after isearch finished or
|
||||
isearch canceled. The arguments is whole filtered list of items.
|
||||
|
||||
If `INITIAL-INDEX` is non-nil, this is an initial index value for
|
||||
`popup-select`. Only positive integer is valid.
|
||||
|
||||
Here is an example:
|
||||
|
||||
(popup-menu* '("Foo" "Bar" "Baz"))
|
||||
;; => "Baz" if you select Baz
|
||||
(popup-menu* (list (popup-make-item "Yes" :value t)
|
||||
(popup-make-item "No" :value nil)))
|
||||
;; => t if you select Yes
|
||||
|
||||
### Function: `popup-cascade-menu`
|
||||
|
||||
Same as `popup-menu` except that an element of `LIST` can be also a
|
||||
sub-menu if the element is a cons cell formed `(ITEM . SUBLIST)` where
|
||||
`ITEM` is an usual item and `SUBLIST` is a list of the sub menu.
|
||||
|
||||
Here is an example:
|
||||
|
||||
(popup-cascade-menu '(("Top1" "Sub1" "Sub2") "Top2"))
|
||||
|
||||
|
||||
### Customize Variables
|
||||
|
||||
#### `popup-isearch-regexp-builder-function`
|
||||
|
||||
Function used to construct a regexp from a pattern. You may for instance
|
||||
provide a function that replaces spaces by '.+' if you like helm or ivy style
|
||||
of completion. Default value is `#'regexp-quote`.
|
||||
|
||||
----
|
||||
|
||||
Copyright (C) 2011-2015 Tomohiro Matsuyama <<m2ym.pub@gmail.com>>
|
||||
|
||||
[melpa-link]: https://melpa.org/#/popup
|
||||
[melpa-stable-link]: https://stable.melpa.org/#/popup
|
||||
[melpa-badge]: https://melpa.org/packages/popup-badge.svg
|
||||
[melpa-stable-badge]: https://stable.melpa.org/packages/popup-badge.svg
|
||||
BIN
lib/popup/etc/images/popup1.png
Normal file
BIN
lib/popup/etc/images/popup1.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.1 KiB |
BIN
lib/popup/etc/images/popup2.png
Normal file
BIN
lib/popup/etc/images/popup2.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2 KiB |
BIN
lib/popup/etc/images/popup3.png
Normal file
BIN
lib/popup/etc/images/popup3.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.2 KiB |
1431
lib/popup/popup.el
Normal file
1431
lib/popup/popup.el
Normal file
File diff suppressed because it is too large
Load diff
124
lib/popup/tests/popup-interactive-test.el
Normal file
124
lib/popup/tests/popup-interactive-test.el
Normal file
|
|
@ -0,0 +1,124 @@
|
|||
(require 'popup)
|
||||
|
||||
(defmacro test (explain &rest body)
|
||||
(declare (indent 1))
|
||||
`(let ((buf "*buf*")
|
||||
(window-config (current-window-configuration)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(delete-other-windows)
|
||||
(switch-to-buffer buf)
|
||||
(erase-buffer)
|
||||
(insert " ")
|
||||
(let ((success (progn ,@body)))
|
||||
(unless success
|
||||
(error "failed: %s" ,explain))))
|
||||
(when popup
|
||||
(popup-delete popup)
|
||||
(setq popup nil))
|
||||
(kill-buffer buf)
|
||||
(set-window-configuration window-config))))
|
||||
|
||||
(defmacro ui-test (prompt &rest body)
|
||||
(declare (indent 1))
|
||||
`(test ,prompt ,@body (yes-or-no-p ,prompt)))
|
||||
|
||||
(defun input (key)
|
||||
(push key unread-command-events))
|
||||
|
||||
(defvar popup nil)
|
||||
|
||||
(test "popup-create"
|
||||
(setq popup (popup-create (point) 10 10)))
|
||||
|
||||
(test "popup-delete"
|
||||
(setq popup (popup-create (point) 10 10))
|
||||
(popup-delete popup)
|
||||
(not (popup-live-p popup)))
|
||||
|
||||
(ui-test "popup?"
|
||||
(setq popup (popup-create (point) 10 10))
|
||||
(popup-set-list popup '("hello" "world"))
|
||||
(popup-draw popup))
|
||||
|
||||
(ui-test "hidden?"
|
||||
(setq popup (popup-create (point) 10 10))
|
||||
(popup-set-list popup '("hello" "world"))
|
||||
(popup-draw popup)
|
||||
(popup-hide popup))
|
||||
|
||||
(ui-test "isearch?"
|
||||
(setq popup (popup-create (point) 10 10))
|
||||
(popup-set-list popup '("hello" "world"))
|
||||
(popup-draw popup)
|
||||
(input ?e)
|
||||
(popup-isearch popup))
|
||||
|
||||
(ui-test "tip?"
|
||||
(popup-tip
|
||||
"Start isearch on POPUP. This function is synchronized, meaning
|
||||
event loop waits for quiting of isearch.
|
||||
|
||||
CURSOR-COLOR is a cursor color during isearch. The default value
|
||||
is `popup-isearch-cursor-color'.
|
||||
|
||||
KEYMAP is a keymap which is used when processing events during
|
||||
event loop. The default value is `popup-isearch-keymap'.
|
||||
|
||||
CALLBACK is a function taking one argument. `popup-isearch' calls
|
||||
CALLBACK, if specified, after isearch finished or isearch
|
||||
canceled. The arguments is whole filtered list of items.
|
||||
|
||||
HELP-DELAY is a delay of displaying helps."
|
||||
:nowait t))
|
||||
|
||||
(ui-test "fold?"
|
||||
(let ((s (make-string (- (window-width) 3) ? )))
|
||||
(insert s)
|
||||
(setq popup (popup-tip "long long long long line" :nowait t))))
|
||||
|
||||
(ui-test "fold?"
|
||||
(let ((s (make-string (- (window-height) 3) ?\n)))
|
||||
(insert s)
|
||||
(setq popup (popup-tip "bla\nbla\nbla\nbla\nbla" :nowait t))))
|
||||
|
||||
(ui-test "margin?"
|
||||
(setq popup (popup-tip "Margin?" :nowait t :margin t)))
|
||||
|
||||
(ui-test "two lines?"
|
||||
(setq popup (popup-tip "Foo\nBar\nBaz" :nowait t :height 2)))
|
||||
|
||||
(ui-test "scroll bar?"
|
||||
(setq popup (popup-tip "Foo\nBar\nBaz\nFez\nOz" :nowait t :height 3 :scroll-bar t :margin t)))
|
||||
|
||||
(ui-test "min-height?"
|
||||
(setq popup (popup-tip "Hello" :nowait t :min-height 10)))
|
||||
|
||||
(ui-test "menu?"
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :nowait t)))
|
||||
|
||||
(ui-test "cascade menu?"
|
||||
(setq popup (popup-cascade-menu '(("Foo" "Foo1" "Foo2") "Bar" "Baz") :nowait t :margin t)))
|
||||
|
||||
(ui-test "next?"
|
||||
(setq popup (popup-cascade-menu '("Foo" "Bar" "Baz") :nowait t :margin t))
|
||||
(popup-next popup))
|
||||
|
||||
(ui-test "previous?"
|
||||
(setq popup (popup-cascade-menu '("Foo" "Bar" "Baz") :nowait t :margin t))
|
||||
(popup-previous popup))
|
||||
|
||||
(ui-test "select?"
|
||||
(setq popup (popup-cascade-menu '("Foo" "Bar" "Baz") :nowait t :margin t))
|
||||
(popup-select popup 1))
|
||||
|
||||
(ui-test "scroll-down?"
|
||||
(setq popup (popup-cascade-menu (loop repeat 100 collect "Foo") :nowait t :height 10 :margin t :scroll-bar t))
|
||||
(popup-scroll-down popup 10))
|
||||
|
||||
(ui-test "scroll-up?"
|
||||
(setq popup (popup-cascade-menu (loop repeat 100 collect "Foo") :nowait t :height 10 :margin t :scroll-bar t))
|
||||
(popup-scroll-down popup 999)
|
||||
(popup-scroll-up popup 10))
|
||||
|
||||
(message "Congratulations!")
|
||||
664
lib/popup/tests/popup-test.el
Normal file
664
lib/popup/tests/popup-test.el
Normal file
|
|
@ -0,0 +1,664 @@
|
|||
(require 'ert)
|
||||
|
||||
(require 'popup)
|
||||
|
||||
(when (< (frame-width) (length "long long long long line"))
|
||||
(set-frame-size (selected-frame) 80 35))
|
||||
|
||||
(defun popup-test-helper-posn-col-row (dummy)
|
||||
"This function is workaround. Because `posn-col-row' and `posn-at-point'
|
||||
can not work well in batch mode."
|
||||
(cons (current-column) (line-number-at-pos (point))))
|
||||
|
||||
(defmacro popup-test-with-common-setup (&rest body)
|
||||
(declare (indent 0) (debug t))
|
||||
`(save-excursion
|
||||
(with-temp-buffer
|
||||
(switch-to-buffer (current-buffer))
|
||||
(delete-other-windows)
|
||||
(erase-buffer)
|
||||
(if noninteractive
|
||||
(cl-letf (((symbol-function 'posn-col-row)
|
||||
#'popup-test-helper-posn-col-row))
|
||||
,@body)
|
||||
,@body))))
|
||||
|
||||
(defun popup-test-helper-line-move-visual (arg)
|
||||
"This function is workaround. Because `line-move-visual' can not work well in
|
||||
batch mode."
|
||||
(let ((cur-col
|
||||
(- (current-column)
|
||||
(save-excursion (vertical-motion 0) (current-column)))))
|
||||
(vertical-motion arg)
|
||||
(move-to-column (+ (current-column) cur-col))))
|
||||
|
||||
(defun popup-test-helper-rectangle-match (str)
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-temp-buffer
|
||||
(insert buffer-contents)
|
||||
(goto-char (point-min))
|
||||
(let ((strings (split-string str "\n")))
|
||||
(when (search-forward (car strings) nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(cl-every
|
||||
'identity
|
||||
(mapcar
|
||||
(lambda (elem)
|
||||
(popup-test-helper-line-move-visual 1)
|
||||
(looking-at (regexp-quote elem)))
|
||||
(cdr strings))))))))
|
||||
|
||||
(defun popup-test-helper-buffer-contents ()
|
||||
(cl-loop with start = (point-min)
|
||||
with contents
|
||||
for overlay in (cl-sort (overlays-in (point-min) (point-max))
|
||||
'< :key 'overlay-start)
|
||||
for overlay-start = (overlay-start overlay)
|
||||
for overlay-end = (overlay-end overlay)
|
||||
for prefix = (buffer-substring start overlay-start)
|
||||
for befstr = (overlay-get overlay 'before-string)
|
||||
for substr = (or (overlay-get overlay 'display)
|
||||
(buffer-substring overlay-start overlay-end))
|
||||
for aftstr = (overlay-get overlay 'after-string)
|
||||
collect prefix into contents
|
||||
unless (overlay-get overlay 'invisible) collect
|
||||
(concat befstr substr aftstr) into contents
|
||||
do (setq start overlay-end)
|
||||
finally (return (concat (apply 'concat contents)
|
||||
(buffer-substring start (point-max))))
|
||||
))
|
||||
|
||||
(defun popup-test-helper-create-popup (str)
|
||||
(setq popup (popup-create (point) 10 10))
|
||||
(popup-set-list popup (split-string str "\n"))
|
||||
(popup-draw popup))
|
||||
|
||||
(defun popup-test-helper-in-popup-p ()
|
||||
(let* ((faces (get-text-property (point) 'face))
|
||||
(faces (if (listp faces) faces (list faces))))
|
||||
(or (memq 'popup-tip-face faces)
|
||||
(memq 'popup-menu-face faces)
|
||||
(memq 'popup-menu-selection-face faces)
|
||||
(memq 'popup-face faces))))
|
||||
|
||||
(defun popup-test-helper-popup-selected-item (str)
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-temp-buffer
|
||||
(insert buffer-contents)
|
||||
(goto-char (point-min))
|
||||
(goto-char
|
||||
(text-property-any (point-min) (point-max)
|
||||
'face 'popup-menu-selection-face))
|
||||
(looking-at str)
|
||||
)))
|
||||
|
||||
(defun popup-test-helper-popup-beginning-line ()
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-temp-buffer
|
||||
(insert buffer-contents)
|
||||
(goto-char (point-min))
|
||||
(let ((end (point)))
|
||||
(while (and (not (eobp))
|
||||
(not (popup-test-helper-in-popup-p)))
|
||||
(goto-char (or (next-single-property-change (point) 'face)
|
||||
(point-max))))
|
||||
(if (popup-test-helper-in-popup-p)
|
||||
;; todo visual line
|
||||
(line-number-at-pos (point)) nil)
|
||||
))))
|
||||
|
||||
(defun popup-test-helper-popup-beginning-column ()
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-temp-buffer
|
||||
(insert buffer-contents)
|
||||
(goto-char (point-min))
|
||||
(let ((end (point)))
|
||||
(while (and (not (eobp))
|
||||
(not (popup-test-helper-in-popup-p)))
|
||||
(goto-char (or (next-single-property-change (point) 'face)
|
||||
(point-max))))
|
||||
(if (popup-test-helper-in-popup-p)
|
||||
(current-column) nil)
|
||||
))))
|
||||
|
||||
(defun popup-test-helper-popup-end-line ()
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-temp-buffer
|
||||
(insert buffer-contents)
|
||||
(goto-char (point-max))
|
||||
(let ((end (point)))
|
||||
(while (and (not (bobp))
|
||||
(not (popup-test-helper-in-popup-p)))
|
||||
(setq end (point))
|
||||
(goto-char (or (previous-single-property-change (point) 'face)
|
||||
(point-min))))
|
||||
(if (popup-test-helper-in-popup-p)
|
||||
;; todo visual line
|
||||
(line-number-at-pos end) nil)
|
||||
))))
|
||||
|
||||
(defun popup-test-helper-popup-end-column ()
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-temp-buffer
|
||||
(insert buffer-contents)
|
||||
(goto-char (point-max))
|
||||
(let ((end (point)))
|
||||
(while (and (not (bobp))
|
||||
(not (popup-test-helper-in-popup-p)))
|
||||
(setq end (point))
|
||||
(goto-char (or (previous-single-property-change (point) 'face)
|
||||
(point-min))))
|
||||
(when (popup-test-helper-in-popup-p)
|
||||
(goto-char end)
|
||||
(current-column))
|
||||
))))
|
||||
|
||||
(defun popup-test-helper-debug ()
|
||||
(let ((buffer-contents (popup-test-helper-buffer-contents)))
|
||||
(with-current-buffer (get-buffer-create "*dump*")
|
||||
(erase-buffer)
|
||||
(insert buffer-contents)
|
||||
(buffer-string)
|
||||
)))
|
||||
;; Test for helper method
|
||||
(ert-deftest popup-test-no-truncated ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 4) ? )) (insert "Foo\n")
|
||||
(insert (make-string (- (window-width) 4) ? )) (insert "Bar\n")
|
||||
(insert (make-string (- (window-width) 4) ? )) (insert "Baz\n")
|
||||
(should (eq t (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz")))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-truncated ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 2) ? )) (insert "Foo\n")
|
||||
(insert (make-string (- (window-width) 2) ? )) (insert "Bar\n")
|
||||
(insert (make-string (- (window-width) 2) ? )) (insert "Baz\n")
|
||||
(should (eq nil (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz")))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-misaligned ()
|
||||
(popup-test-with-common-setup
|
||||
(progn
|
||||
(insert (make-string (- (window-width) 5) ? )) (insert "Foo\n")
|
||||
(insert (make-string (- (window-width) 4) ? )) (insert "Bar\n")
|
||||
(insert (make-string (- (window-width) 3) ? )) (insert "Baz\n"))
|
||||
(should (eq nil (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz")))
|
||||
))
|
||||
;; Test for popup-el
|
||||
(ert-deftest popup-test-simple ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-test-helper-create-popup "\
|
||||
foo
|
||||
bar
|
||||
baz")
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
foo
|
||||
bar
|
||||
baz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-column) 0))))
|
||||
|
||||
(ert-deftest popup-test-delete ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-test-helper-create-popup "\
|
||||
foo
|
||||
bar
|
||||
baz")
|
||||
(popup-delete popup)
|
||||
(should-not (popup-test-helper-rectangle-match "\
|
||||
foo
|
||||
bar
|
||||
baz"))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-hide ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-test-helper-create-popup "\
|
||||
foo
|
||||
bar
|
||||
baz")
|
||||
(popup-hide popup)
|
||||
(should-not (popup-test-helper-rectangle-match "\
|
||||
foo
|
||||
bar
|
||||
baz"))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-at-colum1 ()
|
||||
(popup-test-with-common-setup
|
||||
(insert " ")
|
||||
(popup-test-helper-create-popup "\
|
||||
foo
|
||||
bar
|
||||
baz")
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
foo
|
||||
bar
|
||||
baz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-column) 1))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-tip ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-tip "\
|
||||
Start isearch on POPUP. This function is synchronized, meaning
|
||||
event loop waits for quiting of isearch.
|
||||
|
||||
CURSOR-COLOR is a cursor color during isearch. The default value
|
||||
is `popup-isearch-cursor-color'.
|
||||
|
||||
KEYMAP is a keymap which is used when processing events during
|
||||
event loop. The default value is `popup-isearch-keymap'.
|
||||
|
||||
CALLBACK is a function taking one argument. `popup-isearch' calls
|
||||
CALLBACK, if specified, after isearch finished or isearch
|
||||
canceled. The arguments is whole filtered list of items.
|
||||
|
||||
HELP-DELAY is a delay of displaying helps."
|
||||
:nowait t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
KEYMAP is a keymap which is used when processing events during
|
||||
event loop. The default value is `popup-isearch-keymap'."))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-folding-long-line-right-top ()
|
||||
(popup-test-with-common-setup
|
||||
;; To use window-width because Emacs 23 does not have window-body-width
|
||||
(insert (make-string (- (window-width) 3) ? ))
|
||||
(popup-tip "long long long long line" :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "long long long long line"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line)
|
||||
2))
|
||||
(should (eq (popup-test-helper-popup-end-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-folding-long-line-left-bottom ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-body-height) 1) ?\n))
|
||||
(popup-tip "long long long long line" :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "long long long long line"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line)
|
||||
(- (window-body-height) 1)))
|
||||
(should (eq (popup-test-helper-popup-end-line) (- (window-body-height) 1)))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-folding-long-line-right-bottom ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-body-height) 1) ?\n))
|
||||
(insert (make-string (- (window-width) 3) ? ))
|
||||
(popup-tip "long long long long line" :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "long long long long line"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line)
|
||||
(- (window-body-height) 1)))
|
||||
(should (eq (popup-test-helper-popup-end-line) (- (window-body-height) 1)))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-folding-short-line-right-top ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 4) ? ))
|
||||
(popup-tip "\
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla" :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-folding-short-line-left-bottom ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-body-height) 1) ?\n))
|
||||
(popup-tip "\
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla" :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla"))
|
||||
(should (eq (popup-test-helper-popup-end-line) (- (window-body-height) 1)))))
|
||||
|
||||
(ert-deftest popup-test-folding-short-line-right-bottom ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-body-height) 1) ?\n))
|
||||
(insert (make-string (- (window-width) 4) ? ))
|
||||
(popup-tip "\
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla" :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla
|
||||
bla"))
|
||||
(should (eq (popup-test-helper-popup-end-line) (- (window-body-height) 1)))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-margin-at-column1 ()
|
||||
(popup-test-with-common-setup
|
||||
(insert " ")
|
||||
(popup-tip "Margin?" :nowait t :margin t)
|
||||
(should (eq (popup-test-helper-popup-beginning-column)
|
||||
0))
|
||||
(should (popup-test-helper-rectangle-match " Margin? "))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-margin-left ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-tip "Margin?" :nowait t :margin t)
|
||||
(should (eq (popup-test-helper-popup-beginning-column)
|
||||
0))
|
||||
;; Pending: #19
|
||||
;; (should (popup-test-helper-rectangle-match " Margin? "))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-margin-right ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 1) ? ))
|
||||
(popup-tip "Margin?" :nowait t :margin t)
|
||||
(should (popup-test-helper-rectangle-match " Margin? "))
|
||||
;; Pending: #19
|
||||
;; (should (< (popup-test-helper-popup-end-column) (window-width)))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-height-limit ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-tip "\
|
||||
Foo
|
||||
Bar
|
||||
Baz" :nowait t :height 2)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar"))
|
||||
(should-not (popup-test-helper-rectangle-match "Baz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
(should (eq (popup-test-helper-popup-end-line) 3))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-height-limit-bottom ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-body-height) 1) ?\n))
|
||||
(popup-tip "\
|
||||
Foo
|
||||
Bar
|
||||
Baz" :nowait t :height 2)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar"))
|
||||
(should-not (popup-test-helper-rectangle-match "Baz"))
|
||||
(should (eq (popup-test-helper-popup-end-line) (- (window-body-height) 1)))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-scroll-bar ()
|
||||
(popup-test-with-common-setup
|
||||
(let ((popup-scroll-bar-foreground-char
|
||||
(propertize "f" 'face 'popup-scroll-bar-foreground-face))
|
||||
(popup-scroll-bar-background-char
|
||||
(propertize "b" 'face 'popup-scroll-bar-background-face)))
|
||||
(popup-tip "\
|
||||
Foo
|
||||
Bar
|
||||
Baz
|
||||
Fez
|
||||
Oz"
|
||||
:nowait t :height 3 :scroll-bar t :margin t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo f
|
||||
Bar b
|
||||
Baz b"))
|
||||
(should-not (popup-test-helper-rectangle-match "Fez"))
|
||||
(should-not (popup-test-helper-rectangle-match "Oz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
(should (eq (popup-test-helper-popup-end-line) 4))
|
||||
)))
|
||||
|
||||
(ert-deftest popup-test-scroll-bar-right-no-margin ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 1) ? ))
|
||||
(let ((popup-scroll-bar-foreground-char
|
||||
(propertize "f" 'face 'popup-scroll-bar-foreground-face))
|
||||
(popup-scroll-bar-background-char
|
||||
(propertize "b" 'face 'popup-scroll-bar-background-face)))
|
||||
(popup-tip "\
|
||||
Foo
|
||||
Bar
|
||||
Baz
|
||||
Fez
|
||||
Oz"
|
||||
:nowait t :height 3 :scroll-bar t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foof
|
||||
Barb
|
||||
Bazb"))
|
||||
(should-not (popup-test-helper-rectangle-match "Fez"))
|
||||
(should-not (popup-test-helper-rectangle-match "Oz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
(should (eq (popup-test-helper-popup-end-line) 4))
|
||||
)))
|
||||
|
||||
(ert-deftest popup-test-scroll-bar-right-margin ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 1) ? ))
|
||||
(let ((popup-scroll-bar-foreground-char
|
||||
(propertize "f" 'face 'popup-scroll-bar-foreground-face))
|
||||
(popup-scroll-bar-background-char
|
||||
(propertize "b" 'face 'popup-scroll-bar-background-face)))
|
||||
(popup-tip "\
|
||||
Foo
|
||||
Bar
|
||||
Baz
|
||||
Fez
|
||||
Oz"
|
||||
:nowait t :height 3 :scroll-bar t :margin t)
|
||||
(should-not (popup-test-helper-rectangle-match "Fez"))
|
||||
(should-not (popup-test-helper-rectangle-match "Oz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
(should (eq (popup-test-helper-popup-end-line) 4))
|
||||
;; Pending: #21
|
||||
;; (should (popup-test-helper-rectangle-match "\
|
||||
;; Foof
|
||||
;; Barb
|
||||
;; Bazb"))
|
||||
)))
|
||||
|
||||
(ert-deftest popup-test-min-height ()
|
||||
(popup-test-with-common-setup
|
||||
(insert (make-string (- (window-width) 1) ? ))
|
||||
(popup-tip "Hello" :nowait t :min-height 10)
|
||||
(should (popup-test-helper-rectangle-match "Hello"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
(should (eq (popup-test-helper-popup-end-line) 11))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-menu ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-menu* '("Foo" "Bar" "Baz") :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-cascade-menu ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-cascade-menu
|
||||
'(("Foo" "Foo1" "Foo2") "Bar" "Baz") :nowait t)
|
||||
(should (popup-test-helper-rectangle-match "Foo >"))
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz"))
|
||||
(should-not (popup-test-helper-rectangle-match "Foo1"))
|
||||
(should-not (popup-test-helper-rectangle-match "Foo2"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-next ()
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Foo"))
|
||||
(popup-next popup)
|
||||
(should (popup-test-helper-popup-selected-item "Bar"))
|
||||
(popup-next popup)
|
||||
(should (popup-test-helper-popup-selected-item "Baz"))
|
||||
(popup-next popup)
|
||||
(should (popup-test-helper-popup-selected-item "Foo"))
|
||||
(should (popup-test-helper-rectangle-match "Foo\nBar\nBaz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-previous ()
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Foo"))
|
||||
(popup-previous popup)
|
||||
(should (popup-test-helper-popup-selected-item "Baz"))
|
||||
(popup-previous popup)
|
||||
(should (popup-test-helper-popup-selected-item "Bar"))
|
||||
(popup-previous popup)
|
||||
(should (popup-test-helper-popup-selected-item "Foo"))
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-select ()
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Foo"))
|
||||
(popup-select popup 1)
|
||||
(should (popup-test-helper-popup-selected-item "Bar"))
|
||||
(popup-select popup 0)
|
||||
(should (popup-test-helper-popup-selected-item "Foo"))
|
||||
(popup-select popup 2)
|
||||
(should (popup-test-helper-popup-selected-item "Baz"))
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo
|
||||
Bar
|
||||
Baz"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-scroll-down ()
|
||||
(popup-test-with-common-setup
|
||||
(setq popup
|
||||
(popup-cascade-menu (cl-loop for x to 100 collect (format "Foo%d" x))
|
||||
:nowait t :height 10 :margin t :scroll-bar t))
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo0
|
||||
Foo1
|
||||
Foo2"))
|
||||
(should (popup-test-helper-popup-selected-item "Foo0"))
|
||||
(popup-scroll-down popup 10)
|
||||
(should (popup-test-helper-popup-selected-item "Foo10"))
|
||||
(popup-scroll-down popup 10)
|
||||
(should (popup-test-helper-popup-selected-item "Foo20"))
|
||||
(popup-scroll-down popup 100)
|
||||
(should-not (popup-test-helper-rectangle-match "Foo90"))
|
||||
(should (popup-test-helper-rectangle-match "Foo91"))
|
||||
(should (popup-test-helper-rectangle-match "Foo100"))
|
||||
(should-not (popup-test-helper-rectangle-match "Foo0"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-scroll-up ()
|
||||
(popup-test-with-common-setup
|
||||
(setq popup
|
||||
(popup-cascade-menu (cl-loop for x to 100 collect (format "Foo%d" x))
|
||||
:nowait t :height 10 :margin t :scroll-bar t))
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
Foo0
|
||||
Foo1
|
||||
Foo2"))
|
||||
(should (popup-test-helper-popup-selected-item "Foo0"))
|
||||
(popup-scroll-down popup 100)
|
||||
(should (popup-test-helper-popup-selected-item "Foo91"))
|
||||
(popup-scroll-up popup 10)
|
||||
(should (popup-test-helper-popup-selected-item "Foo81"))
|
||||
(popup-scroll-up popup 10)
|
||||
(should-not (popup-test-helper-rectangle-match "Foo70"))
|
||||
(should (popup-test-helper-rectangle-match "Foo71"))
|
||||
(should (popup-test-helper-rectangle-match "Foo80"))
|
||||
(should-not (popup-test-helper-rectangle-match "Foo81"))
|
||||
(should (eq (popup-test-helper-popup-beginning-line) 2))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-two-tip ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-tip "\
|
||||
Foo
|
||||
Bar" :nowait t)
|
||||
(save-excursion (insert "\n"))
|
||||
(popup-tip "\
|
||||
Baz
|
||||
Qux" :nowait t)
|
||||
;; Pending: #20
|
||||
;; (should (popup-test-helper-rectangle-match "\
|
||||
;; Foo
|
||||
;; Bar"))
|
||||
;; (should (popup-test-helper-rectangle-match "\
|
||||
;; Baz
|
||||
;; Qux"))
|
||||
))
|
||||
|
||||
(ert-deftest popup-test-initial-index ()
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :initial-index 0 :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Foo")))
|
||||
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :initial-index 2 :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Baz")))
|
||||
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :initial-index 2 :height 1 :scroll-bar t :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Baz")))
|
||||
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :initial-index -1 :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Foo")))
|
||||
|
||||
(popup-test-with-common-setup
|
||||
(setq popup (popup-menu* '("Foo" "Bar" "Baz") :initial-index 100 :nowait t))
|
||||
(should (popup-test-helper-popup-selected-item "Baz"))))
|
||||
|
||||
(defun popup-test-helper-input (key)
|
||||
(push key unread-command-events))
|
||||
|
||||
(ert-deftest popup-test-isearch ()
|
||||
(popup-test-with-common-setup
|
||||
(popup-test-helper-create-popup "\
|
||||
foo
|
||||
bar
|
||||
baz")
|
||||
(popup-isearch-update popup 'popup-isearch-filter-list "a")
|
||||
(should (popup-test-helper-rectangle-match "\
|
||||
bar
|
||||
baz"))
|
||||
(should-not (popup-test-helper-rectangle-match "foo"))
|
||||
))
|
||||
32
lib/popup/tests/run-test.el
Normal file
32
lib/popup/tests/run-test.el
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
;; Usage:
|
||||
;;
|
||||
;; cask exec emacs -Q -l tests/run-test.el # interactive mode
|
||||
;; cask exec emacs -batch -Q -l tests/run-test.el # batch mode
|
||||
|
||||
|
||||
;; Utils
|
||||
(defun popup-test-join-path (path &rest rest)
|
||||
"Join a list of PATHS with appropriate separator (such as /).
|
||||
|
||||
\(fn &rest paths)"
|
||||
(if rest
|
||||
(concat (file-name-as-directory path) (apply 'popup-test-join-path rest))
|
||||
path))
|
||||
|
||||
(defvar popup-test-dir (file-name-directory load-file-name))
|
||||
(defvar popup-root-dir (concat popup-test-dir ".."))
|
||||
|
||||
|
||||
;; Setup `load-path'
|
||||
(mapc (lambda (p) (add-to-list 'load-path p))
|
||||
(list popup-test-dir
|
||||
popup-root-dir))
|
||||
|
||||
;; Load tests
|
||||
(load "popup-test")
|
||||
|
||||
|
||||
;; Run tests
|
||||
(if noninteractive
|
||||
(ert-run-tests-batch-and-exit)
|
||||
(ert t))
|
||||
Loading…
Add table
Reference in a new issue