test/redisplay-testsuite.el

   1 ;;; redisplay-testsuite.el --- Test suite for redisplay.
   2
   3 ;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Chong Yidong <cyd@stupidchicken.com>
   6 ;; Keywords:       internal
   7 ;; Human-Keywords: internal
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Type M-x test-redisplay RET to generate the test buffer.
  27
  28 ;;; Code:
  29
  30 (defun test-insert-overlay (text &rest props)
  31   (let ((opoint (point))
  32         overlay)
  33     (insert text)
  34     (setq overlay (make-overlay opoint (point)))
  35     (while props
  36       (overlay-put overlay (car props) (cadr props))
  37       (setq props (cddr props)))))
  38
  39 (defun test-redisplay-1 ()
  40   (insert "Test 1: Displaying adjacent and overlapping overlays:\n\n")
  41   (insert "  Expected: gnu emacs\n")
  42   (insert "  Results:  ")
  43   (test-insert-overlay "n" 'before-string "g" 'after-string  "u ")
  44   (test-insert-overlay "ma" 'before-string "e" 'after-string  "cs")
  45   (insert "\n\n")
  46   (insert "  Expected: gnu emacs\n")
  47   (insert "  Results:  ")
  48   (test-insert-overlay "u" 'before-string "gn")
  49   (test-insert-overlay "ma" 'before-string " e" 'after-string  "cs")
  50   (insert "\n\n")
  51   (insert "  Expected: gnu emacs\n")
  52   (insert "  Results:  ")
  53   (test-insert-overlay "XXX" 'display "u "
  54                        'before-string "gn" 'after-string  "em")
  55   (test-insert-overlay "a" 'after-string  "cs")
  56   (insert "\n\n")
  57   (insert "  Expected: gnu emacs\n")
  58   (insert "  Results:  ")
  59   (test-insert-overlay "u " 'before-string "gn" 'after-string  "em")
  60   (test-insert-overlay "XXX" 'display "a" 'after-string  "cs")
  61   (insert "\n\n"))
  62
  63 (defun test-redisplay-2 ()
  64   (insert "Test 2: Mouse highlighting.  Move your mouse over the letters XXX:\n\n")
  65   (insert "  Expected: "
  66           (propertize "xxxXXXxxx" 'face 'highlight)
  67           "...---...\n  Test:     ")
  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)
  73           "...---...\n  Test:     ")
  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)
  78           "...---...\n  Test:     ")
  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)
  83           "...\n  Test:     ")
  84   (test-insert-overlay "..." 'display "XXX" 'after-string "xxx"
  85                        'mouse-face 'highlight)
  86   (test-insert-overlay "error" 'display "...")
  87   (insert "\n\n  Expected: "
  88           "---..."
  89           (propertize "xxxXXX" 'face 'highlight)
  90           "\n  Test:     ")
  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: "
  95           "...---..."
  96           (propertize "xxxXXXxxx" 'face 'highlight)
  97           "\n  Test:     ")
  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: "
 102           "..."
 103           (propertize "XXX" 'face 'highlight)
 104           "...\n  Test:     ")
 105   (test-insert-overlay "---"
 106                        'display (propertize "XXX" 'mouse-face 'highlight)
 107                        'before-string "..."
 108                        'after-string  "...")
 109   (insert "\n\n  Expected: "
 110           (propertize "XXX\n" 'face 'highlight)
 111           "\n  Test:     ")
 112   (test-insert-overlay "XXX\n" 'mouse-face 'highlight)
 113   (insert "\n\n"))
 114
 115 (defun test-redisplay-3 ()
 116   (insert "Test 3: Overlay with strings and images:\n\n")
 117   (let ((img-data "#define x_width 8
 118 #define x_height 8
 119 static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff };"))
 120     ;; Control
 121     (insert "  Expected: AB"
 122             (propertize "X" 'display `(image :data ,img-data :type xbm))
 123             "CD\n")
 124
 125     ;; Overlay with before, after, and image display string.
 126     (insert "  Result 1: ")
 127     (let ((opoint (point)))
 128       (insert "AXD\n")
 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))))
 134
 135     ;; Overlay with before and after string, and image text prop.
 136     (insert "  Result 2: ")
 137     (let ((opoint (point)))
 138       (insert "AXD\n")
 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))))
 144
 145     ;; Overlays with adjacent before and after strings, and image text
 146     ;; prop.
 147     (insert "  Result 3: ")
 148     (let ((opoint (point)))
 149       (insert "AXD\n")
 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))))
 156
 157     ;; Three overlays.
 158     (insert "  Result 4: ")
 159     (let ((opoint (point)))
 160       (insert "AXD\n\n")
 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))))))
 167
 168 (defun test-redisplay-4 ()
 169   (insert "Test 4: Overlay strings and invisibility:\n\n")
 170   ;; Before and after strings with non-nil `invisibility'.
 171   (insert "  Expected: ABC\n")
 172   (insert "    Result: ")
 173   (let ((opoint (point)))
 174     (insert "ABC\n")
 175     (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
 176       (overlay-put ov 'before-string
 177                    (propertize "XX" 'invisible
 178                                'test-redisplay--simple-invis))
 179       (overlay-put ov 'after-string
 180                    (propertize "XX" 'invisible
 181                                'test-redisplay--simple-invis))))
 182
 183   ;; Before and after strings bogus `invisibility' property (value is
 184   ;; not listed in `buffer-invisibility-spec').
 185   (insert "\n  Expected: ABC")
 186   (insert "\n    Result: ")
 187   (let ((opoint (point)))
 188     (insert "B\n")
 189     (let ((ov (make-overlay opoint (1+ opoint))))
 190       (overlay-put ov 'before-string
 191                    (propertize "A" 'invisible 'bogus-invis-spec))
 192       (overlay-put ov 'after-string
 193                    (propertize "C" 'invisible 'bogus-invis-spec))))
 194
 195   ;; Before/after string with ellipsis `invisibility' property.
 196   (insert "\n  Expected: ...B...")
 197   (insert "\n    Result: ")
 198   (let ((opoint (point)))
 199     (insert "B\n")
 200     (let ((ov (make-overlay opoint (1+ opoint))))
 201       (overlay-put ov 'before-string
 202                    (propertize "A" 'invisible 'test-redisplay--ellipsis-invis))
 203       (overlay-put ov 'after-string
 204                    (propertize "C" 'invisible 'test-redisplay--ellipsis-invis))))
 205
 206   ;; Before/after string with partial ellipsis `invisibility' property.
 207   (insert "\n  Expected: A...ABC...C")
 208   (insert "\n    Result: ")
 209   (let ((opoint (point)))
 210     (insert "B\n")
 211     (let ((ov (make-overlay opoint (1+ opoint)))
 212           (a "AAA")
 213           (c "CCC"))
 214       (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis a)
 215       (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis c)
 216       (overlay-put ov 'before-string a)
 217       (overlay-put ov 'after-string  c)))
 218
 219   ;; Display string with `invisibility' property.
 220   (insert "\n  Expected: ABC")
 221   (insert "\n    Result: ")
 222   (let ((opoint (point)))
 223     (insert "AYBC\n")
 224     (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
 225       (overlay-put ov 'display
 226                    (propertize "XX" 'invisible
 227                                'test-redisplay--simple-invis))))
 228   ;; Display string with bogus `invisibility' property.
 229   (insert "\n  Expected: ABC")
 230   (insert "\n    Result: ")
 231   (let ((opoint (point)))
 232     (insert "AXC\n")
 233     (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
 234       (overlay-put ov 'display
 235                    (propertize "B" 'invisible 'bogus-invis-spec))))
 236   ;; Display string with ellipsis `invisibility' property.
 237   (insert "\n  Expected: A...C")
 238   (insert "\n    Result: ")
 239   (let ((opoint (point)))
 240     (insert "AXC\n")
 241     (let ((ov (make-overlay (1+ opoint) (+ 2 opoint))))
 242       (overlay-put ov 'display
 243                    (propertize "B" 'invisible
 244                                'test-redisplay--ellipsis-invis))))
 245   ;; Display string with partial `invisibility' property.
 246   (insert "\n  Expected: A...C")
 247   (insert "\n    Result: ")
 248   (let ((opoint (point)))
 249     (insert "X\n")
 250     (let ((ov  (make-overlay opoint (1+ opoint)))
 251           (str "ABC"))
 252       (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str)
 253       (overlay-put ov 'display str)))
 254
 255   (insert "\n"))
 256
 257
 258 (defun test-redisplay ()
 259   (interactive)
 260   (let ((buf (get-buffer "*Redisplay Test*")))
 261     (if buf
 262         (kill-buffer buf))
 263     (switch-to-buffer (get-buffer-create "*Redisplay Test*"))
 264     (erase-buffer)
 265     (setq buffer-invisibility-spec
 266           '(test-redisplay--simple-invis
 267             (test-redisplay--ellipsis-invis . t)))
 268     (test-redisplay-1)
 269     (test-redisplay-2)
 270     (test-redisplay-3)
 271     (test-redisplay-4)
 272     (goto-char (point-min))))
 273