initial commit
[emacs-init.git] / nxhtml / tests / nxhtmltest-helpers.el
1 ;;; nxhtmltest-helpers.el --- Helper functions for testing
2 ;;
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2008-07-08T19:10:54+0200 Tue
5 ;; Version: 0.2
6 ;; Last-Updated: 2008-09-01T01:13:15+0200 Sun
7 ;; URL:
8 ;; Keywords:
9 ;; Compatibility:
10 ;;
11 ;; Features that might be required by this library:
12 ;;
13 ;;   `button', `help-fns', `help-mode', `view'.
14 ;;
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16 ;;
17 ;;; Commentary:
18 ;;
19 ;;
20 ;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
22 ;;
23 ;;; Change log:
24 ;;
25 ;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;
28 ;; This program is free software; you can redistribute it and/or
29 ;; modify it under the terms of the GNU General Public License as
30 ;; published by the Free Software Foundation; either version 2, or
31 ;; (at your option) any later version.
32 ;;
33 ;; This program is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
36 ;; General Public License for more details.
37 ;;
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with this program; see the file COPYING.  If not, write to
40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
41 ;; Floor, Boston, MA 02110-1301, USA.
42 ;;
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44 ;;
45 ;;; Code:
46
47 (eval-when-compile (require 'cl))
48 (require 'ert2)
49
50 (defun nxhtmltest-goto-line (line)
51   (save-restriction
52     (widen)
53     (goto-char (point-min))
54     (forward-line (1- line))))
55
56 (defun nxhtmltest-mumamo-error-messages ()
57   (ert-get-messages "^MU:MuMaMo error"))
58
59 (defun nxhtmltest-should-no-mumamo-errors ()
60   (ert-should (not (nxhtmltest-mumamo-error-messages))))
61
62 (defun nxhtmltest-should-no-nxml-errors ()
63   (ert-should (not (ert-get-messages "Internal nXML mode error"))))
64
65 (defun nxhtmltest-be-really-idle (seconds &optional prompt-mark)
66   (unless prompt-mark (setq prompt-mark ""))
67   (with-timeout (4 (message "<<<< %s - not really idle any more at %s"
68                             prompt-mark
69                             (format-time-string "%H:%M:%S")))
70     (let ((prompt (format
71                    ">>>> %s Starting beeing really idle %s seconds at %s"
72                    prompt-mark
73                    seconds
74                    (format-time-string "%H:%M:%S ..."))))
75       (message "%s" prompt)
76       (read-minibuffer prompt)
77       (redisplay))))
78
79 ;;(nxhtmltest-be-really-idle 4 "HERE I AM!!")
80
81
82 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
83 ;;; Fontification methods
84
85 (defvar nxhtmltest-default-fontification-method nil)
86
87 (defun nxhtmltest-get-fontification-method ()
88   "Ask user for default fontification method."
89   (let* ((collection
90           '(
91             ("Fontify as usual (wait)" fontify-as-usual)
92             ("Fontify by calling timer handlers" fontify-w-timer-handlers)
93             ("Fontify ps print " fontify-as-ps-print)
94             ("Call fontify-buffer" fontify-buffer)
95             ))
96          (hist (mapcar (lambda (rec)
97                          (car rec))
98                        collection))
99          (method-name (or t
100                           (completing-read "Default fontification method: "
101                                            collection nil t
102                                            (car (nth 1 collection))
103                                            'hist))))
104     (setq nxhtmltest-default-fontification-method
105           ;;(nth 1 (assoc method-name collection))
106           ;;'fontify-w-timer-handlers
107           'fontify-as-ps-print
108           )))
109
110 (defun nxhtmltest-fontify-as-usual (seconds prompt-mark)
111   (font-lock-mode 1)
112   ;; This does not work now since I deleted the function below:
113   (error "font-lock-wait not defined")
114   ;;(font-lock-wait (nxhtmltest-be-really-idle seconds prompt-mark))
115   )
116
117 (defun nxhtmltest-fontify-w-timers-handlers ()
118     ;;(dolist (timer (copy-list timer-idle-list))
119     (dolist (timer (copy-sequence timer-idle-list))
120       (timer-event-handler timer))
121     (redisplay t))
122
123 (declare-function jit-lock-fontify-now "jit-lock" (&optional start end))
124 (declare-function lazy-lock-fontify-region "lazy-lock" (beg end))
125
126 ;; to avoid compilation gripes
127 ;;(defun ps-print-ensure-fontified (start end)
128 (defun nxhtmltest-fontify-as-ps-print()
129   (save-restriction
130     (widen)
131     (let ((start (point-min))
132           (end   (point-max)))
133       (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
134              (jit-lock-fontify-now start end))
135             ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
136              (lazy-lock-fontify-region start end))))))
137
138 (defun nxhtmltest-fontify-buffer ()
139   (font-lock-fontify-buffer)
140   (redisplay t))
141
142 (defun nxhtmltest-fontify-default-way (seconds &optional pmark)
143   ;;(assert (not font-lock-mode))
144   (case nxhtmltest-default-fontification-method
145     (fontify-as-usual         (nxhtmltest-fontify-as-usual seconds pmark))
146     (fontify-w-timer-handlers (nxhtmltest-fontify-w-timers-handlers))
147     (fontify-as-ps-print      (nxhtmltest-fontify-as-ps-print))
148     (fontify-buffer           (nxhtmltest-fontify-buffer))
149     (t (error "Unrecognized default fontification method: %s"
150               nxhtmltest-default-fontification-method))))
151
152
153
154 (provide 'nxhtmltest-helpers)
155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
156 ;;; nxhtmltest-helpers.el ends here