comparison lisp/w3/w3-speak.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8fc7fe29b841
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; w3-speak.el,v --- Emacs-W3 speech interface 1 ;;; w3-speak.el --- Emacs-W3 speech interface
2 ;; Author: wmperry 2 ;; Authors: wmperry and Raman
3 ;; Original author: William Perry --<wmperry@cs.indiana.edu> 3 ;; Created: 1996/07/09 14:08:09
4 ;; Cloned from emacspeak-w3.el 4 ;; Version: 1.4
5 ;; Created: 1996/10/16 20:56:40
6 ;; Version: 1.14
7 ;; Keywords: hypermedia, speech 5 ;; Keywords: hypermedia, speech
8 6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;{{{ Copyright
10 ;;; Copyright (c) 1996 by T.V. Raman (raman@adobe.com) 8
11 ;;; Copyright (c) 1996, 1997 by William M. Perry (wmperry@spry.com) 9 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
12 ;;; Copyright (c) 1997 Free Software Foundation, Inc.
13 ;;; 10 ;;;
14 ;;; This file is not part of GNU Emacs, but the same permissions apply. 11 ;;; This file is not part of GNU Emacs, but the same permissions apply.
15 ;;; 12 ;;;
16 ;;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
17 ;;; it under the terms of the GNU General Public License as published by 14 ;;; it under the terms of the GNU General Public License as published by
22 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;;; GNU General Public License for more details. 21 ;;; GNU General Public License for more details.
25 ;;; 22 ;;;
26 ;;; You should have received a copy of the GNU General Public License 23 ;;; You should have received a copy of the GNU General Public License
27 ;;; along with GNU Emacs; see the file COPYING. If not, write to the 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to
28 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
29 ;;; Boston, MA 02111-1307, USA.
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 27
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;;; A replacement module for emacspeak-w3 that uses all the new functionality 29 ;;; A replacement module for emacspeak-w3 that uses all the new functionality
34 ;;; of Emacs-W3 3.0. 30 ;;; of Emacs-W3 3.0.
35 ;;; 31 ;;;
36 ;;; This file would not be possible without the help of 32 ;;; This file would not be possible without the help of
37 ;;; T.V. Raman (raman@adobe.com) and his continued efforts to make Emacs-W3 33 ;;; T.V. Raman (raman@adobe.com) and his continued efforts to make Emacs-W3
38 ;;; even remotely useful. :) 34 ;;; even remotely useful. :)
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 35
40 36 ;;}}}
41 ;;; This conforms to http://www4.inria.fr/speech2.html 37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38 ;;{{{ Required modules
42 39
43 (require 'widget) 40 (require 'widget)
44 (require 'w3-forms) 41 (require 'w3-forms)
45 (require 'advice) 42 (require 'advice)
43
46 ;; This condition-case needs to be here or it completely chokes 44 ;; This condition-case needs to be here or it completely chokes
47 ;; byte-compilation for people who do not have Emacspeak installed. 45 ;; byte-compilation for people who do not have Emacspeak installed.
48 ;; *sigh* 46 ;; *sigh*
47
49 (condition-case () 48 (condition-case ()
50 (progn 49 (progn
51 (require 'emacspeak) 50 (require 'emacspeak)
52 (require 'dtk-voices) 51 (require 'dtk-voices)
52 (require 'dtk-css-speech)
53 (require 'emacspeak-speak) 53 (require 'emacspeak-speak)
54 (require 'emacspeak-sounds) 54 (require 'emacspeak-sounds)
55 (eval-when (compile) 55 (eval-when (compile)
56 (require 'emacspeak-fix-interactive))) 56 (require 'emacspeak-fix-interactive)))
57 (error (message "Emacspeak not found - speech will not work."))) 57 (error (message "Emacspeak not found - speech will not work.")))
58 58
59 ;;}}}
60
59 61
60 ;;{{{ speaking form fields 62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63 ;;; How to get information summarizing a form field, so it can be spoken in
64 ;;; a sane manner.
65 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
66 ;;{{{ putting and getting form field summarizer
67
68 (defsubst w3-speak-define-field-summarizer (type &optional function-name)
69 "Associate the name of a function that describes this type of form field."
70 (put type 'w3-speak-summarizer
71 (or function-name (intern
72 (format "w3-speak-summarize-%s-field" type)))))
73
74 (defsubst w3-speak-get-field-summarizer (type)
75 "Retrieve function-name string for this voice"
76 (get type 'w3-speak-summarizer))
77
78 ;;}}}
79 ;;{{{ define the form field summarizer functions
80
81 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82 ;;; Now actually define the summarizers
83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84
85 (defsubst w3-speak-extract-form-field-label (data)
86 ;;; FIXXX!!! Need to reimplement using the new forms implementation!
87 (declare (special w3-form-labels))
88 nil)
89
90 (defun w3-speak-summarize-text-field (data)
91 "Summarize a text field given the field data."
92 (let (
93 (label (w3-speak-extract-form-field-label data))
94 (name (w3-form-element-name data))
95 (value (widget-value (w3-form-element-widget data))))
96 (dtk-speak
97 (format "Text field %s %s " (or label (concat "called " name))
98 (concat "set to " value)))))
99
100 (defun w3-speak-summarize-file-field (data)
101 "Summarize a f field of type file given the field data."
102 (let (
103 (label (w3-speak-extract-form-field-label data))
104 (name (w3-form-element-name data))
105 (value (widget-value (w3-form-element-widget data))))
106 (dtk-speak
107 (format "File field %s %s " (or label (concat "called " name))
108 (concat "set to " value)))))
109
110 (defun w3-speak-summarize-textarea-field (data)
111 "Summarize a textarea field given the field data."
112 (let (
113 (name (w3-form-element-name data))
114 (label (w3-speak-extract-form-field-label data))
115 (value (w3-form-element-value data)))
116 (dtk-speak
117 (format "Multiline text input %s %s" (or label (concat "called " name))
118 (concat "set to " value)))))
119
120 (defun w3-speak-summarize-checkbox-field (data)
121 "Summarize a checkbox field given the field data."
122 (let (
123 (name (w3-form-element-name data))
124 (label (w3-speak-extract-form-field-label data))
125 (checked (widget-value (w3-form-element-widget data))))
126 (dtk-speak
127 (format "Checkbox %s is %s" (or label name) (if checked "on" "off")))))
128
129 (defun w3-speak-summarize-option-field (data)
130 "Summarize a options field given the field data."
131 (let (
132 (name (w3-form-element-name data))
133 (label (w3-speak-extract-form-field-label data))
134 (default (w3-form-element-default-value data)))
135 (dtk-speak
136 (format "Choose an option %s %s" (or label name)
137 (if (string= "" default)
138 ""
139 (format "default is %s" default))))))
140
141 ;;; to handle brain dead nynex forms
142 (defun w3-speak-summarize-image-field (data)
143 "Summarize a image field given the field data.
144 Currently, only the NYNEX server uses this."
145 (let (
146 (name (w3-form-element-name data))
147 (label (w3-speak-extract-form-field-label data)))
148 (dtk-speak
149 (substring name 1))))
150
151 (defun w3-speak-summarize-submit-field (data)
152 "Summarize a submit field given the field data."
153 (let (
154 (type (w3-form-element-type data))
155 (label (w3-speak-extract-form-field-label data))
156 (button-text (widget-value (w3-form-element-widget data))))
157 (message "%s" (or label button-text
158 (case type
159 (submit "Submit Form")
160 (reset "Reset Form")
161 (button "A Button"))))))
162
163 (defalias 'w3-speak-summarize-reset-field 'w3-speak-summarize-submit-field)
164 (defalias 'w3-speak-summarize-button-field 'w3-speak-summarize-submit-field)
165
166 (defun w3-speak-summarize-radio-field (data)
167 "Summarize a radio field given the field data."
168 (let (
169 (name (w3-form-element-name data))
170 (label (w3-speak-extract-form-field-label data))
171 (checked (widget-value (w3-form-element-widget data))))
172 (dtk-speak
173 (format "Radio button %s is %s" (or label name) (if checked
174 "pressed"
175 "not pressed")))))
176
177 ;;}}}
178 ;;{{{ Associate summarizer functions for form fields
179
180 (w3-speak-define-field-summarizer 'text)
181 (w3-speak-define-field-summarizer 'option)
182 (w3-speak-define-field-summarizer 'checkbox)
183 (w3-speak-define-field-summarizer 'reset)
184 (w3-speak-define-field-summarizer 'submit)
185 (w3-speak-define-field-summarizer 'button)
186 (w3-speak-define-field-summarizer 'radio)
187 (w3-speak-define-field-summarizer 'multiline)
188 (w3-speak-define-field-summarizer 'image)
189 (w3-speak-define-field-summarizer 'file)
190
191 ;;}}}
192
193 ;;{{{ speaking form fields
61 194
62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63 ;;; Now for the guts 196 ;;; Now for the guts
64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
198 (defun w3-speak-extract-form-field-information ()
199 (let* ((widget (widget-at (point)))
200 (data (and widget (widget-get widget 'w3-form-data))))
201 data))
202
65 (defun w3-speak-summarize-form-field () 203 (defun w3-speak-summarize-form-field ()
66 "Summarizes field under point if any." 204 "Summarizes field under point if any."
67 (let ((widget (widget-at (point)))) 205 (let* ((data (w3-speak-extract-form-field-information))
68 (and widget (w3-form-summarize-field widget)))) 206 (type (and data (w3-form-element-type data)))
207 (summarizer (and type (w3-speak-get-field-summarizer type))))
208 (cond
209 ((and data summarizer (fboundp summarizer))
210 (funcall summarizer data))
211 (data
212 (message "Please define a summarizer function for %s" type))
213 (t nil))))
69 214
70 ;;}}} 215 ;;}}}
71 216
217 ;;{{{ Movement notification
218
72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 219 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73 ;;; Movement notification 220 ;;; Movement notification
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 221 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 (defadvice w3-widget-forward (after emacspeak pre act comp)
76 (when (interactive-p)
77 (emacspeak-auditory-icon 'large-movement)
78 (emacspeak-widget-summarize (emacspeak-widget-at (point )))))
79
80
81 (defadvice w3-widget-backward (after emacspeak pre act comp)
82 (when (interactive-p)
83 (emacspeak-auditory-icon 'large-movement)
84 (emacspeak-widget-summarize (emacspeak-widget-at (point )))))
85
86 (defadvice w3-scroll-up (after emacspeak pre act comp) 222 (defadvice w3-scroll-up (after emacspeak pre act comp)
87 "Provide auditory feedback" 223 "Provide auditory feedback"
88 (when (interactive-p) 224 (when (interactive-p)
89 (let ((start (point ))) 225 (let ((start (point )))
90 (emacspeak-auditory-icon 'scroll) 226 (emacspeak-auditory-icon 'scroll)
91 (save-excursion 227 (save-excursion
92 (forward-line (window-height)) 228 (forward-line (window-height))
93 (emacspeak-speak-region start (point )))))) 229 (emacspeak-speak-region start (point ))))))
94 230
95 (defadvice w3-follow-link (around emacspeak pre act) 231 (defadvice w3-follow-link (around emacspeak pre act)
96 "Provide feedback on what you did. " 232 "Provide feedback on what you did. "
97 (let ((data (emacspeak-w3-extract-form-field-information)) 233 (let ((data (w3-speak-extract-form-field-information))
98 (form-field-p nil) 234 (form-field-p nil))
99 (this-zone nil)
100 (opoint nil))
101 (if data 235 (if data
102 (setq form-field-p t 236 (setq form-field-p t))
103 opoint (point)))
104 ad-do-it 237 ad-do-it
105 (when form-field-p 238 (when form-field-p
106 (w3-speak-summarize-form-field) 239 (w3-speak-summarize-form-field)
107 (case (w3-form-element-type data) 240 (case (w3-form-element-type data)
108 ((radio checkbox) 241 ((radio checkbox button)
109 (emacspeak-auditory-icon 'button)) 242 (emacspeak-auditory-icon 'button))
243 ((text textarea)
244 (emacspeak-auditory-icon 'close-object)
110 ;; fill in any others here 245 ;; fill in any others here
111 (otherwise 246 (otherwise
112 nil))) 247 nil)))
113 ad-return-value)) 248 ad-return-value)))
114 249
115 (defadvice w3-revert-form (after emacspeak pre act) 250 (defadvice w3-revert-form (after emacspeak pre act)
116 "Announce that you cleared the form. " 251 "Announce that you cleared the form. "
117 (dtk-speak "Cleared the form. ")) 252 (dtk-speak "Cleared the form. "))
118 253
119 (defadvice w3-finish-text-entry (after emacspeak pre act ) 254 (defadvice w3-finish-text-entry (after emacspeak pre act )
120 "Announce what the field was set to." 255 "Announce what the field was set to."
121 (when (interactive-p) 256 (when (interactive-p)
122 (w3-speak-summarize-form-field))) 257 (w3-speak-summarize-form-field)))
123 258
259 (defadvice widget-forward (after emacspeak pre act)
260 "Produce an auditory icon when moving forward.
261 If on a form field, then summarize it."
262 (declare (special emacspeak-lazy-message-time))
263 (when (interactive-p)
264 (let ((emacspeak-lazy-message-time 0))
265 (w3-speak-summarize-form-field)
266 (emacspeak-auditory-icon 'large-movement))))
267
268 (defadvice widget-backward (after emacspeak pre act)
269 "Produce an auditory icon when moving backward.
270 If on a form field, then summarize it."
271 (declare (special emacspeak-lazy-message-time))
272 (when (interactive-p )
273 (let ((emacspeak-lazy-message-time 0))
274 (w3-speak-summarize-form-field)
275 (emacspeak-auditory-icon 'large-movement))))
276
124 (defadvice w3-start-of-document (after emacspeak pre act) 277 (defadvice w3-start-of-document (after emacspeak pre act)
125 "Produce an auditory icon. Also speak the first line. " 278 "Produce an auditory icon. Also speak the first line. "
126 (when (interactive-p) 279 (when (interactive-p)
127 (emacspeak-speak-line) 280 (emacspeak-speak-line)
128 (emacspeak-auditory-icon 'large-movement))) 281 (emacspeak-auditory-icon 'large-movement)))
129 282
130 (defadvice w3-end-of-document (after emacspeak pre act) 283 (defadvice w3-end-of-document (after emacspeak pre act)
131 "Produce an auditory icon. Also speak the first line." 284 "Produce an auditory icon. "
132 (when (interactive-p) 285 (when (interactive-p)
133 (emacspeak-speak-line) 286 (emacspeak-speak-line)
134 (emacspeak-auditory-icon 'large-movement))) 287 (emacspeak-auditory-icon 'large-movement)))
135 288
136 (defadvice w3-goto-last-buffer (after emacspeak pre act) 289 (defadvice w3-goto-last-buffer (after emacspeak pre act)
144 (when (interactive-p) 297 (when (interactive-p)
145 (emacspeak-auditory-icon 'close-object) 298 (emacspeak-auditory-icon 'close-object)
146 (emacspeak-speak-mode-line))) 299 (emacspeak-speak-mode-line)))
147 300
148 (defadvice w3-fetch (around emacspeak act comp ) 301 (defadvice w3-fetch (around emacspeak act comp )
149 "First produce an auditory icon to indicate retrieval. 302 "First produce an auditory icon to indicate retrieval. After
150 After retrieval, 303 retrieval, set voice-lock-mode to t after displaying the buffer, and
151 set voice-lock-mode to t after displaying the buffer, 304 then speak the mode-line. "
152 and then speak the mode-line. "
153 (declare (special dtk-punctuation-mode)) 305 (declare (special dtk-punctuation-mode))
154 (emacspeak-auditory-icon 'select-object) 306 (when (interactive-p)
155 ad-do-it) 307 (emacspeak-auditory-icon 'select-object)
308 ad-do-it
309 (set (make-local-variable 'voice-lock-mode) t)
310 (setq dtk-punctuation-mode "some")
311 (modify-syntax-entry 10 " ")
312 (emacspeak-auditory-icon 'open-object)
313 (emacspeak-speak-mode-line )))
314
315 ;;}}}
316 ;;{{{ top level
156 317
157 (defun w3-speak-mode-hook () 318 (defun w3-speak-mode-hook ()
158 (set (make-local-variable 'voice-lock-mode) t) 319 (set (make-local-variable 'voice-lock-mode) t)
159 (setq dtk-punctuation-mode "some") 320 (setq dtk-punctuation-mode "some")
160 (emacspeak-auditory-icon 'open-object) 321 (emacspeak-auditory-icon 'open-object)
166 "Tells w3 to start using voice locking. 327 "Tells w3 to start using voice locking.
167 This is done by setting the w3 variables so that anchors etc are not marked by 328 This is done by setting the w3 variables so that anchors etc are not marked by
168 delimiters. We then turn on voice-lock-mode. 329 delimiters. We then turn on voice-lock-mode.
169 Interactive prefix arg does the opposite. " 330 Interactive prefix arg does the opposite. "
170 (interactive "P") 331 (interactive "P")
171 (declare (special w3-echo-link)) 332 (declare (special w3-delimit-links w3-delimit-emphasis w3-echo-link))
172 (setq w3-echo-link 'text) 333 (setq w3-echo-link 'text)
173 (if arg 334 (if arg
174 (remove-hook 'w3-mode-hook 'w3-speak-mode-hook) 335 (progn
336 (setq w3-delimit-links 'guess
337 w3-delimit-emphasis 'guess)
338 (remove-hook 'w3-mode-hook 'w3-speak-mode-hook))
339 (setq w3-delimit-links nil
340 w3-delimit-emphasis nil)
175 (add-hook 'w3-mode-hook 'w3-speak-mode-hook))) 341 (add-hook 'w3-mode-hook 'w3-speak-mode-hook)))
176 342
177 (defun w3-speak-browse-page () 343 ;;}}}
178 "Browse a WWW page" 344 ;;{{{ make-local-hook
179 (interactive) 345
180 (emacspeak-audio-annotate-paragraphs) 346 ;;; hope this is correct:
181 (emacspeak-execute-repeatedly 'forward-paragraph)) 347 (unless (fboundp 'make-local-hook)
182 348 (defun make-local-hook (var)
183 (declaim (special w3-mode-map)) 349 (make-variable-buffer-local var))
184 (define-key w3-mode-map "." 'w3-speak-browse-page) 350 )
185 351
186 (defvar url-speak-last-progress-indication 0 352 ;;}}}
187 "Caches when we last produced a progress auditory icon")
188
189 (defadvice url-lazy-message (around emacspeak pre act)
190 "Provide pleasant auditory feedback about progress"
191 (declare (special url-speak-last-progress-indication ))
192 (let ((now (nth 1 (current-time))))
193 (when (> now
194 (+ 3 url-speak-last-progress-indication))
195 (setq url-speak-last-progress-indication now)
196 (emacspeak-auditory-icon 'progress))))
197
198 (provide 'w3-speak) 353 (provide 'w3-speak)