emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/popup 37c8761 070/184: Refactoring all test cases


From: ELPA Syncer
Subject: [nongnu] elpa/popup 37c8761 070/184: Refactoring all test cases
Date: Wed, 6 Oct 2021 00:01:09 -0400 (EDT)

branch: elpa/popup
commit 37c8761d5c8e6afc4e64ec5acc8fc1e1515998e2
Author: uk-ar <yuuki.ari@gmail.com>
Commit: uk-ar <yuuki.ari@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))
+    ))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]