Mercurial > hg > xemacs-beta
annotate tests/glyph-test.el @ 4897:91a023144e72
fix longstanding search bug involving searching for Control-1 chars
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-29 Ben Wing <ben@xemacs.org>
* search.c (boyer_moore): Fix longstanding bug involving
searching for Control-1 chars; code was trying to directly
extract the last byte in the textual representation of a char
from an Ichar (and doing it in a buggy fashion) rather than
just converting the Ichar to text and looking at the last byte.
tests/ChangeLog addition:
2010-01-29 Ben Wing <ben@xemacs.org>
* automated/search-tests.el:
New file.
* automated/search-tests.el:
* automated/case-tests.el:
* automated/case-tests.el (pristine-case-table): Removed.
* automated/case-tests.el (uni-mappings):
* automated/lisp-tests.el:
* automated/regexp-tests.el:
Extract some search-related code from case-tests and regexp-tests
and move to search-tests. Move some regexp-related code from
lisp-tests to regexp-tests.
Write a comment trying to express the proper division of labor
between case-tests, search-tests and regexp-tests.
Add a new test for the Control-1 search bug.
Fix a buggy test in the Unicode torture-test section of case-tests.el.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 29 Jan 2010 20:57:42 -0600 |
| parents | 8a653fbe5c27 |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
|
4781
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
1 ;;; Copyright (C) 1998 Andy Piper |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
2 |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
3 ;;; This file is part of XEmacs. |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
4 |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
5 ;;; XEmacs is free software; you can redistribute it and/or modify it |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
6 ;;; under the terms of the GNU General Public License as published by |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
7 ;;; the Free Software Foundation; either version 2, or (at your |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
8 ;;; option) any later version. |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
9 |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
10 ;;; XEmacs is distributed in the hope that it will be useful, but |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
11 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
13 ;;; General Public License for more details. |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
14 |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
15 ;;; You should have received a copy of the GNU General Public License |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
16 ;;; along with XEmacs; see the file COPYING. If not, write to the Free |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
17 ;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
18 ;;; Boston, MA 02110-1301, USA. |
|
8a653fbe5c27
Add copyright and GPL v2 or later notices to Andy Piper's contributions, with
Jerry James <james@xemacs.org>
parents:
462
diff
changeset
|
19 |
| 428 | 20 (set-extent-begin-glyph |
| 21 (make-extent (point) (point)) | |
| 442 | 22 (setq im (make-glyph [xbm :file "xemacsicon.xbm"]))) |
| 428 | 23 |
| 438 | 24 (set-extent-begin-glyph |
| 25 (make-extent (point) (point)) | |
| 26 (make-glyph [string :data "xemacs"])) | |
| 27 | |
| 428 | 28 (defun foo () |
| 29 (interactive) | |
| 30 (setq ok-select (not ok-select))) | |
| 31 | |
| 32 (defun fee () (interactive) (message "hello")) | |
| 33 | |
| 34 ;; button in a group | |
| 35 (setq ok-select nil) | |
| 36 (set-extent-begin-glyph | |
| 37 (make-extent (point) (point)) | |
| 442 | 38 (make-glyph |
| 39 (setq radio-button1 | |
| 40 [button :face widget | |
| 41 :descriptor ["ok1" (setq ok-select t) | |
| 428 | 42 :style radio :selected ok-select]]))) |
| 43 ;; button in a group | |
| 44 (set-extent-begin-glyph | |
| 45 (make-extent (point) (point)) | |
| 442 | 46 (make-glyph |
| 47 (setq radio-button2 | |
| 48 [button :descriptor ["ok2" (setq ok-select nil) :style radio | |
| 428 | 49 :selected (not ok-select)]]))) |
| 50 ;; toggle button | |
| 51 (set-extent-begin-glyph | |
| 52 (make-extent (point) (point)) | |
| 53 (setq tbutton | |
| 442 | 54 (make-glyph [button :descriptor ["ok3" (setq ok-select nil) |
| 428 | 55 :style toggle |
| 56 :selected (not ok-select)]]))) | |
| 57 (set-extent-begin-glyph | |
| 58 (make-extent (point) (point)) | |
| 442 | 59 (make-glyph |
| 60 (setq toggle-button | |
| 61 [button :descriptor ["ok4" :style toggle | |
| 62 :callback | |
| 63 (setq ok-select (not ok-select)) | |
| 64 :selected ok-select]]))) | |
| 428 | 65 |
| 66 ;; normal pushbutton | |
| 67 (set-extent-begin-glyph | |
| 68 (make-extent (point) (point)) | |
| 69 (setq push-button | |
| 70 (make-glyph [button :width 10 :height 2 | |
| 71 :face modeline-mousable | |
| 442 | 72 :descriptor "ok" :callback foo |
| 428 | 73 :selected t]))) |
| 74 ;; tree view | |
| 75 (set-extent-begin-glyph | |
| 76 (make-extent (point) (point)) | |
| 77 (setq tree (make-glyph | |
| 78 [tree-view :width 10 | |
| 79 :descriptor "My Tree" | |
| 442 | 80 :items (["One" foo] |
| 81 (["Two" foo] | |
| 82 ["Four" foo] | |
| 83 "Six") | |
| 84 "Three")]))) | |
| 428 | 85 |
| 86 ;; tab control | |
| 87 (set-extent-begin-glyph | |
| 88 (make-extent (point) (point)) | |
| 89 (setq tab (make-glyph | |
| 90 [tab-control :descriptor "My Tab" | |
| 91 :face highlight | |
| 438 | 92 :orientation right |
| 442 | 93 :items (["One" foo :selected t] |
| 94 ["Two" fee :selected nil] | |
| 95 ["Three" foo :selected nil])]))) | |
| 428 | 96 |
| 97 ;; progress gauge | |
| 98 (set-extent-begin-glyph | |
| 99 (make-extent (point) (point)) | |
| 100 (setq pgauge (make-glyph | |
| 442 | 101 [progress-gauge :width 10 :height 2 :value 0 |
| 428 | 102 :descriptor "ok"]))) |
| 103 ;; progress the progress ... | |
| 104 (let ((x 0)) | |
| 105 (while (<= x 100) | |
| 442 | 106 (set-glyph-image pgauge `[progress-gauge :width 10 :height 2 |
| 107 :descriptor "ok" :value ,x]) | |
| 428 | 108 (setq x (+ x 5)) |
| 109 (sit-for 0.1))) | |
| 110 | |
| 111 ;; progress gauge in the modeline | |
| 112 (setq global-mode-string | |
| 113 (cons (make-extent nil nil) | |
| 114 (setq pg (make-glyph | |
| 115 [progress-gauge :width 5 :pixel-height 16 | |
| 116 :descriptor "ok"])))) | |
| 117 ;; progress the progress ... | |
| 118 (let ((x 0)) | |
| 119 (while (<= x 100) | |
| 442 | 120 (set-glyph-image pg |
| 121 `[progress-gauge :width 5 :pixel-height 16 | |
| 122 :descriptor "ok" :value ,x]) | |
| 428 | 123 (setq x (+ x 5)) |
| 462 | 124 (redisplay-frame) |
| 428 | 125 (sit-for 0.1))) |
| 126 | |
| 127 (set-extent-begin-glyph | |
| 128 (make-extent (point) (point)) | |
| 129 (make-glyph | |
| 130 [button :face modeline-mousable | |
| 131 :descriptor "ok" :callback foo | |
| 132 :image [xpm :file "../etc/xemacs-icon.xpm"]])) | |
| 133 | |
| 134 ;; normal pushbutton | |
| 135 (set-extent-begin-glyph | |
| 136 (make-extent (point) (point)) | |
| 438 | 137 (setq pbutton |
| 138 (make-glyph [button :descriptor ["A Big Button" foo ]]))) | |
| 428 | 139 |
| 140 ;; edit box | |
| 141 (set-extent-begin-glyph | |
| 142 (make-extent (point) (point)) | |
| 442 | 143 (make-glyph (setq edit-field [edit-field :pixel-width 50 :pixel-height 30 |
| 428 | 144 :face bold-italic |
| 145 :descriptor ["Hello"]]))) | |
| 146 ;; combo box | |
| 147 (set-extent-begin-glyph | |
| 148 (make-extent (point) (point)) | |
| 442 | 149 (make-glyph (setq combo-box |
| 150 [combo-box :width 10 :descriptor ["Hello"] | |
| 151 :items ("One" "Two" "Three")]))) | |
| 428 | 152 |
| 153 ;; label | |
| 154 (set-extent-begin-glyph | |
| 155 (make-extent (point) (point)) | |
| 442 | 156 (make-glyph (setq label [label :pixel-width 150 :descriptor "Hello"]))) |
| 428 | 157 |
| 158 ;; string | |
| 159 (set-extent-begin-glyph | |
| 160 (make-extent (point) (point)) | |
| 442 | 161 (make-glyph |
| 162 (setq str | |
| 163 [string :data "Hello There"]))) | |
| 428 | 164 |
| 165 ;; scrollbar | |
| 166 ;(set-extent-begin-glyph | |
| 167 ; (make-extent (point) (point)) | |
| 168 ; (make-glyph [scrollbar :width 50 :height 20 :descriptor ["Hello"]])) | |
| 169 | |
| 170 ;; generic subwindow | |
| 171 (setq sw (make-glyph [subwindow :pixel-width 50 :pixel-height 70])) | |
| 172 (set-extent-begin-glyph (make-extent (point) (point)) sw) | |
| 173 | |
| 174 ;; layout | |
| 175 (setq layout | |
| 176 (make-glyph | |
| 442 | 177 `[layout :descriptor "The Layout" |
| 178 :orientation vertical | |
| 179 :justify left | |
| 180 :border [string :data "Hello There Mrs"] | |
| 181 :items ([layout :orientation horizontal | |
| 182 :items (,radio-button1 ,radio-button2)] | |
| 183 ,edit-field ,toggle-button ,label ,str)])) | |
| 184 ;(set-glyph-face layout 'gui-element) | |
| 428 | 185 (set-extent-begin-glyph |
| 186 (make-extent (point) (point)) layout) | |
| 434 | 187 |
| 442 | 188 ;; another test layout |
| 189 (set-extent-begin-glyph | |
| 190 (make-extent (point) (point)) | |
| 191 (setq layout-2 | |
| 192 (make-glyph `[layout :descriptor "The Layout" | |
| 193 :orientation vertical | |
| 194 :items ([progress-gauge :value 0 :width 10 :height 2 | |
| 195 :descriptor "ok"])]))) | |
| 196 | |
| 197 (set-glyph-image layout-2 `[layout :descriptor "The Layout" | |
| 198 :orientation vertical | |
| 199 :items ([progress-gauge :value 4 :width 10 :height 2 | |
| 200 :descriptor "ok"])]) | |
| 434 | 201 (setq test-toggle-widget nil) |
| 202 | |
| 203 (defun test-toggle (widget) | |
| 204 (set-extent-begin-glyph | |
| 205 (make-extent (point) (point)) | |
| 206 (make-glyph (vector 'button | |
| 207 :descriptor "ok" | |
| 208 :style 'toggle | |
| 209 :selected `(funcall test-toggle-value | |
| 210 ,widget) | |
| 211 :callback `(funcall test-toggle-action | |
| 212 ,widget))))) | |
| 213 | |
| 214 (defun test-toggle-action (widget &optional event) | |
| 215 (if widget | |
| 216 (message "Widget is t") | |
| 217 (message "Widget is nil"))) | |
| 218 | |
| 219 (defun test-toggle-value (widget) | |
| 220 (setq widget (not widget)) | |
| 221 (not widget)) |