test/redisplay-testsuite.el

   1 ;;; redisplay-testsuite.el --- Test suite for redisplay.
   2
   3 ;; Copyright (C) 2009, 2010 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 before/after 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
 169 (defun test-redisplay ()
 170   (interactive)
 171   (let ((buf (get-buffer "*Redisplay Test*")))
 172     (if buf
 173         (kill-buffer buf))
 174     (pop-to-buffer (get-buffer-create "*Redisplay Test*"))
 175     (erase-buffer)
 176     (test-redisplay-1)
 177     (test-redisplay-2)
 178     (test-redisplay-3)
 179     (goto-char (point-min))))
 180
 181 ;; arch-tag: fcee53c8-024f-403d-9154-61ae3ce0bfb8