Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-forms.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 0293115a14e9
children 8fc7fe29b841
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
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/28 14:21:54 3 ;; Created: 1997/02/09 06:39:43
4 ;; Version: 1.55 4 ;; Version: 1.65
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, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 28
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;; FORMS processing for html 2.0/3.0 30 ;;; FORMS processing for html 2.0/3.0
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 (eval-when-compile
33 (require 'cl))
34
32 (eval-and-compile 35 (eval-and-compile
33 (require 'w3-display) 36 (require 'w3-display)
34 (require 'widget)) 37 (require 'widget)
38 (require 'widget-edit))
35 39
36 (require 'w3-vars) 40 (require 'w3-vars)
37 (require 'mule-sysdp) 41 (require 'mule-sysdp)
38 42
43 (defvar w3-form-use-old-style nil
44 "*Non-nil means use the old way of interacting for form fields.")
45
39 (define-widget-keywords :emacspeak-help :w3-form-data) 46 (define-widget-keywords :emacspeak-help :w3-form-data)
40 47
41 (defvar w3-form-keymap (copy-keymap global-map)) 48 (defvar w3-form-keymap (copy-keymap global-map))
49 (if (and w3-form-keymap widget-keymap)
50 (cl-map-keymap (function
51 (lambda (key binding)
52 (define-key w3-form-keymap
53 (if (vectorp key) key (vector key))
54 (case binding
55 (widget-backward 'w3-widget-backward)
56 (widget-forward 'w3-widget-forward)
57 (otherwise binding)))))
58 widget-keymap))
59 (define-key w3-form-keymap [return] 'w3-form-maybe-submit-by-keypress)
42 (define-key w3-form-keymap "\r" 'w3-form-maybe-submit-by-keypress) 60 (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) 61 (define-key w3-form-keymap "\n" 'w3-form-maybe-submit-by-keypress)
44 (define-key w3-form-keymap "\t" 'w3-widget-forward) 62 (define-key w3-form-keymap "\t" 'w3-widget-forward)
45 (define-key w3-form-keymap [(shift tab)] 'w3-widget-backward) 63 (define-key w3-form-keymap "\C-k" 'widget-kill-line)
64 (define-key w3-form-keymap "\C-a" 'widget-beginning-of-line)
65 (define-key w3-form-keymap "\C-e" 'widget-end-of-line)
46 66
47 ;; A form entry area is a vector 67 ;; A form entry area is a vector
48 ;; [ type name default-value value maxlength options widget plist] 68 ;; [ type name default-value value maxlength options widget plist]
49 ;; Where: 69 ;; Where:
50 ;; type = symbol defining what type of form entry area it is 70 ;; type = symbol defining what type of form entry area it is
82 (symbol-name 102 (symbol-name
83 (w3-form-element-type el)))))) 103 (w3-form-element-type el))))))
84 (multiline 21) 104 (multiline 21)
85 (hidden nil) 105 (hidden nil)
86 (file (or size 26)) 106 (file (or size 26))
87 ((float password text int) (or size 20)) 107 ((float password text int)
108 (if w3-form-use-old-style
109 (or size 22)
110 (or size 20)))
88 (image (+ 2 (length (or 111 (image (+ 2 (length (or
89 (plist-get (w3-form-element-plist el) 'alt) 112 (plist-get (w3-form-element-plist el) 'alt)
90 "Form-Image")))) 113 "Form-Image"))))
91 (option 114 (option
92 (or size 115 (let ((options (copy-sequence (w3-form-element-options el))))
93 (length (caar (sort (w3-form-element-options el) 116 (or size
94 (function 117 (length (caar (sort options
95 (lambda (x y) 118 (function
96 (>= (length (car x)) (length (car y)))))))))) 119 (lambda (x y)
120 (>= (length (car x))
121 (length (car y)))))))))))
97 (otherwise (or size 22)))) 122 (otherwise (or size 22))))
98 123
99 ;;###autoload 124 ;;###autoload
100 (defun w3-form-add-element (plist face) 125 (defun w3-form-add-element (plist face)
101 (let* ((action (plist-get plist 'action)) 126 (let* ((action (plist-get plist 'action))
118 (setq w3-form-elements (cons (cons action (list el)) 143 (setq w3-form-elements (cons (cons action (list el))
119 w3-form-elements)))) 144 w3-form-elements))))
120 (if size 145 (if size
121 (set-text-properties (point) 146 (set-text-properties (point)
122 (progn (insert-char ?T size) (point)) 147 (progn (insert-char ?T size) (point))
123 (list 'w3-form-info el 148 (list 'w3-form-info (cons el face)
124 'start-open t 149 'start-open t
125 'end-open t 150 'end-open t
126 'rear-nonsticky t))))) 151 'rear-nonsticky t)))))
127 152
128 (defun w3-form-resurrect-widgets () 153 (defun w3-form-resurrect-widgets ()
129 (let ((st (point-min)) 154 (let ((st (point-min))
130 info nd node action) 155 info nd node action face)
131 (while st 156 (while st
132 (if (setq info (get-text-property st 'w3-form-info)) 157 (if (setq info (get-text-property st 'w3-form-info))
133 (progn 158 (progn
134 (setq nd (or (next-single-property-change st 'w3-form-info) 159 (setq nd (or (next-single-property-change st 'w3-form-info)
135 (point-max)) 160 (point-max))
161 face (cdr info)
162 info (car info)
136 action (w3-form-element-action info) 163 action (w3-form-element-action info)
137 node (assoc action w3-form-elements)) 164 node (assoc action w3-form-elements))
138 (goto-char st) 165 (goto-char st)
139 (delete-region st nd) 166 (delete-region st nd)
140 (if (not (w3-form-element-size info)) 167 (if (not (w3-form-element-size info))
141 (w3-form-element-set-size info 20)) 168 (w3-form-element-set-size info 20))
142 (if node 169 (if node
143 (setcdr node (cons info (cdr node))) 170 (setcdr node (cons info (cdr node)))
144 (setq w3-form-elements (cons (cons action (list info)) 171 (setq w3-form-elements (cons (cons action (list info))
145 w3-form-elements))) 172 w3-form-elements)))
146 (w3-form-add-element-internal info) 173 (w3-form-add-element-internal info face)
147 (setq st (next-single-property-change st 'w3-form-info))) 174 (setq st (next-single-property-change st 'w3-form-info)))
148 (setq st (next-single-property-change st 'w3-form-info)))))) 175 (setq st (next-single-property-change st 'w3-form-info))))))
149 176
150 (defsubst w3-form-mark-widget (widget el) 177 (defsubst w3-form-mark-widget (widget el)
151 (let ((widgets (list widget)) 178 (let ((widgets (list widget))
171 (widget-get (car children) :children)))) 198 (widget-get (car children) :children))))
172 (setq children (cdr children))) 199 (setq children (cdr children)))
173 (while widgets 200 (while widgets
174 (setq widget (pop widgets)) 201 (setq widget (pop widgets))
175 (widget-put widget :emacspeak-help 'w3-form-summarize-field) 202 (widget-put widget :emacspeak-help 'w3-form-summarize-field)
203 (widget-put widget :help-echo 'w3-form-summarize-field)
176 (widget-put widget :w3-form-data el)))) 204 (widget-put widget :w3-form-data el))))
177 205
178 (defun w3-form-add-element-internal (el) 206 (defun w3-form-add-element-internal (el face)
179 (let* ((widget nil) 207 (let* ((widget nil)
180 (buffer-read-only nil) 208 (buffer-read-only nil)
181 (inhibit-read-only t) 209 (inhibit-read-only t)
182 (widget-creation-function nil)) 210 (widget-creation-function nil))
183 (setq widget-creation-function (or (get (w3-form-element-type el) 211 (setq widget-creation-function (or (get (w3-form-element-type el)
184 'w3-widget-creation-function) 212 'w3-widget-creation-function)
185 'w3-form-default-widget-creator) 213 'w3-form-default-widget-creator)
186 widget (and (fboundp widget-creation-function) 214 widget (and (fboundp widget-creation-function)
187 (funcall widget-creation-function el nil))) 215 (funcall widget-creation-function el face)))
188 (if (not widget) 216 (if (not widget)
189 nil 217 nil
190 (w3-form-mark-widget widget el)))) 218 (w3-form-mark-widget widget el))))
191 219
192 ;; These properties tell the add-element function how to actually create 220 ;; These properties tell the add-element function how to actually create
228 (push widget w3-custom-options) 256 (push widget w3-custom-options)
229 widget)) 257 widget))
230 258
231 (defun w3-form-create-checkbox (el face) 259 (defun w3-form-create-checkbox (el face)
232 (widget-create 'checkbox 260 (widget-create 'checkbox
233 :value-face face 261 :button-face face
234 (and (w3-form-element-default-value el) t))) 262 (and (w3-form-element-default-value el) t)))
235 263
236 (defun w3-form-radio-button-update (widget child event) 264 (defun w3-form-radio-button-update (widget child event)
237 (widget-radio-action widget child event) 265 (widget-radio-action widget child event)
238 (w3-form-mark-widget widget (widget-get widget :w3-form-data))) 266 (w3-form-mark-widget widget (widget-get widget :w3-form-data)))
279 (if (or (not val) (string= val "")) 307 (if (or (not val) (string= val ""))
280 (setq val "Push Me")) 308 (setq val "Push Me"))
281 (widget-create 'push-button 309 (widget-create 'push-button
282 :notify 'ignore 310 :notify 'ignore
283 :button-face face 311 :button-face face
312 :value-face face
284 val))) 313 val)))
285 314
286 (defun w3-form-create-image (el face) 315 (defun w3-form-create-image (el face)
287 (widget-create 'push-button 316 (widget-create 'push-button
288 :notify 'w3-form-submit/reset-callback 317 :notify 'w3-form-submit/reset-callback
300 :notify 'w3-form-submit/reset-callback 329 :notify 'w3-form-submit/reset-callback
301 :button-face face val))) 330 :button-face face val)))
302 331
303 (defun w3-form-create-file-browser (el face) 332 (defun w3-form-create-file-browser (el face)
304 (widget-create 'file 333 (widget-create 'file
334 :button-face face
305 :value-face face 335 :value-face face
306 :size (w3-form-element-size el) 336 :size (w3-form-element-size el)
307 :must-match t 337 :must-match t
308 :value (w3-form-element-value el))) 338 :value (w3-form-element-value el)))
309 339
331 (apply 'widget-create 'menu-choice 361 (apply 'widget-create 'menu-choice
332 :value 1024 362 :value 1024
333 :ignore-case t 363 :ignore-case t
334 :tag "Key Length" 364 :tag "Key Length"
335 :size (1+ longest) 365 :size (1+ longest)
366 :button-face face
336 :value-face face 367 :value-face face
337 options))) 368 options)))
338 369
339 (defun w3-form-create-option-list (el face) 370 (defun w3-form-create-option-list (el face)
340 (let* ((size (w3-form-determine-size el nil)) 371 (let* ((size (w3-form-determine-size el nil))
343 :ignore-case t 374 :ignore-case t
344 :tag "Choose" 375 :tag "Choose"
345 :format "%v" 376 :format "%v"
346 :size size 377 :size size
347 :value-face face 378 :value-face face
379 :button-face face
348 (mapcar 380 (mapcar
349 (function 381 (function
350 (lambda (x) 382 (lambda (x)
351 (list 'choice-item :format "%[%t%]" 383 (list 'choice-item :format "%[%t%]"
352 :emacspeak-help 'w3-form-summarize-field 384 :emacspeak-help 'w3-form-summarize-field
353 :tag (mule-truncate-string (car x) size ? ) 385 :tag (mule-truncate-string (car x) size ? )
386 :button-face face
387 :value-face face
354 :value (car x)))) 388 :value (car x))))
355 (w3-form-element-options el))))) 389 (w3-form-element-options el)))))
356 (widget-value-set widget (w3-form-element-value el)) 390 (widget-value-set widget (w3-form-element-value el))
357 widget)) 391 widget))
358 392
363 (widget-create 'push-button 397 (widget-create 'push-button
364 :notify 'w3-do-text-entry 398 :notify 'w3-do-text-entry
365 "Multiline text area")) 399 "Multiline text area"))
366 400
367 (defun w3-form-create-integer (el face) 401 (defun w3-form-create-integer (el face)
368 (widget-create 'integer 402 (if w3-form-use-old-style
369 :size (w3-form-element-size el) 403 (w3-form-default-widget-creator el face)
370 :value-face face 404 (widget-create 'integer
371 :tag "" 405 :size (w3-form-element-size el)
372 :format "%v" 406 :value-face face
373 :keymap w3-form-keymap 407 :tag ""
374 :w3-form-data el 408 :format "%v"
375 (w3-form-element-value el))) 409 :keymap w3-form-keymap
410 :w3-form-data el
411 (w3-form-element-value el))))
376 412
377 (defun w3-form-create-float (el face) 413 (defun w3-form-create-float (el face)
378 (widget-create 'number 414 (if w3-form-use-old-style
379 :size (w3-form-element-size el) 415 (w3-form-default-widget-creator el face)
380 :value-face face 416 (widget-create 'number
381 :format "%v" 417 :size (w3-form-element-size el)
382 :tag "" 418 :value-face face
383 :keymap w3-form-keymap 419 :format "%v"
384 :w3-form-data el 420 :tag ""
385 (w3-form-element-value el))) 421 :keymap w3-form-keymap
422 :w3-form-data el
423 (w3-form-element-value el))))
386 424
387 (defun w3-form-create-text (el face) 425 (defun w3-form-create-text (el face)
388 (widget-create 'editable-field 426 (if w3-form-use-old-style
389 :keymap w3-form-keymap 427 (w3-form-default-widget-creator el face)
390 :size (w3-form-element-size el) 428 (widget-create 'editable-field
391 :value-face face 429 :keymap w3-form-keymap
392 :w3-form-data el 430 :size (w3-form-element-size el)
393 (w3-form-element-value el))) 431 :value-face face
432 :w3-form-data el
433 (w3-form-element-value el))))
394 434
395 (defun w3-form-create-password (el face) 435 (defun w3-form-create-password (el face)
396 ;; *sigh* This will fail under XEmacs, but I can yell at them about 436 ;; *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 437 ;; upgrading separately for the release of 19.15 and 20.0
398 (if (boundp :secret) 438 (if w3-form-use-old-style
399 (widget-create 'editable-field 439 (w3-form-default-widget-creator el face)
400 :secret ?* 440 (widget-create 'editable-field
401 :keymap w3-form-keymap 441 :secret ?*
402 :size (w3-form-element-size el) 442 :keymap w3-form-keymap
403 :value-face face 443 :size (w3-form-element-size el)
404 :w3-form-data el 444 :value-face face
405 (w3-form-element-value el)) 445 :button-face face
406 (w3-form-default-widget-creator el face))) 446 :w3-form-data el
447 (w3-form-element-value el))))
407 448
408 (defun w3-form-default-widget-creator (el face) 449 (defun w3-form-default-widget-creator (el face)
409 (widget-create 'link 450 (widget-create 'link
410 :notify 'w3-form-default-button-callback 451 :notify 'w3-form-default-button-callback
411 :value-to-internal 'w3-form-default-button-update 452 :value-to-internal 'w3-form-default-button-update
412 :size (w3-form-element-size el) 453 :size (w3-form-element-size el)
413 :value-face face 454 :value-face face
455 :button-face face
414 :w3-form-data el 456 :w3-form-data el
415 (w3-form-element-value el))) 457 (w3-form-element-value el)))
416 458
417 (defun w3-form-default-button-update (w v) 459 (defun w3-form-default-button-update (w v)
418 (let ((info (widget-get w :w3-form-data))) 460 (let ((info (widget-get w :w3-form-data)))
420 (if info 462 (if info
421 (mule-truncate-string 463 (mule-truncate-string
422 (if (eq 'password (w3-form-element-type info)) 464 (if (eq 'password (w3-form-element-type info))
423 (make-string (length v) ?*) 465 (make-string (length v) ?*)
424 v) 466 v)
425 (w3-form-element-size info) ?_))) 467 (w3-form-element-size info) ? )))
426 v)) 468 v))
427 469
428 (defun w3-form-default-button-callback (widget &rest ignore) 470 (defun w3-form-default-button-callback (widget &rest ignore)
429 (let* ((obj (widget-get widget :w3-form-data)) 471 (let* ((obj (widget-get widget :w3-form-data))
430 (typ (w3-form-element-type obj)) 472 (typ (w3-form-element-type obj))
450 (put 'button 'w3-summarize-function 'w3-form-summarize-submit-button) 492 (put 'button 'w3-summarize-function 'w3-form-summarize-submit-button)
451 (put 'file 'w3-summarize-function 'w3-form-summarize-file-browser) 493 (put 'file 'w3-summarize-function 'w3-form-summarize-file-browser)
452 (put 'option 'w3-summarize-function 'w3-form-summarize-option-list) 494 (put 'option 'w3-summarize-function 'w3-form-summarize-option-list)
453 (put 'keygen 'w3-summarize-function 'w3-form-summarize-keygen-list) 495 (put 'keygen 'w3-summarize-function 'w3-form-summarize-keygen-list)
454 (put 'image 'w3-summarize-function 'w3-form-summarize-image) 496 (put 'image 'w3-summarize-function 'w3-form-summarize-image)
455 (put 'hidden 'w3-summariez-function 'ignore) 497 (put 'hidden 'w3-summarize-function 'ignore)
456 498
457 (defun w3-form-summarize-field (widget &rest ignore) 499 (defun w3-form-summarize-field (widget &rest ignore)
458 "Sumarize a widget that should be a W3 form entry area. 500 "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." 501 This can be used as the :help-echo property of all w3 form entry widgets."
460 (let ((info nil) 502 (let ((info nil)
528 570
529 (defun w3-form-summarize-radio-button (data widget) 571 (defun w3-form-summarize-radio-button (data widget)
530 (let ((name (w3-form-element-name data)) 572 (let ((name (w3-form-element-name data))
531 (label (w3-form-field-label data)) 573 (label (w3-form-field-label data))
532 (cur-value (widget-value (w3-form-element-widget data))) 574 (cur-value (widget-value (w3-form-element-widget data)))
533 (this-value (widget-value widget))) 575 (this-value (widget-value (widget-get-sibling widget))))
534 (format "Radio button %s is %s, could be %s" (or label name) cur-value 576 (format "Radio button %s is %s, could be %s" (or label name) cur-value
535 this-value))) 577 this-value)))
536 578
537 (defun w3-form-summarize-file-browser (data widget) 579 (defun w3-form-summarize-file-browser (data widget)
538 (let ((name (w3-form-element-name data)) 580 (let ((name (w3-form-element-name data))
637 widget (w3-form-element-widget formobj) 679 widget (w3-form-element-widget formobj)
638 formobjs (cdr formobjs) 680 formobjs (cdr formobjs)
639 deft (w3-form-element-default-value formobj) 681 deft (w3-form-element-default-value formobj)
640 type (w3-form-element-type formobj)) 682 type (w3-form-element-type formobj))
641 (case type 683 (case type
642 ((submit reset image) nil) 684 ((submit reset image hidden) nil)
643 (radio 685 (radio
644 (setq deft (widget-get widget 'w3-form-default-value)) 686 (setq deft (widget-get widget 'w3-form-default-value))
645 (if (and widget deft) 687 (if (and widget deft)
646 (widget-value-set widget deft))) 688 (widget-value-set widget deft)))
647 (checkbox 689 (checkbox
821 (mapconcat 863 (mapconcat
822 (function 864 (function
823 (lambda (char) 865 (lambda (char)
824 (cond 866 (cond
825 ((= char ? ) "+") 867 ((= char ? ) "+")
868 ((memq char '(?: ?/)) (char-to-string char))
826 ((memq char url-unreserved-chars) (char-to-string char)) 869 ((memq char url-unreserved-chars) (char-to-string char))
827 (t (upcase (format "%%%02x" char)))))) 870 (t (upcase (format "%%%02x" char))))))
828 (mule-encode-string chunk) "")) 871 (mule-encode-string chunk) ""))
829 872
830 (defun w3-form-encode-application/x-www-form-urlencoded (result) 873 (defun w3-form-encode-application/x-www-form-urlencoded (result)