branch: elpa/popup
commit 37c8761d5c8e6afc4e64ec5acc8fc1e1515998e2
Author: uk-ar <yuuki....@gmail.com>
Commit: uk-ar <yuuki....@gmail.com>
Refactoring all test cases
---
tests/popup-test.el | 818 +++++++++++++++++++++++++++-------------------------
1 file changed, 419 insertions(+), 399 deletions(-)
diff --git a/tests/popup-test.el b/tests/popup-test.el
index a8357b0..819c0d7 100644
--- a/tests/popup-test.el
+++ b/tests/popup-test.el
@@ -7,7 +7,7 @@
(when (< (frame-width) (length "long long long long line"))
(set-frame-size (selected-frame) 80 35))
-(defmacro popup-test-with-temp-buffer (&rest body)
+(defmacro popup-test-with-common-setup (&rest body)
(declare (indent 0) (debug t))
`(save-excursion
(with-temp-buffer
@@ -17,85 +17,6 @@
,@body
)))
-(defun popup-test-helper-get-overlays-buffer ()
- "Create a new buffer called *text* containing the visible text
-of the current buffer, ie. it converts overlays containing text
-into real text. Return *text* buffer"
- (interactive)
- (let ((tb (get-buffer-create "*text*"))
- (s (point-min))
- (os (overlays-in (point-min) (point-max))))
- (with-current-buffer tb
- (erase-buffer))
- (setq os (sort os (lambda (o1 o2)
- (< (overlay-start o1)
- (overlay-start o2)))))
- (mapc (lambda (o)
- (let ((bt (buffer-substring-no-properties s (overlay-start o)))
- (b (overlay-get o 'before-string))
- (text (or (overlay-get o 'display)
- (buffer-substring-no-properties (overlay-start o)
(overlay-end o))))
- (a (overlay-get o 'after-string))
- (inv (overlay-get o 'invisible)))
- (with-current-buffer tb
- (insert bt)
- (unless inv
- (when b (insert b))
- (insert text)
- (when a (insert a))))
- (setq s (overlay-end o))))
- os)
- (let ((x (buffer-substring-no-properties s (point-max))))
- (with-current-buffer tb
- (insert x)
- tb))))
-
-(defun popup-test-helper-match-points (strings)
- "Return list of start of first match"
- (when (listp strings)
- (let ((text (buffer-string)))
- (mapcar
- (lambda (content)
- (let ((pos (string-match (regexp-quote content) text)))
- (if (null pos) pos (1+ pos))))
- strings))))
-
-(defun popup-test-helper-points-to-columns (points)
- "Return list of colum"
- (mapcar
- (lambda (point)
- (if point
- (save-excursion (goto-char point) (current-column))
- nil))
- points))
-
-(defun popup-test-helper-same-all-p (seq)
- "Return first element if `eq' every element of SEQ.If not, return nil."
- (reduce #'(lambda (x y) (if (eq x y) x nil)) seq))
-
-(defun popup-test-helper-input (key)
- (push key unread-command-events))
-
-(defun popup-test-helper-in-popup-p ()
- (let* ((face (get-text-property (point) 'face))
- (face (if (listp face) face (list face))))
- (some (lambda (face) (if (memq face '(popup-tip-face popup-face)) t nil))
- face)))
-
-(defun popup-test-helper-last-popup-line ()
- "Return (START END) list of last popup line"
- (save-excursion
- (end-of-buffer)
- (let ((end (point)))
- (while (and (not (popup-test-helper-in-popup-p))
- (let ((pos (previous-single-property-change (point) 'face)))
- (when pos
- (setq end (point))
- (goto-char pos))
- pos)))
- (if (popup-test-helper-in-popup-p) `(,(point) ,end) nil)
- )))
-
(defun popup-test-helper-line-move-visual (arg)
"This function is workaround. Because `line-move-visual' can not work well in
batch mode."
@@ -106,16 +27,20 @@ batch mode."
(move-to-column (+ (current-column) cur-col))))
(defun popup-test-helper-rectangle-match (str)
- (goto-char (point-max))
- (let ((strings (split-string str)))
- (search-backward (car strings) nil t)
- (every
- 'identity
- (mapcar
- (lambda (elem)
- (popup-test-helper-line-move-visual 1)
- (looking-at (regexp-quote elem)))
- (cdr strings)))))
+ (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))
+ (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 ()
(loop with start = (point-min)
@@ -137,55 +62,171 @@ batch mode."
(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)))
+ (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 (point)) nil)
+ ))))
+
+(defun popup-test-helper-debug ()
+ (let ((buffer-contents (popup-test-helper-buffer-contents)))
+ (with-current-buffer (get-buffer-create "*dump*")
+ (insert buffer-contents)
+ (buffer-string)
+ )))
;; Test for helper method
-(ert-deftest popup-test-test-helper ()
- (should (eq (popup-test-helper-same-all-p '(0 0 0)) 0))
- (should (eq (popup-test-helper-same-all-p '(1 1 1)) 1))
- (should (eq (popup-test-helper-same-all-p '(0 1 1)) nil))
- )
+(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")))
+ ))
-;; Test for popup-el
-(defvar popup nil)
+(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-temp-buffer
- (insert (popup-test-with-temp-buffer
- (setq popup (popup-create (point) 10 10))
- (popup-set-list popup '("foo" "bar" "baz"))
- (popup-draw popup)
- (should (equal (popup-list popup) '("foo" "bar" "baz")))
- (popup-test-helper-buffer-contents)))
- (should (eq t (popup-test-helper-rectangle-match "\
+ (popup-test-with-common-setup
+ (popup-test-helper-create-popup "\
+foo
+bar
+baz")
+ (should (popup-test-helper-rectangle-match "\
foo
bar
-baz")))
- (should (eq (current-column) 0))))
+baz"))
+ (should (eq (popup-test-helper-popup-beginning-column) 0))))
(ert-deftest popup-test-delete ()
- (popup-test-with-temp-buffer
- (setq popup (popup-create (point) 10 10))
+ (popup-test-with-common-setup
+ (popup-test-helper-create-popup "\
+foo
+bar
+baz")
(popup-delete popup)
- (should-not (popup-live-p popup))))
+ (should-not (popup-test-helper-rectangle-match "\
+foo
+bar
+baz"))
+ ))
(ert-deftest popup-test-hide ()
- (popup-test-with-temp-buffer
- (insert (popup-test-with-temp-buffer
- (setq popup (popup-create (point) 10 10))
- (popup-set-list popup '("foo" "bar" "baz"))
- (popup-draw popup)
- (popup-hide popup)
- (should (equal (popup-list popup) '("foo" "bar" "baz")))
- (popup-test-helper-buffer-contents)))
- (should-not (eq t (popup-test-helper-rectangle-match "\
+ (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")))))
+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-temp-buffer
- (insert (popup-test-with-temp-buffer
- (popup-tip
- "Start isearch on POPUP. This function is synchronized, meaning
+ (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
@@ -200,327 +241,306 @@ canceled. The arguments is whole filtered list of items.
HELP-DELAY is a delay of displaying helps."
:nowait t)
- (popup-test-helper-buffer-contents)))
- (should-not (eq t (popup-test-helper-rectangle-match "\
+ (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-column ()
- (popup-test-with-temp-buffer
- (popup-test-with-temp-buffer
- (insert (popup-test-with-temp-buffer
- (insert " ")
- (setq popup (popup-create (point) 10 10))
- (popup-set-list popup '("foo" "bar" "baz"))
- (popup-draw popup)
- (should (equal (popup-list popup) '("foo" "bar" "baz")))
- (popup-test-helper-buffer-contents)))
- (should (eq t (popup-test-helper-rectangle-match "\
-foo
-bar
-baz")))
- (should (eq (current-column) 1)))
+event loop. The default value is `popup-isearch-keymap'."))
))
(ert-deftest popup-test-folding-long-line-right-top ()
- (popup-test-with-temp-buffer
+ (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)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("long long long long line"))))
- (should (every #'identity points))
- (should (eq (line-number-at-pos (car points)) 2))
- ))))
+ (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-temp-buffer
+ (popup-test-with-common-setup
(insert (make-string (- (window-body-height) 1) ?\n))
(popup-tip "long long long long line" :nowait t)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("long long long long line"))))
- (should (every #'identity points))
- (should (eq (line-number-at-pos (car points))
- (- (window-body-height) 1)))
- ))))
+ (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-temp-buffer
+ (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)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("long long long long line"))))
- (should (every #'identity points))
- (should (eq (line-number-at-pos (car points))
- (- (window-body-height) 1))))
- )))
+ (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-temp-buffer
- (insert (make-string (- (window-width) 3) ? ))
- (popup-tip "bla\nbla\nbla\nbla\nbla" :nowait t)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("bla"))))
- (should (every #'identity points))
- (should (eq (line-number-at-pos (car points)) 2))
- ))))
+ (popup-test-with-common-setup
+ (insert (make-string (- (window-width) 4) ? ))
+ (popup-tip "\
+bla
+bla
+bla
+bla
+bla" :nowait t)
+ (message (popup-test-helper-debug))
+ (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-temp-buffer
+ (popup-test-with-common-setup
(insert (make-string (- (window-body-height) 1) ?\n))
- (popup-tip "bla\nbla\nbla\nbla\nbla" :nowait t)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("bla"))))
- (should (every #'identity points))
- (should (eq (popup-test-helper-same-all-p
- (popup-test-helper-points-to-columns points)) 0))
- (should (eq (line-number-at-pos (car points))
- (- (window-body-height) 5)))
- ))))
+ (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-temp-buffer
+ (popup-test-with-common-setup
(insert (make-string (- (window-body-height) 1) ?\n))
- (insert (make-string (- (window-width) 3) ? ))
- (popup-tip "bla\nbla\nbla\nbla\nbla" :nowait t)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("bla"))))
- (should (every #'identity points))
- (should (eq (line-number-at-pos (car points))
- (- (window-body-height) 5))))
- )))
+ (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-middle ()
- (popup-test-with-temp-buffer
+(ert-deftest popup-test-margin-at-column1 ()
+ (popup-test-with-common-setup
(insert " ")
- (let ((popup (popup-tip "Margin?" :nowait t :margin t)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points '(" Margin? "))))
- (should (every #'identity points))
- (should (equal (car (popup-test-helper-points-to-columns points))
- 0))
- )))))
-
-(ert-deftest popup-test-two-lines ()
- (popup-test-with-temp-buffer
- (let ((popup (popup-tip "Foo\nBar\nBaz" :nowait t :height 2)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points '("Foo" "Bar" "Baz"))))
- (should (equal points '(2 6 nil)))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 nil)))
- (should (eq (line-number-at-pos (car points)) 2))
- )))))
-
-(ert-deftest popup-test-two-lines-bottom ()
- (popup-test-with-temp-buffer
+ (popup-tip "Margin?" :nowait t :margin t)
+ (should (popup-test-helper-rectangle-match "Margin?"))
+ ;; Pending:
+ ;; (should (eq (popup-test-helper-popup-beginning-column)
+ ;; 1))
+ ))
+
+(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))
- (let ((popup (popup-tip "Foo\nBar\nBaz" :nowait t :height 2)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points '("Foo" "Bar" "Baz"))))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 nil)))
- (should (eq (line-number-at-pos (car points))
- (- (window-body-height) 2)))
- )))))
+ (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-temp-buffer
- (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 (popup-tip "Foo\nBar\nBaz\nFez\nOz"
- :nowait t :height 3 :scroll-bar t :margin t)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo f" "Bar b" "Baz b" "Fez"))))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0 nil)))
- (should (eq (line-number-at-pos (car points)) 2))
- )))))
+ (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-temp-buffer
+ (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 (popup-tip "Foo\nBar\nBaz\nFez\nOz"
- :nowait t :height 3 :scroll-bar t)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foof" "Barb" "Bazb"))))
- (should (equal (popup-test-helper-same-all-p
- (popup-test-helper-points-to-columns points))
- (- (window-width) 5)))
- (should (eq (line-number-at-pos (car points)) 2))
- )))))
+ (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))
+ ;; (should (eq (popup-test-helper-popup-beginning-column)
+ ;; (- (window-width) 5)))
+ )))
(ert-deftest popup-test-min-height ()
- (popup-test-with-temp-buffer
+ (popup-test-with-common-setup
(insert (make-string (- (window-width) 1) ? ))
- (let ((popup (popup-tip "Hello" :nowait t :min-height 10)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Hello")))
- (last-bounds (popup-test-helper-last-popup-line)))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (eq
- (car (popup-test-helper-points-to-columns points))
- (car (popup-test-helper-points-to-columns last-bounds))))
- (should (eq (line-number-at-pos (car last-bounds)) 11))
- (should (eq (nth 1 (popup-test-helper-points-to-columns last-bounds))
- (1- (window-width))))
- )))))
+ (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-temp-buffer
- (let ((popup (popup-menu* '("Foo" "Bar" "Baz") :nowait t)))
- (should (equal (popup-list popup) '("Foo" "Bar" "Baz")))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo" "Bar" "Baz"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0)))
- )))))
+ (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-temp-buffer
- (let ((popup (popup-cascade-menu
- '(("Foo" "Foo1" "Foo2") "Bar" "Baz") :nowait t :margin t)))
- (should (string= (car (popup-list popup)) "Foo"))
- (should (equal (popup-item-sublist (car (popup-list popup)))
- '("Foo1" "Foo2")))
- (should (equal (popup-item-symbol (car (popup-list popup))) ">"))
- (should (equal (cdr (popup-list popup)) '("Bar" "Baz")))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo" "Bar" "Baz" "Foo1"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0 nil)))
- )))))
+ (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-temp-buffer
- (let ((popup (popup-cascade-menu
- '("Foo" "Bar" "Baz") :nowait t :margin t)))
- (should (equal (popup-list popup) '("Foo" "Bar" "Baz")))
- (should (equal (popup-selected-item popup) "Foo"))
- (popup-next popup)
- (should (equal (popup-selected-item popup) "Bar"))
- (popup-next popup)
- (should (equal (popup-selected-item popup) "Baz"))
- (popup-next popup)
- (should (equal (popup-selected-item popup) "Foo"))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo" "Bar" "Baz"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0)))
- )))))
+ (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-temp-buffer
- (let ((popup (popup-cascade-menu
- '("Foo" "Bar" "Baz") :nowait t :margin t)))
- (should (equal (popup-list popup) '("Foo" "Bar" "Baz")))
- (should (equal (popup-selected-item popup) "Foo"))
- (popup-previous popup)
- (should (equal (popup-selected-item popup) "Baz"))
- (popup-previous popup)
- (should (equal (popup-selected-item popup) "Bar"))
- (popup-previous popup)
- (should (equal (popup-selected-item popup) "Foo"))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo" "Bar" "Baz"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0)))
- )))))
+ (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-temp-buffer
- (let ((popup (popup-cascade-menu
- '("Foo" "Bar" "Baz") :nowait t :margin t)))
- (should (equal (popup-list popup) '("Foo" "Bar" "Baz")))
- (should (equal (popup-selected-item popup) "Foo"))
- (popup-select popup 1)
- (should (equal (popup-selected-item popup) "Bar"))
- (popup-select popup 0)
- (should (equal (popup-selected-item popup) "Foo"))
- (popup-select popup 2)
- (should (equal (popup-selected-item popup) "Baz"))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo" "Bar" "Baz"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0)))
- )))))
+ (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-temp-buffer
- (let ((popup
- (popup-cascade-menu (loop for x to 100 collect (format "Foo%d" x))
- :nowait t :height 10 :margin t :scroll-bar t)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo0" "Foo1" "Foo2"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0)))
- ))
- (should (equal (popup-selected-item popup) "Foo0"))
- (popup-scroll-down popup 10)
- (should (equal (popup-selected-item popup) "Foo10"))
- (popup-scroll-down popup 10)
- (should (equal (popup-selected-item popup) "Foo20"))
- (popup-scroll-down popup 100)
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo91" "Foo100" "Foo90"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 nil)))
- ))
- )))
+ (popup-test-with-common-setup
+ (setq popup
+ (popup-cascade-menu (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-temp-buffer
- (let ((popup
- (popup-cascade-menu (loop for x to 100 collect (format "Foo%d" x))
- :nowait t :height 10 :margin t :scroll-bar t)))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo0" "Foo1" "Foo2"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 0)))
- ))
- (should (equal (popup-selected-item popup) "Foo0"))
- (popup-scroll-down popup 100)
- (should (equal (popup-selected-item popup) "Foo91"))
- (popup-scroll-up popup 10)
- (should (equal (popup-selected-item popup) "Foo81"))
- (with-current-buffer (popup-test-helper-get-overlays-buffer)
- (let ((points (popup-test-helper-match-points
- '("Foo81" "Foo90" "Foo80"))))
- (should (eq (line-number-at-pos (car points)) 2))
- (should (equal (popup-test-helper-points-to-columns points)
- '(0 0 nil)))
- ))
- )))
+ (popup-test-with-common-setup
+ (setq popup
+ (popup-cascade-menu (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))
+ ))
