Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-forms.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 859a2309aef8
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine 1 ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/02 20:20:29 3 ;; Created: 1997/01/28 14:21:54
4 ;; Version: 1.32 4 ;; Version: 1.55
5 ;; Keywords: faces, help, comm, data, languages 5 ;; Keywords: faces, help, comm, data, languages
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
10 ;;; 10 ;;;
11 ;;; This file is part of GNU Emacs. 11 ;;; This file is part of GNU Emacs.
12 ;;; 12 ;;;
13 ;;; 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
14 ;;; 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
34 (require 'widget)) 34 (require 'widget))
35 35
36 (require 'w3-vars) 36 (require 'w3-vars)
37 (require 'mule-sysdp) 37 (require 'mule-sysdp)
38 38
39 (define-widget-keywords :emacspeak-help :w3-form-data)
40
41 (defvar w3-form-keymap (copy-keymap global-map))
42 (define-key w3-form-keymap "\r" 'w3-form-maybe-submit-by-keypress)
43 (define-key w3-form-keymap "\n" 'w3-form-maybe-submit-by-keypress)
44 (define-key w3-form-keymap "\t" 'w3-widget-forward)
45 (define-key w3-form-keymap [(shift tab)] 'w3-widget-backward)
46
39 ;; A form entry area is a vector 47 ;; A form entry area is a vector
40 ;; [ type name default-value value maxlength options widget] 48 ;; [ type name default-value value maxlength options widget plist]
41 ;; Where: 49 ;; Where:
42 ;; type = symbol defining what type of form entry area it is 50 ;; type = symbol defining what type of form entry area it is
43 ;; (ie: file, radio) 51 ;; (ie: file, radio)
44 ;; name = the name of the form element 52 ;; name = the name of the form element
45 ;; default-value = the value this started out with 53 ;; default-value = the value this started out with
51 (defsubst w3-form-element-size (obj) (aref obj 4)) 59 (defsubst w3-form-element-size (obj) (aref obj 4))
52 (defsubst w3-form-element-maxlength (obj) (aref obj 5)) 60 (defsubst w3-form-element-maxlength (obj) (aref obj 5))
53 (defsubst w3-form-element-options (obj) (aref obj 6)) 61 (defsubst w3-form-element-options (obj) (aref obj 6))
54 (defsubst w3-form-element-action (obj) (aref obj 7)) 62 (defsubst w3-form-element-action (obj) (aref obj 7))
55 (defsubst w3-form-element-widget (obj) (aref obj 8)) 63 (defsubst w3-form-element-widget (obj) (aref obj 8))
64 (defsubst w3-form-element-plist (obj) (aref obj 9))
56 65
57 (defsubst w3-form-element-set-type (obj val) (aset obj 0 val)) 66 (defsubst w3-form-element-set-type (obj val) (aset obj 0 val))
58 (defsubst w3-form-element-set-name (obj val) (aset obj 1 val)) 67 (defsubst w3-form-element-set-name (obj val) (aset obj 1 val))
59 (defsubst w3-form-element-set-default-value (obj val) (aset obj 2 val)) 68 (defsubst w3-form-element-set-default-value (obj val) (aset obj 2 val))
60 (defsubst w3-form-element-set-value (obj val) (aset obj 3 val)) 69 (defsubst w3-form-element-set-value (obj val) (aset obj 3 val))
61 (defsubst w3-form-element-set-size (obj val) (aset obj 4 val)) 70 (defsubst w3-form-element-set-size (obj val) (aset obj 4 val))
62 (defsubst w3-form-element-set-maxlength (obj val) (aset obj 5 val)) 71 (defsubst w3-form-element-set-maxlength (obj val) (aset obj 5 val))
63 (defsubst w3-form-element-set-options (obj val) (aset obj 6 val)) 72 (defsubst w3-form-element-set-options (obj val) (aset obj 6 val))
64 (defsubst w3-form-element-set-action (obj val) (aset obj 7 val)) 73 (defsubst w3-form-element-set-action (obj val) (aset obj 7 val))
65 (defsubst w3-form-element-set-widget (obj val) (aset obj 8 val)) 74 (defsubst w3-form-element-set-widget (obj val) (aset obj 8 val))
66 75 (defsubst w3-form-element-set-plist (obj val) (aset obj 9 val))
67 ;; The main function - this adds a single widget to the form 76
68 (defun w3-form-add-element (type name value size maxlength default 77 (defun w3-form-determine-size (el size)
69 action options number id checked 78 (case (w3-form-element-type el)
70 face) 79 (checkbox 3)
71 (let* ((name (or name (case type 80 (radio 4)
72 ((submit reset) nil) 81 ((reset submit) (+ 2 (length (or (w3-form-element-value el)
73 (otherwise (symbol-name type))))) 82 (symbol-name
74 (el (vector type 83 (w3-form-element-type el))))))
75 name 84 (multiline 21)
76 default 85 (hidden nil)
77 value 86 (file (or size 26))
78 size 87 ((float password text int) (or size 20))
79 maxlength 88 (image (+ 2 (length (or
80 options 89 (plist-get (w3-form-element-plist el) 'alt)
81 action nil)) 90 "Form-Image"))))
82 (size (if size 91 (option
83 (+ 2 size) 92 (or size
84 (case type 93 (length (caar (sort (w3-form-element-options el)
85 ((checkbox radio) 3) 94 (function
86 ((reset submit) 95 (lambda (x y)
87 (+ 2 (length (or value (symbol-name type))))) 96 (>= (length (car x)) (length (car y))))))))))
88 (multiline 21) 97 (otherwise (or size 22))))
89 (hidden nil) 98
90 (otherwise 22)))) 99 ;;###autoload
91 ) 100 (defun w3-form-add-element (plist face)
101 (let* ((action (plist-get plist 'action))
102 (el (vector (plist-get plist 'type)
103 (plist-get plist 'name)
104 (plist-get plist 'default)
105 (plist-get plist 'value)
106 (plist-get plist 'size)
107 (plist-get plist 'maxlength)
108 (plist-get plist 'options)
109 action
110 nil
111 plist))
112 (size (w3-form-determine-size el (plist-get plist 'size)))
113 (node (assoc action w3-form-elements)))
114 (if (and (eq (plist-get plist 'type) 'hidden)
115 (not (assq '*table-autolayout w3-display-open-element-stack)))
116 (if node
117 (setcdr node (cons el (cdr node)))
118 (setq w3-form-elements (cons (cons action (list el))
119 w3-form-elements))))
92 (if size 120 (if size
93 (set-text-properties (point) 121 (set-text-properties (point)
94 (progn (insert-char ?T size) (point)) 122 (progn (insert-char ?T size) (point))
95 (list 'w3-form-info el 123 (list 'w3-form-info el
96 'start-open t 124 'start-open t
101 (let ((st (point-min)) 129 (let ((st (point-min))
102 info nd node action) 130 info nd node action)
103 (while st 131 (while st
104 (if (setq info (get-text-property st 'w3-form-info)) 132 (if (setq info (get-text-property st 'w3-form-info))
105 (progn 133 (progn
106 (setq nd (next-single-property-change st 'w3-form-info) 134 (setq nd (or (next-single-property-change st 'w3-form-info)
135 (point-max))
107 action (w3-form-element-action info) 136 action (w3-form-element-action info)
108 node (assoc action w3-form-elements)) 137 node (assoc action w3-form-elements))
109 (goto-char st) 138 (goto-char st)
110 (delete-region st nd) 139 (delete-region st nd)
111 (if (not (w3-form-element-size info)) 140 (if (not (w3-form-element-size info))
116 w3-form-elements))) 145 w3-form-elements)))
117 (w3-form-add-element-internal info) 146 (w3-form-add-element-internal info)
118 (setq st (next-single-property-change st 'w3-form-info))) 147 (setq st (next-single-property-change st 'w3-form-info)))
119 (setq st (next-single-property-change st 'w3-form-info)))))) 148 (setq st (next-single-property-change st 'w3-form-info))))))
120 149
150 (defsubst w3-form-mark-widget (widget el)
151 (let ((widgets (list widget))
152 (children (widget-get widget :children))
153 (parent (widget-get widget :parent)))
154 (w3-form-element-set-widget el widget)
155 ;; Get _all_ the children associated with this widget
156 (while children
157 (setq widgets (cons (car children) widgets))
158 (if (widget-get (car children) :children)
159 (setq children (append children
160 (widget-get (car children) :children))))
161 (setq children (cdr children)))
162 (while (widget-get widget :parent)
163 (setq widget (widget-get widget :parent)
164 widgets (cons widget widgets)))
165 (setq children (widget-get widget :buttons))
166 ;; Special case for radio buttons
167 (while children
168 (setq widgets (cons (car children) widgets))
169 (if (widget-get (car children) :children)
170 (setq children (append children
171 (widget-get (car children) :children))))
172 (setq children (cdr children)))
173 (while widgets
174 (setq widget (pop widgets))
175 (widget-put widget :emacspeak-help 'w3-form-summarize-field)
176 (widget-put widget :w3-form-data el))))
177
121 (defun w3-form-add-element-internal (el) 178 (defun w3-form-add-element-internal (el)
122 (let* ((widget nil) 179 (let* ((widget nil)
123 (buffer-read-only nil) 180 (buffer-read-only nil)
124 (inhibit-read-only t) 181 (inhibit-read-only t)
125 (widget-creation-function nil)) 182 (widget-creation-function nil))
126 (setq widget-creation-function (or (get (w3-form-element-type el) 183 (setq widget-creation-function (or (get (w3-form-element-type el)
127 'w3-widget-creation-function) 184 'w3-widget-creation-function)
128 'w3-form-default-widget-creator) 185 'w3-form-default-widget-creator)
129 widget (funcall widget-creation-function el nil)) 186 widget (and (fboundp widget-creation-function)
187 (funcall widget-creation-function el nil)))
130 (if (not widget) 188 (if (not widget)
131 nil 189 nil
132 (w3-form-element-set-widget el widget) 190 (w3-form-mark-widget widget el))))
133 (widget-put widget 'w3-form-data el))))
134 191
135 ;; These properties tell the add-element function how to actually create 192 ;; These properties tell the add-element function how to actually create
136 ;; each type of widget. 193 ;; each type of widget.
137 (put 'checkbox 'w3-widget-creation-function 'w3-form-create-checkbox) 194 (put 'checkbox 'w3-widget-creation-function 'w3-form-create-checkbox)
138 (put 'multiline 'w3-widget-creation-function 'w3-form-create-multiline) 195 (put 'multiline 'w3-widget-creation-function 'w3-form-create-multiline)
143 (put 'file 'w3-widget-creation-function 'w3-form-create-file-browser) 200 (put 'file 'w3-widget-creation-function 'w3-form-create-file-browser)
144 (put 'option 'w3-widget-creation-function 'w3-form-create-option-list) 201 (put 'option 'w3-widget-creation-function 'w3-form-create-option-list)
145 (put 'keygen 'w3-widget-creation-function 'w3-form-create-keygen-list) 202 (put 'keygen 'w3-widget-creation-function 'w3-form-create-keygen-list)
146 (put 'button 'w3-widget-creation-function 'w3-form-create-button) 203 (put 'button 'w3-widget-creation-function 'w3-form-create-button)
147 (put 'image 'w3-widget-creation-function 'w3-form-create-image) 204 (put 'image 'w3-widget-creation-function 'w3-form-create-image)
205 (put 'int 'w3-widget-creation-function 'w3-form-create-integer)
206 (put 'float 'w3-widget-creation-function 'w3-form-create-float)
207 (put 'custom 'w3-widget-creation-function 'w3-form-create-custom)
208 (put 'text 'w3-widget-creation-function 'w3-form-create-text)
209 (put 'password 'w3-widget-creation-function 'w3-form-create-password)
210
211 ;; Custom support.
212 (defvar w3-custom-options nil)
213 (make-variable-buffer-local 'w3-custom-options)
214
215 (defun w3-form-create-custom (el face)
216 (require 'custom-edit)
217 (let* ((name (w3-form-element-name el))
218 (var-name (w3-form-element-value el))
219 (type (plist-get (w3-form-element-plist el) 'custom-type))
220 (widget (widget-create (cond ((string-equal type "variable")
221 'custom-variable)
222 ((string-equal type "face")
223 'custom-face)
224 ((string-equal type "group")
225 'custom-group)
226 (t 'item)) (intern var-name))))
227 (custom-magic-reset widget)
228 (push widget w3-custom-options)
229 widget))
148 230
149 (defun w3-form-create-checkbox (el face) 231 (defun w3-form-create-checkbox (el face)
150 (widget-create 'checkbox :value-face face 232 (widget-create 'checkbox
233 :value-face face
151 (and (w3-form-element-default-value el) t))) 234 (and (w3-form-element-default-value el) t)))
235
236 (defun w3-form-radio-button-update (widget child event)
237 (widget-radio-action widget child event)
238 (w3-form-mark-widget widget (widget-get widget :w3-form-data)))
152 239
153 (defun w3-form-create-radio-button (el face) 240 (defun w3-form-create-radio-button (el face)
154 (let* ((name (w3-form-element-name el)) 241 (let* ((name (w3-form-element-name el))
155 (formobj (cdr (assoc name w3-form-radio-elements))) 242 (action (w3-form-element-action el))
243 (uniqid (cons name action))
244 (formobj (cdr (assoc uniqid w3-form-radio-elements)))
156 (widget nil) 245 (widget nil)
157 ) 246 )
158 (if formobj 247 (if formobj
159 (progn 248 (progn
160 (setq widget (w3-form-element-widget formobj)) 249 (setq widget (w3-form-element-widget formobj))
161 (widget-radio-add-item widget 250 (widget-radio-add-item widget
162 (list 'item 251 (list 'item
163 :format "%t" 252 :format "%t"
164 :tag "" 253 :tag ""
165 :value (w3-form-element-value el))) 254 :value (w3-form-element-value el)))
255 (w3-form-mark-widget widget el)
166 (if (w3-form-element-default-value el) 256 (if (w3-form-element-default-value el)
167 (widget-value-set widget (w3-form-element-value el))) 257 (progn
258 (widget-put widget 'w3-form-default-value
259 (w3-form-element-value el))
260 (widget-value-set widget (w3-form-element-value el))))
168 nil) 261 nil)
169 (setq widget (widget-create 'radio-button-choice 262 (setq widget (widget-create
170 :value (w3-form-element-value el) 263 'radio-button-choice
171 (list 'item 264 :value (w3-form-element-value el)
172 :format "%t" 265 :action 'w3-form-radio-button-update
173 :tag "" 266 (list 'item
174 :value (w3-form-element-value el))) 267 :format "%t"
175 w3-form-radio-elements (cons (cons name el) 268 :tag ""
269 :value (w3-form-element-value el)))
270 w3-form-radio-elements (cons (cons uniqid el)
176 w3-form-radio-elements)) 271 w3-form-radio-elements))
272 (widget-put widget 'w3-form-default-value (w3-form-element-value el))
177 widget))) 273 widget)))
178 274
179 (defun w3-form-create-button (el face) 275 (defun w3-form-create-button (el face)
180 ;; This handles dealing with the bogus Netscape 'button' input type 276 ;; This handles dealing with the bogus Netscape 'button' input type
181 ;; that lots of places have been using to slap javascript shit onto 277 ;; that lots of places have been using to slap javascript shit onto
182 (let ((val (w3-form-element-value el))) 278 (let ((val (w3-form-element-value el)))
183 (if (or (not val) (string= val "")) 279 (if (or (not val) (string= val ""))
184 (setq val "Push Me")) 280 (setq val "Push Me"))
185 (widget-create 'push-button :notify 'ignore :button-face face val))) 281 (widget-create 'push-button
282 :notify 'ignore
283 :button-face face
284 val)))
186 285
187 (defun w3-form-create-image (el face) 286 (defun w3-form-create-image (el face)
188 (let ((widget (widget-create 'push-button 287 (widget-create 'push-button
189 :notify 'w3-form-submit/reset-callback 288 :notify 'w3-form-submit/reset-callback
190 :value "Form-Image"))) 289 :value (or
191 widget)) 290 (plist-get (w3-form-element-plist el) 'alt)
291 "Form-Image")))
192 292
193 (defun w3-form-create-submit-button (el face) 293 (defun w3-form-create-submit-button (el face)
194 (let ((val (w3-form-element-value el))) 294 (let ((val (w3-form-element-value el)))
195 (if (or (not val) (string= val "")) 295 (if (or (not val) (string= val ""))
196 (setq val (if (eq (w3-form-element-type el) 'submit) 296 (setq val (if (eq (w3-form-element-type el) 'submit)
199 (widget-create 'push-button 299 (widget-create 'push-button
200 :notify 'w3-form-submit/reset-callback 300 :notify 'w3-form-submit/reset-callback
201 :button-face face val))) 301 :button-face face val)))
202 302
203 (defun w3-form-create-file-browser (el face) 303 (defun w3-form-create-file-browser (el face)
204 (widget-create 'file :value-face face :value (w3-form-element-value el))) 304 (widget-create 'file
305 :value-face face
306 :size (w3-form-element-size el)
307 :must-match t
308 :value (w3-form-element-value el)))
205 309
206 (defvar w3-form-valid-key-sizes 310 (defvar w3-form-valid-key-sizes
207 '( 311 '(
208 ("1024 (Premium)" . 1024) 312 ("1024 (Premium)" . 1024)
209 ("896 (Regular)" . 896) 313 ("896 (Regular)" . 896)
231 :size (1+ longest) 335 :size (1+ longest)
232 :value-face face 336 :value-face face
233 options))) 337 options)))
234 338
235 (defun w3-form-create-option-list (el face) 339 (defun w3-form-create-option-list (el face)
236 (let ((widget (apply 'widget-create 'menu-choice 340 (let* ((size (w3-form-determine-size el nil))
341 (widget (apply 'widget-create 'menu-choice
237 :value (w3-form-element-value el) 342 :value (w3-form-element-value el)
238 :ignore-case t 343 :ignore-case t
239 :tag "Choose" 344 :tag "Choose"
240 :format "%v" 345 :format "%v"
241 :size (w3-form-element-size el) 346 :size size
242 :value-face face 347 :value-face face
243 (mapcar 348 (mapcar
244 (function 349 (function
245 (lambda (x) 350 (lambda (x)
246 (list 'choice-item :format "%[%t%]" 351 (list 'choice-item :format "%[%t%]"
247 :tag (car x) :value (car x)))) 352 :emacspeak-help 'w3-form-summarize-field
353 :tag (mule-truncate-string (car x) size ? )
354 :value (car x))))
248 (w3-form-element-options el))))) 355 (w3-form-element-options el)))))
249 (widget-value-set widget (w3-form-element-value el)) 356 (widget-value-set widget (w3-form-element-value el))
250 widget)) 357 widget))
251 358
252 ;(defun w3-form-create-multiline (el face) 359 ;(defun w3-form-create-multiline (el face)
253 ; ;; FIX THIS! - need to padd out with newlines or something... 360 ; (widget-create 'text :value-face face (w3-form-element-value el)))
254 ; (widget-create 'field :value-face face (w3-form-element-value el)))
255 361
256 (defun w3-form-create-multiline (el face) 362 (defun w3-form-create-multiline (el face)
257 (widget-create 'push-button :notify 'w3-do-text-entry "Multiline text area")) 363 (widget-create 'push-button
364 :notify 'w3-do-text-entry
365 "Multiline text area"))
366
367 (defun w3-form-create-integer (el face)
368 (widget-create 'integer
369 :size (w3-form-element-size el)
370 :value-face face
371 :tag ""
372 :format "%v"
373 :keymap w3-form-keymap
374 :w3-form-data el
375 (w3-form-element-value el)))
376
377 (defun w3-form-create-float (el face)
378 (widget-create 'number
379 :size (w3-form-element-size el)
380 :value-face face
381 :format "%v"
382 :tag ""
383 :keymap w3-form-keymap
384 :w3-form-data el
385 (w3-form-element-value el)))
386
387 (defun w3-form-create-text (el face)
388 (widget-create 'editable-field
389 :keymap w3-form-keymap
390 :size (w3-form-element-size el)
391 :value-face face
392 :w3-form-data el
393 (w3-form-element-value el)))
394
395 (defun w3-form-create-password (el face)
396 ;; *sigh* This will fail under XEmacs, but I can yell at them about
397 ;; upgrading separately for the release of 19.15 and 20.0
398 (if (boundp :secret)
399 (widget-create 'editable-field
400 :secret ?*
401 :keymap w3-form-keymap
402 :size (w3-form-element-size el)
403 :value-face face
404 :w3-form-data el
405 (w3-form-element-value el))
406 (w3-form-default-widget-creator el face)))
258 407
259 (defun w3-form-default-widget-creator (el face) 408 (defun w3-form-default-widget-creator (el face)
260 (widget-create 'link 409 (widget-create 'link
261 :notify 'w3-form-default-button-callback 410 :notify 'w3-form-default-button-callback
411 :value-to-internal 'w3-form-default-button-update
262 :size (w3-form-element-size el) 412 :size (w3-form-element-size el)
263 :tag (mule-truncate-string (w3-form-element-value el)
264 (w3-form-element-size el) ?_)
265 :value-face face 413 :value-face face
414 :w3-form-data el
266 (w3-form-element-value el))) 415 (w3-form-element-value el)))
267 416
417 (defun w3-form-default-button-update (w v)
418 (let ((info (widget-get w :w3-form-data)))
419 (widget-put w :tag
420 (if info
421 (mule-truncate-string
422 (if (eq 'password (w3-form-element-type info))
423 (make-string (length v) ?*)
424 v)
425 (w3-form-element-size info) ?_)))
426 v))
427
268 (defun w3-form-default-button-callback (widget &rest ignore) 428 (defun w3-form-default-button-callback (widget &rest ignore)
269 (let* ((obj (widget-get widget 'w3-form-data)) 429 (let* ((obj (widget-get widget :w3-form-data))
270 (typ (w3-form-element-type obj)) 430 (typ (w3-form-element-type obj))
271 (def (widget-value widget)) 431 (def (widget-value widget))
272 (val nil) 432 (val nil)
273 ) 433 )
274 (case typ 434 (case typ
275 (password 435 (password
276 (setq val (funcall url-passwd-entry-func "Password: " def)) 436 (setq val (funcall url-passwd-entry-func "Password: " def)))
277 (widget-put widget :tag (mule-truncate-string
278 (make-string (length val) ?*)
279 (w3-form-element-size obj) ?_)))
280 (otherwise 437 (otherwise
281 (setq val (read-string 438 (setq val (read-string
282 (concat (capitalize (symbol-name typ)) ": ") def)) 439 (concat (capitalize (symbol-name typ)) ": ") def))))
283 (widget-put widget :tag (mule-truncate-string
284 val (w3-form-element-size obj) ?_))))
285 (widget-value-set widget val)) 440 (widget-value-set widget val))
286 (apply 'w3-form-possibly-submit widget ignore)) 441 (apply 'w3-form-possibly-submit widget ignore))
442
443 ;; These properties tell the help-echo function how to summarize each
444 ;; type of widget.
445 (put 'checkbox 'w3-summarize-function 'w3-form-summarize-checkbox)
446 (put 'multiline 'w3-summarize-function 'w3-form-summarize-multiline)
447 (put 'radio 'w3-summarize-function 'w3-form-summarize-radio-button)
448 (put 'reset 'w3-summarize-function 'w3-form-summarize-submit-button)
449 (put 'submit 'w3-summarize-function 'w3-form-summarize-submit-button)
450 (put 'button 'w3-summarize-function 'w3-form-summarize-submit-button)
451 (put 'file 'w3-summarize-function 'w3-form-summarize-file-browser)
452 (put 'option 'w3-summarize-function 'w3-form-summarize-option-list)
453 (put 'keygen 'w3-summarize-function 'w3-form-summarize-keygen-list)
454 (put 'image 'w3-summarize-function 'w3-form-summarize-image)
455 (put 'hidden 'w3-summariez-function 'ignore)
456
457 (defun w3-form-summarize-field (widget &rest ignore)
458 "Sumarize a widget that should be a W3 form entry area.
459 This can be used as the :help-echo property of all w3 form entry widgets."
460 (let ((info nil)
461 (func nil)
462 (msg nil)
463 )
464 (setq info (widget-get widget :w3-form-data))
465 (if info
466 nil
467 (while (widget-get widget :parent)
468 (setq widget (widget-get widget :parent)))
469 (setq info (widget-get widget :w3-form-data)))
470 (if (not info)
471 (signal 'wrong-type-argument (list 'w3-form-widget widget)))
472 (setq func (or (get (w3-form-element-type info) 'w3-summarize-function)
473 'w3-form-summarize-default)
474 msg (and (fboundp func) (funcall func info widget)))
475 ;; FIXME! This should be removed once emacspeak is updated to
476 ;; more closely follow the widget-y way of just returning the string
477 ;; instead of having the underlying :help-echo or :emacspeak-help
478 ;; implementation do it.
479 (message "%s" msg)))
480
481 (defsubst w3-form-field-label (data)
482 ;;; FIXXX!!! Need to reimplement using the new forms implementation!
483 (declare (special w3-form-labels))
484 nil)
485
486 (defun w3-form-summarize-default (data widget)
487 (let ((label (w3-form-field-label data))
488 (name (w3-form-element-name data))
489 (value (widget-value (w3-form-element-widget data))))
490 (format "Text field %s set to: %s" (or label (concat "called " name))
491 value)))
492
493 (defun w3-form-summarize-multiline (data widget)
494 (let ((name (w3-form-element-name data))
495 (label (w3-form-field-label data))
496 (value (w3-form-element-value data)))
497 (format "Multiline text input %s set to: %s"
498 (or label (concat "called " name))
499 value)))
500
501 (defun w3-form-summarize-checkbox (data widget)
502 (let ((name (w3-form-element-name data))
503 (label (w3-form-field-label data))
504 (checked (widget-value (w3-form-element-widget data))))
505 (format "Checkbox %s is %s" (or label name) (if checked "on" "off"))))
506
507 (defun w3-form-summarize-option-list (data widget)
508 (let ((name (w3-form-element-name data))
509 (label (w3-form-field-label data))
510 (default (w3-form-element-default-value data)))
511 (format "Option list (%s) set to: %s" (or label name)
512 (widget-value (w3-form-element-widget data)))))
513
514 (defun w3-form-summarize-image (data widget)
515 (let ((name (w3-form-element-name data))
516 (label (w3-form-field-label data)))
517 (concat "Image entry " (or label (concat "called " name)))))
518
519 (defun w3-form-summarize-submit-button (data widget)
520 (let* ((type (w3-form-element-type data))
521 (label (w3-form-field-label data))
522 (button-text (widget-value (w3-form-element-widget data)))
523 (type-desc (case type
524 (submit "Submit Form")
525 (reset "Reset Form")
526 (button "A Button"))))
527 (format "%s: %s" type-desc (or label button-text ""))))
528
529 (defun w3-form-summarize-radio-button (data widget)
530 (let ((name (w3-form-element-name data))
531 (label (w3-form-field-label data))
532 (cur-value (widget-value (w3-form-element-widget data)))
533 (this-value (widget-value widget)))
534 (format "Radio button %s is %s, could be %s" (or label name) cur-value
535 this-value)))
536
537 (defun w3-form-summarize-file-browser (data widget)
538 (let ((name (w3-form-element-name data))
539 (label (w3-form-field-label data))
540 (file (widget-value (w3-form-element-widget data))))
541 (format "File entry %s pointing to: %s" (or label name) (or file
542 "[nothing]"))))
543
544 (defun w3-form-summarize-keygen-list (data widget)
545 )
546
547
548 (defun w3-form-maybe-submit-by-keypress ()
549 (interactive)
550 (let ((widget (widget-at (point))))
551 (if widget
552 (w3-form-possibly-submit widget))))
287 553
288 (defun w3-form-possibly-submit (widget &rest ignore) 554 (defun w3-form-possibly-submit (widget &rest ignore)
289 (let* ((formobj (widget-get widget 'w3-form-data)) 555 (let* ((formobj (widget-get widget :w3-form-data))
290 (ident (w3-form-element-action formobj)) 556 (ident (w3-form-element-action formobj))
291 (widgets (w3-all-widgets ident)) 557 (widgets (w3-all-widgets ident))
292 (text-fields 0) 558 (text-fields 0)
293 (text-p nil)) 559 (text-p nil))
294 ;; 560 ;;
311 widgets (cdr widgets))) 577 widgets (cdr widgets)))
312 (if (and (= text-fields 1) text-p) 578 (if (and (= text-fields 1) text-p)
313 (w3-submit-form ident)))) 579 (w3-submit-form ident))))
314 580
315 (defun w3-form-submit/reset-callback (widget &rest ignore) 581 (defun w3-form-submit/reset-callback (widget &rest ignore)
316 (let* ((formobj (widget-get widget 'w3-form-data)) 582 (let* ((formobj (widget-get widget :w3-form-data))
317 (w3-submit-button formobj)) 583 (w3-submit-button formobj))
318 (case (w3-form-element-type formobj) 584 (case (w3-form-element-type formobj)
319 (submit (w3-submit-form (w3-form-element-action formobj))) 585 (submit (w3-submit-form (w3-form-element-action formobj)))
320 (reset (w3-revert-form (w3-form-element-action formobj))) 586 (reset (w3-revert-form (w3-form-element-action formobj)))
321 (image (w3-submit-form (w3-form-element-action formobj))) 587 (image (w3-submit-form (w3-form-element-action formobj)))
324 "Impossible widget type %s triggered w3-form-submit/reset-callback" 590 "Impossible widget type %s triggered w3-form-submit/reset-callback"
325 (w3-form-element-type formobj)))))) 591 (w3-form-element-type formobj))))))
326 592
327 (defun w3-do-text-entry (widget &rest ignore) 593 (defun w3-do-text-entry (widget &rest ignore)
328 (let* ((data (list widget (current-buffer))) 594 (let* ((data (list widget (current-buffer)))
329 (formobj (widget-get widget 'w3-form-data)) 595 (formobj (widget-get widget :w3-form-data))
330 (buff (get-buffer-create (format "Form Entry: %s" 596 (buff (get-buffer-create (format "Form Entry: %s"
331 (w3-form-element-name formobj))))) 597 (w3-form-element-name formobj)))))
332 (switch-to-buffer-other-window buff) 598 (switch-to-buffer-other-window buff)
333 (indented-text-mode) 599 (indented-text-mode)
334 (erase-buffer) 600 (erase-buffer)
340 606
341 (defun w3-finish-text-entry () 607 (defun w3-finish-text-entry ()
342 (interactive) 608 (interactive)
343 (if w3-current-last-buffer 609 (if w3-current-last-buffer
344 (let* ((widget (nth 0 w3-current-last-buffer)) 610 (let* ((widget (nth 0 w3-current-last-buffer))
345 (formobj (widget-get widget 'w3-form-data)) 611 (formobj (widget-get widget :w3-form-data))
346 (buff (nth 1 w3-current-last-buffer)) 612 (buff (nth 1 w3-current-last-buffer))
347 (valu (buffer-string)) 613 (valu (buffer-string))
348 (inhibit-read-only t) 614 (inhibit-read-only t)
349 ) 615 )
350 (local-set-key "\C-c\C-c" 'undefined) 616 (local-set-key "\C-c\C-c" 'undefined)
373 deft (w3-form-element-default-value formobj) 639 deft (w3-form-element-default-value formobj)
374 type (w3-form-element-type formobj)) 640 type (w3-form-element-type formobj))
375 (case type 641 (case type
376 ((submit reset image) nil) 642 ((submit reset image) nil)
377 (radio 643 (radio
378 ;; Ack - how!? 644 (setq deft (widget-get widget 'w3-form-default-value))
379 ) 645 (if (and widget deft)
646 (widget-value-set widget deft)))
380 (checkbox 647 (checkbox
381 (if deft 648 (if deft
382 (widget-value-set widget t) 649 (widget-value-set widget t)
383 (widget-value-set widget nil))) 650 (widget-value-set widget nil)))
651 (multiline
652 (w3-form-element-set-value formobj (w3-form-element-default-value
653 formobj)))
384 (file 654 (file
385 (widget-value-set widget deft)) 655 (widget-value-set widget deft))
386 (otherwise 656 (otherwise
387 (widget-value-set widget deft))))))) 657 (widget-value-set widget deft))))
658 (widget-setup))))
388 659
389 (defun w3-form-encode-helper (formobjs) 660 (defun w3-form-encode-helper (formobjs)
390 (let ( 661 (let (
391 (submit-button-data w3-submit-button) 662 (submit-button-data w3-submit-button)
392 formobj result widget temp type) 663 formobj result widget temp type)
395 type (w3-form-element-type formobj) 666 type (w3-form-element-type formobj)
396 widget (w3-form-element-widget formobj) 667 widget (w3-form-element-widget formobj)
397 formobjs (cdr formobjs) 668 formobjs (cdr formobjs)
398 temp (case type 669 temp (case type
399 (reset nil) 670 (reset nil)
671 (button nil)
400 (image 672 (image
401 (if (and (eq submit-button-data formobj) 673 (if (and (eq submit-button-data formobj)
402 (w3-form-element-name formobj)) 674 (w3-form-element-name formobj))
403 (setq result (append 675 (setq result (append
404 (list 676 (list
416 (cons (w3-form-element-name formobj) 688 (cons (w3-form-element-name formobj)
417 (w3-form-element-value formobj)))) 689 (w3-form-element-value formobj))))
418 (radio 690 (radio
419 (let* ((radio-name (w3-form-element-name formobj)) 691 (let* ((radio-name (w3-form-element-name formobj))
420 (radio-object (cdr-safe 692 (radio-object (cdr-safe
421 (assoc radio-name 693 (assoc
422 w3-form-radio-elements))) 694 (cons
695 radio-name
696 (w3-form-element-action formobj))
697 w3-form-radio-elements)))
423 (chosen-widget (and radio-object 698 (chosen-widget (and radio-object
424 (widget-radio-chosen 699 (widget-radio-chosen
425 (w3-form-element-widget 700 (w3-form-element-widget
426 radio-object))))) 701 radio-object)))))
427 (if (assoc radio-name result) 702 (if (assoc radio-name result)
428 nil 703 nil
429 (cons radio-name (widget-value chosen-widget))))) 704 (cons radio-name (widget-value chosen-widget)))))
705 ((int float)
706 (cons (w3-form-element-name formobj)
707 (number-to-string (or (condition-case ()
708 (widget-value widget)
709 (error nil)) 0))))
430 (checkbox 710 (checkbox
431 (if (widget-value widget) 711 (if (widget-value widget)
432 (cons (w3-form-element-name formobj) 712 (cons (w3-form-element-name formobj)
433 (w3-form-element-value formobj)))) 713 (w3-form-element-value formobj))))
434 (file 714 (file