1 ;;; redisplay-testsuite.el --- Test suite for redisplay.
3 ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Chong Yidong <cyd@stupidchicken.com>
7 ;; Human-Keywords: internal
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Type M-x test-redisplay RET to generate the test buffer.
30 (defun test-insert-overlay (text &rest props)
31 (let ((opoint (point))
34 (setq overlay (make-overlay opoint (point)))
36 (overlay-put overlay (car props) (cadr props))
37 (setq props (cddr props)))))
39 (defun test-redisplay-1 ()
40 (insert "Test 1: Displaying adjacent and overlapping overlays:\n\n")
41 (insert " Expected: gnu emacs\n")
43 (test-insert-overlay "n" 'before-string "g" 'after-string "u ")
44 (test-insert-overlay "ma" 'before-string "e" 'after-string "cs")
46 (insert " Expected: gnu emacs\n")
48 (test-insert-overlay "u" 'before-string "gn")
49 (test-insert-overlay "ma" 'before-string " e" 'after-string "cs")
51 (insert " Expected: gnu emacs\n")
53 (test-insert-overlay "XXX" 'display "u "
54 'before-string "gn" 'after-string "em")
55 (test-insert-overlay "a" 'after-string "cs")
57 (insert " Expected: gnu emacs\n")
59 (test-insert-overlay "u " 'before-string "gn" 'after-string "em")
60 (test-insert-overlay "XXX" 'display "a" 'after-string "cs")
63 (defun test-redisplay-2 ()
64 (insert "Test 2: Mouse highlighting. Move your mouse over the letters XXX:\n\n")
66 (propertize "xxxXXXxxx" 'face 'highlight)
68 (test-insert-overlay "XXX" 'before-string "xxx" 'after-string "xxx"
69 'mouse-face 'highlight )
70 (test-insert-overlay "---" 'before-string "..." 'after-string "...")
71 (insert "\n\n Expected: "
72 (propertize "xxxXXX" 'face 'highlight)
74 (test-insert-overlay "XXX" 'before-string "xxx" 'mouse-face 'highlight)
75 (test-insert-overlay "---" 'before-string "..." 'after-string "...")
76 (insert "\n\n Expected: "
77 (propertize "XXX" 'face 'highlight)
79 (test-insert-overlay "..." 'display "XXX" 'mouse-face 'highlight)
80 (test-insert-overlay "---" 'before-string "..." 'after-string "...")
81 (insert "\n\n Expected: "
82 (propertize "XXXxxx" 'face 'highlight)
84 (test-insert-overlay "..." 'display "XXX" 'after-string "xxx"
85 'mouse-face 'highlight)
86 (test-insert-overlay "error" 'display "...")
87 (insert "\n\n Expected: "
89 (propertize "xxxXXX" 'face 'highlight)
91 (test-insert-overlay "xxx" 'display "---" 'after-string "...")
92 (test-insert-overlay "error" 'before-string "xxx" 'display "XXX"
93 'mouse-face 'highlight)
94 (insert "\n\n Expected: "
96 (propertize "xxxXXXxxx" 'face 'highlight)
98 (test-insert-overlay "---" 'before-string "..." 'after-string "...")
99 (test-insert-overlay "XXX" 'before-string "xxx" 'after-string "xxx"
100 'mouse-face 'highlight)
101 (insert "\n\n Expected: "
103 (propertize "XXX" 'face 'highlight)
105 (test-insert-overlay "---"
106 'display (propertize "XXX" 'mouse-face 'highlight)
109 (insert "\n\n Expected: "
110 (propertize "XXX\n" 'face 'highlight)
112 (test-insert-overlay "XXX\n" 'mouse-face 'highlight)
115 (defun test-redisplay-3 ()
116 (insert "Test 3: Overlay with before/after strings and images:\n\n")
117 (let ((img-data "#define x_width 8
119 static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff };"))
121 (insert " Expected: AB"
122 (propertize "X" 'display `(image :data ,img-data :type xbm))
125 ;; Overlay with before, after, and image display string.
126 (insert " Result 1: ")
127 (let ((opoint (point)))
129 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
130 (overlay-put ov 'before-string "B")
131 (overlay-put ov 'after-string "C")
132 (overlay-put ov 'display
133 `(image :data ,img-data :type xbm))))
135 ;; Overlay with before and after string, and image text prop.
136 (insert " Result 2: ")
137 (let ((opoint (point)))
139 (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
140 (overlay-put ov 'before-string "B")
141 (overlay-put ov 'after-string "C")
142 (put-text-property (1+ opoint) (+ 2 opoint) 'display
143 `(image :data ,img-data :type xbm))))
145 ;; Overlays with adjacent before and after strings, and image text
147 (insert " Result 3: ")
148 (let ((opoint (point)))
150 (let ((ov1 (make-overlay opoint (1+ opoint)))
151 (ov2 (make-overlay (+ 2 opoint) (+ 3 opoint))))
152 (overlay-put ov1 'after-string "B")
153 (overlay-put ov2 'before-string "C")
154 (put-text-property (1+ opoint) (+ 2 opoint) 'display
155 `(image :data ,img-data :type xbm))))
158 (insert " Result 4: ")
159 (let ((opoint (point)))
161 (let ((ov1 (make-overlay opoint (1+ opoint)))
162 (ov2 (make-overlay (+ 2 opoint) (+ 3 opoint)))
163 (ov3 (make-overlay (1+ opoint) (+ 2 opoint))))
164 (overlay-put ov1 'after-string "B")
165 (overlay-put ov2 'before-string "C")
166 (overlay-put ov3 'display `(image :data ,img-data :type xbm))))))
169 (defun test-redisplay ()
171 (let ((buf (get-buffer "*Redisplay Test*")))
174 (pop-to-buffer (get-buffer-create "*Redisplay Test*"))
179 (goto-char (point-min))))
181 ;; arch-tag: fcee53c8-024f-403d-9154-61ae3ce0bfb8