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"))
 114
 115 (defun test-redisplay ()
 116   (interactive)
 117   (pop-to-buffer (generate-new-buffer "*Redisplay Test*"))
 118   (test-redisplay-1)
 119   (test-redisplay-2)
 120   (goto-char (point-min)))
 121
 122 ;; arch-tag: fcee53c8-024f-403d-9154-61ae3ce0bfb8