Mercurial > hg > xemacs-beta
diff lisp/w3/w3-forms.el @ 98:0d2f883870bc r20-1b1
Import from CVS: tag r20-1b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:13:56 +0200 |
parents | 821dec489c24 |
children | a145efe76779 |
line wrap: on
line diff
--- a/lisp/w3/w3-forms.el Mon Aug 13 09:12:43 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 09:13:56 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1997/01/28 14:21:54 -;; Version: 1.55 +;; Created: 1997/02/13 23:10:23 +;; Version: 1.70 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -29,20 +29,44 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; FORMS processing for html 2.0/3.0 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(eval-when-compile + (require 'cl)) + (eval-and-compile (require 'w3-display) - (require 'widget)) + (require 'widget) + (require 'widget-edit)) (require 'w3-vars) (require 'mule-sysdp) +(defvar w3-form-use-old-style nil + "*Non-nil means use the old way of interacting for form fields.") + (define-widget-keywords :emacspeak-help :w3-form-data) -(defvar w3-form-keymap (copy-keymap global-map)) -(define-key w3-form-keymap "\r" 'w3-form-maybe-submit-by-keypress) -(define-key w3-form-keymap "\n" 'w3-form-maybe-submit-by-keypress) -(define-key w3-form-keymap "\t" 'w3-widget-forward) -(define-key w3-form-keymap [(shift tab)] 'w3-widget-backward) +(defvar w3-form-keymap + (let ((map (copy-keymap global-map)) + (eol-loc (where-is-internal 'end-of-line nil t))) + (if widget-keymap + (cl-map-keymap (function + (lambda (key binding) + (define-key map + (if (vectorp key) key (vector key)) + (case binding + (widget-backward 'w3-widget-backward) + (widget-forward 'w3-widget-forward) + (otherwise binding))))) + widget-keymap)) + (define-key map [return] 'w3-form-maybe-submit-by-keypress) + (define-key map "\r" 'w3-form-maybe-submit-by-keypress) + (define-key map "\n" 'w3-form-maybe-submit-by-keypress) + (define-key map "\t" 'w3-widget-forward) + (define-key map "\C-k" 'widget-kill-line) + (define-key map "\C-a" 'widget-beginning-of-line) + (if eol-loc + (define-key map eol-loc 'widget-end-of-line)) + map)) ;; A form entry area is a vector ;; [ type name default-value value maxlength options widget plist] @@ -84,16 +108,21 @@ (multiline 21) (hidden nil) (file (or size 26)) - ((float password text int) (or size 20)) + ((float password text int) + (if w3-form-use-old-style + (or size 22) + (or size 20))) (image (+ 2 (length (or (plist-get (w3-form-element-plist el) 'alt) "Form-Image")))) (option - (or size - (length (caar (sort (w3-form-element-options el) - (function - (lambda (x y) - (>= (length (car x)) (length (car y)))))))))) + (let ((options (copy-sequence (w3-form-element-options el)))) + (or size + (length (caar (sort options + (function + (lambda (x y) + (>= (length (car x)) + (length (car y))))))))))) (otherwise (or size 22)))) ;;###autoload @@ -120,19 +149,23 @@ (if size (set-text-properties (point) (progn (insert-char ?T size) (point)) - (list 'w3-form-info el + (list 'w3-form-info (cons el face) 'start-open t 'end-open t 'rear-nonsticky t))))) (defun w3-form-resurrect-widgets () (let ((st (point-min)) - info nd node action) + ;; FIXME! For some reason this loses on long lines right now. + (widget-push-button-gui nil) + info nd node action face) (while st (if (setq info (get-text-property st 'w3-form-info)) (progn (setq nd (or (next-single-property-change st 'w3-form-info) (point-max)) + face (cdr info) + info (car info) action (w3-form-element-action info) node (assoc action w3-form-elements)) (goto-char st) @@ -143,7 +176,7 @@ (setcdr node (cons info (cdr node))) (setq w3-form-elements (cons (cons action (list info)) w3-form-elements))) - (w3-form-add-element-internal info) + (w3-form-add-element-internal info face) (setq st (next-single-property-change st 'w3-form-info))) (setq st (next-single-property-change st 'w3-form-info)))))) @@ -173,9 +206,10 @@ (while widgets (setq widget (pop widgets)) (widget-put widget :emacspeak-help 'w3-form-summarize-field) + (widget-put widget :help-echo 'w3-form-summarize-field) (widget-put widget :w3-form-data el)))) -(defun w3-form-add-element-internal (el) +(defun w3-form-add-element-internal (el face) (let* ((widget nil) (buffer-read-only nil) (inhibit-read-only t) @@ -184,7 +218,7 @@ 'w3-widget-creation-function) 'w3-form-default-widget-creator) widget (and (fboundp widget-creation-function) - (funcall widget-creation-function el nil))) + (funcall widget-creation-function el face))) (if (not widget) nil (w3-form-mark-widget widget el)))) @@ -230,7 +264,7 @@ (defun w3-form-create-checkbox (el face) (widget-create 'checkbox - :value-face face + :button-face face (and (w3-form-element-default-value el) t))) (defun w3-form-radio-button-update (widget child event) @@ -281,6 +315,7 @@ (widget-create 'push-button :notify 'ignore :button-face face + :value-face face val))) (defun w3-form-create-image (el face) @@ -302,6 +337,7 @@ (defun w3-form-create-file-browser (el face) (widget-create 'file + :button-face face :value-face face :size (w3-form-element-size el) :must-match t @@ -333,6 +369,7 @@ :ignore-case t :tag "Key Length" :size (1+ longest) + :button-face face :value-face face options))) @@ -345,12 +382,16 @@ :format "%v" :size size :value-face face + :button-face face (mapcar (function (lambda (x) (list 'choice-item :format "%[%t%]" :emacspeak-help 'w3-form-summarize-field + :menu-tag-get (` (lambda (zed) (, (car x)))) :tag (mule-truncate-string (car x) size ? ) + :button-face face + :value-face face :value (car x)))) (w3-form-element-options el))))) (widget-value-set widget (w3-form-element-value el)) @@ -365,45 +406,52 @@ "Multiline text area")) (defun w3-form-create-integer (el face) - (widget-create 'integer - :size (w3-form-element-size el) - :value-face face - :tag "" - :format "%v" - :keymap w3-form-keymap - :w3-form-data el - (w3-form-element-value el))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'integer + :size (w3-form-element-size el) + :value-face face + :tag "" + :format "%v" + :keymap w3-form-keymap + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-create-float (el face) - (widget-create 'number - :size (w3-form-element-size el) - :value-face face - :format "%v" - :tag "" - :keymap w3-form-keymap - :w3-form-data el - (w3-form-element-value el))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'number + :size (w3-form-element-size el) + :value-face face + :format "%v" + :tag "" + :keymap w3-form-keymap + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-create-text (el face) - (widget-create 'editable-field - :keymap w3-form-keymap - :size (w3-form-element-size el) - :value-face face - :w3-form-data el - (w3-form-element-value el))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'editable-field + :keymap w3-form-keymap + :size (w3-form-element-size el) + :value-face face + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-create-password (el face) ;; *sigh* This will fail under XEmacs, but I can yell at them about ;; upgrading separately for the release of 19.15 and 20.0 - (if (boundp :secret) - (widget-create 'editable-field - :secret ?* - :keymap w3-form-keymap - :size (w3-form-element-size el) - :value-face face - :w3-form-data el - (w3-form-element-value el)) - (w3-form-default-widget-creator el face))) + (if w3-form-use-old-style + (w3-form-default-widget-creator el face) + (widget-create 'editable-field + :secret ?* + :keymap w3-form-keymap + :size (w3-form-element-size el) + :value-face face + :button-face face + :w3-form-data el + (w3-form-element-value el)))) (defun w3-form-default-widget-creator (el face) (widget-create 'link @@ -411,6 +459,7 @@ :value-to-internal 'w3-form-default-button-update :size (w3-form-element-size el) :value-face face + :button-face face :w3-form-data el (w3-form-element-value el))) @@ -422,7 +471,7 @@ (if (eq 'password (w3-form-element-type info)) (make-string (length v) ?*) v) - (w3-form-element-size info) ?_))) + (w3-form-element-size info) ? ))) v)) (defun w3-form-default-button-callback (widget &rest ignore) @@ -452,7 +501,7 @@ (put 'option 'w3-summarize-function 'w3-form-summarize-option-list) (put 'keygen 'w3-summarize-function 'w3-form-summarize-keygen-list) (put 'image 'w3-summarize-function 'w3-form-summarize-image) -(put 'hidden 'w3-summariez-function 'ignore) +(put 'hidden 'w3-summarize-function 'ignore) (defun w3-form-summarize-field (widget &rest ignore) "Sumarize a widget that should be a W3 form entry area. @@ -530,7 +579,7 @@ (let ((name (w3-form-element-name data)) (label (w3-form-field-label data)) (cur-value (widget-value (w3-form-element-widget data))) - (this-value (widget-value widget))) + (this-value (widget-value (widget-get-sibling widget)))) (format "Radio button %s is %s, could be %s" (or label name) cur-value this-value))) @@ -639,7 +688,7 @@ deft (w3-form-element-default-value formobj) type (w3-form-element-type formobj)) (case type - ((submit reset image) nil) + ((submit reset image hidden) nil) (radio (setq deft (widget-get widget 'w3-form-default-value)) (if (and widget deft) @@ -823,6 +872,7 @@ (lambda (char) (cond ((= char ? ) "+") + ((memq char '(?: ?/)) (char-to-string char)) ((memq char url-unreserved-chars) (char-to-string char)) (t (upcase (format "%%%02x" char)))))) (mule-encode-string chunk) ""))