comparison lisp/w3/w3-forms.el @ 86:364816949b59 r20-0b93

Import from CVS: tag r20-0b93
author cvs
date Mon, 13 Aug 2007 09:09:02 +0200
parents 6a378aca36af
children 821dec489c24
comparison
equal deleted inserted replaced
85:c661705957e0 86:364816949b59
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/21 19:45:55 3 ;; Created: 1997/01/27 00:57:39
4 ;; Version: 1.48 4 ;; Version: 1.51
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.
37 (require 'mule-sysdp) 37 (require 'mule-sysdp)
38 38
39 (define-widget-keywords :emacspeak-help :w3-form-data) 39 (define-widget-keywords :emacspeak-help :w3-form-data)
40 40
41 (defvar w3-form-keymap (copy-keymap global-map)) 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)
42 (define-key w3-form-keymap "\t" 'w3-widget-forward) 44 (define-key w3-form-keymap "\t" 'w3-widget-forward)
43 (define-key w3-form-keymap [(shift tab)] 'w3-widget-backward) 45 (define-key w3-form-keymap [(shift tab)] 'w3-widget-backward)
44 46
45 ;; A form entry area is a vector 47 ;; A form entry area is a vector
46 ;; [ type name default-value value maxlength options widget] 48 ;; [ type name default-value value maxlength options widget plist]
47 ;; Where: 49 ;; Where:
48 ;; type = symbol defining what type of form entry area it is 50 ;; type = symbol defining what type of form entry area it is
49 ;; (ie: file, radio) 51 ;; (ie: file, radio)
50 ;; name = the name of the form element 52 ;; name = the name of the form element
51 ;; default-value = the value this started out with 53 ;; default-value = the value this started out with
57 (defsubst w3-form-element-size (obj) (aref obj 4)) 59 (defsubst w3-form-element-size (obj) (aref obj 4))
58 (defsubst w3-form-element-maxlength (obj) (aref obj 5)) 60 (defsubst w3-form-element-maxlength (obj) (aref obj 5))
59 (defsubst w3-form-element-options (obj) (aref obj 6)) 61 (defsubst w3-form-element-options (obj) (aref obj 6))
60 (defsubst w3-form-element-action (obj) (aref obj 7)) 62 (defsubst w3-form-element-action (obj) (aref obj 7))
61 (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))
62 65
63 (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))
64 (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))
65 (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))
66 (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))
67 (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))
68 (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))
69 (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))
70 (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))
71 (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))
72 75 (defsubst w3-form-element-set-plist (obj val) (aset obj 9 val))
73 ;; The main function - this adds a single widget to the form 76
74 (defun w3-form-add-element (type name value size maxlength default 77 (defun w3-form-determine-size (el size)
75 action options number id checked 78 (case (w3-form-element-type el)
76 face) 79 (checkbox 3)
77 (let* ((name (or name (case type 80 (radio 4)
78 ((submit reset) nil) 81 ((reset submit) (+ 2 (length (or (w3-form-element-value el)
79 (otherwise (symbol-name type))))) 82 (symbol-name
80 (el (vector type 83 (w3-form-element-type el))))))
81 name 84 (multiline 21)
82 default 85 (hidden nil)
83 value 86 (file (or size 26))
84 size 87 ((float text int) (or size 20))
85 maxlength 88 (option
86 options 89 (or size
87 action nil)) 90 (length (caar (sort (w3-form-element-options el)
88 (size (case type 91 (function
89 (checkbox 3) 92 (lambda (x y)
90 (radio 4) 93 (>= (length (car x)) (length (car y))))))))))
91 ((reset submit) 94 (otherwise (or size 22))))
92 (+ 2 (length (or value (symbol-name type))))) 95
93 (multiline 21) 96 ;;###autoload
94 (hidden nil) 97 (defun w3-form-add-element (plist face)
95 (file (+ 6 (or size 20))) 98 (let* ((action (plist-get plist 'action))
96 ((float int) (or size 20)) 99 (el (vector (plist-get plist 'type)
97 (otherwise (or size 22)))) 100 (plist-get plist 'name)
101 (plist-get plist 'default)
102 (plist-get plist 'value)
103 (plist-get plist 'size)
104 (plist-get plist 'maxlength)
105 (plist-get plist 'options)
106 action
107 nil
108 plist))
109 (size (w3-form-determine-size el (plist-get plist 'size)))
98 (node (assoc action w3-form-elements))) 110 (node (assoc action w3-form-elements)))
99 (if (eq type 'hidden) 111 (if (eq (plist-get plist 'type) 'hidden)
100 (if node 112 (if node
101 (setcdr node (cons el (cdr node))) 113 (setcdr node (cons el (cdr node)))
102 (setq w3-form-elements (cons (cons action (list el)) 114 (setq w3-form-elements (cons (cons action (list el))
103 w3-form-elements)))) 115 w3-form-elements))))
104 (if size 116 (if size
186 (put 'keygen 'w3-widget-creation-function 'w3-form-create-keygen-list) 198 (put 'keygen 'w3-widget-creation-function 'w3-form-create-keygen-list)
187 (put 'button 'w3-widget-creation-function 'w3-form-create-button) 199 (put 'button 'w3-widget-creation-function 'w3-form-create-button)
188 (put 'image 'w3-widget-creation-function 'w3-form-create-image) 200 (put 'image 'w3-widget-creation-function 'w3-form-create-image)
189 (put 'int 'w3-widget-creation-function 'w3-form-create-integer) 201 (put 'int 'w3-widget-creation-function 'w3-form-create-integer)
190 (put 'float 'w3-widget-creation-function 'w3-form-create-float) 202 (put 'float 'w3-widget-creation-function 'w3-form-create-float)
203 (put 'custom 'w3-widget-creation-function 'w3-form-create-custom)
204 (put 'text 'w3-widget-creation-function 'w3-form-create-text)
205
206 ;; Custom support.
207 (defvar w3-custom-options nil)
208 (make-variable-buffer-local 'w3-custom-options)
209
210 (defun w3-form-create-custom (el face)
211 (require 'custom-edit)
212 (let* ((name (w3-form-element-name el))
213 (var-name (w3-form-element-value el))
214 (type (plist-get (w3-form-element-plist el) 'custom-type))
215 (widget (widget-create (cond ((string-equal type "variable")
216 'custom-variable)
217 ((string-equal type "face")
218 'custom-face)
219 ((string-equal type "group")
220 'custom-group)
221 (t 'item)) (intern var-name))))
222 (custom-magic-reset widget)
223 (push widget w3-custom-options)
224 widget))
191 225
192 (defun w3-form-create-checkbox (el face) 226 (defun w3-form-create-checkbox (el face)
193 (widget-create 'checkbox 227 (widget-create 'checkbox
194 :value-face face 228 :value-face face
195 (and (w3-form-element-default-value el) t))) 229 (and (w3-form-element-default-value el) t)))
295 :size (1+ longest) 329 :size (1+ longest)
296 :value-face face 330 :value-face face
297 options))) 331 options)))
298 332
299 (defun w3-form-create-option-list (el face) 333 (defun w3-form-create-option-list (el face)
300 (let ((widget (apply 'widget-create 'menu-choice 334 (let* ((size (w3-form-determine-size el nil))
335 (widget (apply 'widget-create 'menu-choice
301 :value (w3-form-element-value el) 336 :value (w3-form-element-value el)
302 :ignore-case t 337 :ignore-case t
303 :tag "Choose" 338 :tag "Choose"
304 :format "%v" 339 :format "%v"
305 :size (w3-form-element-size el) 340 :size size
306 :value-face face 341 :value-face face
307 (mapcar 342 (mapcar
308 (function 343 (function
309 (lambda (x) 344 (lambda (x)
310 (list 'choice-item :format "%[%t%]" 345 (list 'choice-item :format "%[%t%]"
311 :emacspeak-help 'w3-form-summarize-field 346 :emacspeak-help 'w3-form-summarize-field
312 :tag (mule-truncate-string (car x) 347 :tag (mule-truncate-string (car x) size ? )
313 (w3-form-element-size el) ? )
314 :value (car x)))) 348 :value (car x))))
315 (w3-form-element-options el))))) 349 (w3-form-element-options el)))))
316 (widget-value-set widget (w3-form-element-value el)) 350 (widget-value-set widget (w3-form-element-value el))
317 widget)) 351 widget))
318 352
339 :size (w3-form-element-size el) 373 :size (w3-form-element-size el)
340 :value-face face 374 :value-face face
341 :format "%v" 375 :format "%v"
342 :tag "" 376 :tag ""
343 :keymap w3-form-keymap 377 :keymap w3-form-keymap
378 :w3-form-data el
379 (w3-form-element-value el)))
380
381 (defun w3-form-create-text (el face)
382 (widget-create 'editable-field
383 :keymap w3-form-keymap
384 :size (w3-form-element-size el)
385 :value-face face
344 :w3-form-data el 386 :w3-form-data el
345 (w3-form-element-value el))) 387 (w3-form-element-value el)))
346 388
347 (defun w3-form-default-widget-creator (el face) 389 (defun w3-form-default-widget-creator (el face)
348 (widget-create 'link 390 (widget-create 'link
482 524
483 (defun w3-form-summarize-keygen-list (data widget) 525 (defun w3-form-summarize-keygen-list (data widget)
484 ) 526 )
485 527
486 528
529 (defun w3-form-maybe-submit-by-keypress ()
530 (interactive)
531 (let ((widget (widget-at (point))))
532 (if widget
533 (w3-form-possibly-submit widget))))
534
487 (defun w3-form-possibly-submit (widget &rest ignore) 535 (defun w3-form-possibly-submit (widget &rest ignore)
488 (let* ((formobj (widget-get widget :w3-form-data)) 536 (let* ((formobj (widget-get widget :w3-form-data))
489 (ident (w3-form-element-action formobj)) 537 (ident (w3-form-element-action formobj))
490 (widgets (w3-all-widgets ident)) 538 (widgets (w3-all-widgets ident))
491 (text-fields 0) 539 (text-fields 0)
585 (w3-form-element-set-value formobj (w3-form-element-default-value 633 (w3-form-element-set-value formobj (w3-form-element-default-value
586 formobj))) 634 formobj)))
587 (file 635 (file
588 (widget-value-set widget deft)) 636 (widget-value-set widget deft))
589 (otherwise 637 (otherwise
590 (widget-value-set widget deft))))))) 638 (widget-value-set widget deft))))
639 (widget-setup))))
591 640
592 (defun w3-form-encode-helper (formobjs) 641 (defun w3-form-encode-helper (formobjs)
593 (let ( 642 (let (
594 (submit-button-data w3-submit-button) 643 (submit-button-data w3-submit-button)
595 formobj result widget temp type) 644 formobj result widget temp type)
598 type (w3-form-element-type formobj) 647 type (w3-form-element-type formobj)
599 widget (w3-form-element-widget formobj) 648 widget (w3-form-element-widget formobj)
600 formobjs (cdr formobjs) 649 formobjs (cdr formobjs)
601 temp (case type 650 temp (case type
602 (reset nil) 651 (reset nil)
652 (button nil)
603 (image 653 (image
604 (if (and (eq submit-button-data formobj) 654 (if (and (eq submit-button-data formobj)
605 (w3-form-element-name formobj)) 655 (w3-form-element-name formobj))
606 (setq result (append 656 (setq result (append
607 (list 657 (list