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

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

[nongnu] elpa/popup 1277ab1 073/184: Merge pull request #23 from uk-ar/u


From: ELPA Syncer
Subject: [nongnu] elpa/popup 1277ab1 073/184: Merge pull request #23 from uk-ar/uk-ar-add-test-case
Date: Wed, 6 Oct 2021 00:01:10 -0400 (EDT)

branch: elpa/popup
commit 1277ab12c0bd07e19525f858bfc0a8a849249ae3
Merge: 6f00052 2593e06
Author: Tomohiro Matsuyama <tomo@cx4a.org>
Commit: Tomohiro Matsuyama <tomo@cx4a.org>

    Merge pull request #23 from uk-ar/uk-ar-add-test-case
    
    Port test from popup-interactive-test.el
---
 tests/popup-test.el | 744 +++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 564 insertions(+), 180 deletions(-)

diff --git a/tests/popup-test.el b/tests/popup-test.el
index 53ce80b..d3ed9a7 100644
--- a/tests/popup-test.el
+++ b/tests/popup-test.el
@@ -7,16 +7,7 @@
 (when (< (frame-width) (length "long long long long line"))
   (set-frame-size (selected-frame) 80 35))
 
-(defmacro popup-test-with-create-popup (&rest body)
-  (declare (indent 0) (debug t))
-  `(let ((popup (popup-create (point) 10 10)))
-     (unwind-protect
-         (progn ,@body)
-       (when popup
-         (popup-delete popup)))
-     ))
-
-(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
@@ -26,108 +17,234 @@
        ,@body
        )))
 
-(defmacro popup-test-with-common-setup (&rest body)
-  (declare (indent 0) (debug t))
-  `(popup-test-with-temp-buffer
-     (popup-test-with-create-popup ,@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)
-     (save-excursion (goto-char point) (current-column)))
-   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-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-input (key)
-  (push key unread-command-events))
+(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))
+          (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)
+        with contents
+        for overlay in (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-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")))
+    ))
 
+(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-set-list popup '("foo" "bar" "baz"))
-    (popup-draw popup)
-    (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 (every #'identity points))
-        (should (equal (popup-test-helper-points-to-columns points) '(0 0 0)))
-        (should (eq (popup-test-helper-same-all-p
-                     (popup-test-helper-points-to-columns points)) 0))))))
+    (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-live-p popup))))
+    (should-not (popup-test-helper-rectangle-match "\
+foo
+bar
+baz"))
+    ))
 
 (ert-deftest popup-test-hide ()
   (popup-test-with-common-setup
-    (popup-set-list popup '("foo" "bar" "baz"))
-    (popup-draw popup)
+    (popup-test-helper-create-popup "\
+foo
+bar
+baz")
     (popup-hide popup)
-    (should (equal (popup-list popup) '("foo" "bar" "baz")))
-    (with-current-buffer (popup-test-helper-get-overlays-buffer)
-      (should-not (every #'identity
-                         (popup-test-helper-match-points '("foo" "bar" 
"baz")))))
+    (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-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
@@ -141,113 +258,380 @@ 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)
-    (with-current-buffer (popup-test-helper-get-overlays-buffer)
-      (let ((points (popup-test-helper-match-points
-                     '("CURSOR-COLOR is a cursor color during isearch"
-                       "KEYMAP is a keymap"))))
-        (should (every #'identity points))
-        (should (eq (popup-test-helper-same-all-p
-                     (popup-test-helper-points-to-columns points)) 0)))
-      )))
-
-(ert-deftest popup-test-culumn ()
-  (popup-test-with-temp-buffer
-    (insert " ")
-    (popup-test-with-create-popup
-      (popup-set-list popup '("foo" "bar" "baz"))
-      (popup-draw popup)
-      (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 (every #'identity points))
-          (should (equal (popup-test-helper-points-to-columns points)
-                         '(1 1 1)))
-          )
-        ))))
+               :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-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)
+    (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))
-          )))))
+    (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 (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 (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"))
+   ))
+
+(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 "a")
+    (should (popup-test-helper-rectangle-match "\
+bar
+baz"))
+    (should-not (popup-test-helper-rectangle-match "foo"))
+    ))



reply via email to

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