--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/w3/w3-forms.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,586 @@
+;;; w3-forms.el,v --- Emacs-w3 forms parsing code for new display engine
+;; Author: wmperry
+;; Created: 1996/06/06 14:14:34
+;; Version: 1.51
+;; Keywords: faces, help, comm, data, languages
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
+;;;
+;;; This file is not part of GNU Emacs, but the same permissions apply.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; FORMS processing for html 2.0/3.0
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(eval-and-compile
+  (require 'w3-draw))
+
+(require 'widget)
+
+(if (featurep 'mule) (fset 'string-width 'length))
+
+;; These are things in later versions of the widget package that I don't
+;; have yet.
+(defun widget-at (pt)
+  (or (get-text-property pt 'button)
+      (get-text-property pt 'field)))
+
+;; A form entry area is a vector
+;; [ type name default-value value maxlength options widget]
+;; Where:
+;;          type = symbol defining what type of form entry area it is
+;;                 (ie: file, radio)
+;;          name = the name of the form element
+;; default-value = the value this started out with
+
+(defsubst w3-form-element-type          (obj) (aref obj 0))
+(defsubst w3-form-element-name          (obj) (aref obj 1))
+(defsubst w3-form-element-default-value (obj) (aref obj 2))
+(defsubst w3-form-element-value         (obj) (aref obj 3))
+(defsubst w3-form-element-size          (obj) (aref obj 4))
+(defsubst w3-form-element-maxlength     (obj) (aref obj 5))
+(defsubst w3-form-element-options       (obj) (aref obj 6))
+(defsubst w3-form-element-action        (obj) (aref obj 7))
+(defsubst w3-form-element-widget        (obj) (aref obj 8))
+
+(defsubst w3-form-element-set-type          (obj val) (aset obj 0 val))
+(defsubst w3-form-element-set-name          (obj val) (aset obj 1 val))
+(defsubst w3-form-element-set-default-value (obj val) (aset obj 2 val))
+(defsubst w3-form-element-set-value         (obj val) (aset obj 3 val))
+(defsubst w3-form-element-set-size          (obj val) (aset obj 4 val))
+(defsubst w3-form-element-set-maxlength     (obj val) (aset obj 5 val))
+(defsubst w3-form-element-set-options       (obj val) (aset obj 6 val))
+(defsubst w3-form-element-set-action        (obj val) (aset obj 7 val))
+(defsubst w3-form-element-set-widget        (obj val) (aset obj 8 val))
+
+;; The main function - this adds a single widget to the form
+(defun w3-form-add-element (&rest args)
+  (let* ((widget nil)
+	 (buffer-read-only nil)
+	 (inhibit-read-only t)
+	 (widget-creation-function nil)
+	 (action (nth 6 args))
+	 (node (assoc action w3-form-elements))
+	 (name (or (nth 1 args)
+		   (if (memq (nth 0 args) '(submit reset))
+		       nil
+		     (symbol-name (nth 0 args)))))
+	 (val (vector (nth 0 args)	; type
+		      name		; name
+		      (nth 5 args)	; default
+		      (nth 2 args)	; value
+		      (nth 3 args)	; size
+		      (nth 4 args)	; maxlength
+		      (nth 7 args)	; options
+		      action
+		      nil))		; widget
+	 )
+    (setq widget-creation-function (or (get (car args)
+					    'w3-widget-creation-function)
+				       'w3-form-default-widget-creator)
+	  widget (funcall widget-creation-function val
+			  (cdr (nth 10 args))))
+    (if node
+	(setcdr node (cons val (cdr node)))
+      (setq w3-form-elements (cons (cons action (list val)) w3-form-elements)))
+    (if (not widget)
+	nil
+      (w3-form-element-set-widget val widget)
+      (widget-put widget 'w3-form-data val))))
+
+;; These properties tell the add-element function how to actually create
+;; each type of widget.
+(put 'checkbox  'w3-widget-creation-function 'w3-form-create-checkbox)
+(put 'multiline 'w3-widget-creation-function 'w3-form-create-multiline)
+(put 'radio     'w3-widget-creation-function 'w3-form-create-radio-button)
+(put 'reset     'w3-widget-creation-function 'w3-form-create-submit-button)
+(put 'submit    'w3-widget-creation-function 'w3-form-create-submit-button)
+(put 'hidden    'w3-widget-creation-function 'ignore)
+(put 'file      'w3-widget-creation-function 'w3-form-create-file-browser)
+(put 'option    'w3-widget-creation-function 'w3-form-create-option-list)
+(put 'keygen    'w3-widget-creation-function 'w3-form-create-keygen-list)
+(put 'button    'w3-widget-creation-function 'w3-form-create-button)
+(put 'image	'w3-widget-creation-function 'w3-form-create-image)
+
+(defun w3-form-create-checkbox (el face)
+  (widget-create 'checkbox :value-face face
+		 (and (w3-form-element-default-value el) t)))
+
+(defun w3-form-create-radio-button (el face)
+  (let* ((name (w3-form-element-name el))
+	 (formobj (cdr (assoc name w3-form-radio-elements)))
+	 (widget nil)
+	 )
+    (if formobj
+	(progn
+	  (setq widget (w3-form-element-widget formobj))
+	  (widget-radio-add-item widget (list 'item :format "%t" :tag ""))
+	  nil)
+      (setq widget (widget-create 'radio (list 'item :format "%t" :tag ""))
+	    w3-form-radio-elements (cons (cons name el)
+					 w3-form-radio-elements))
+      widget)))
+
+(defun w3-form-create-button (el face)
+  ;; This handles dealing with the bogus Netscape 'button' input type
+  ;; that lots of places have been using to slap javascript shit onto
+  (let ((val (w3-form-element-value el)))
+    (if (or (not val) (string= val ""))
+	(setq val "Push Me"))
+    (widget-create 'push :notify 'ignore :button-face face val)))
+
+(defun w3-form-create-image (el face)
+  (let ((widget (widget-create 'push
+			       :notify 'w3-form-submit/reset-callback
+			       :value "Form-Image")))
+    widget))
+
+(defun w3-form-create-submit-button (el face)
+  (let ((val (w3-form-element-value el)))
+    (if (or (not val) (string= val ""))
+	(setq val (if (eq (w3-form-element-type el) 'submit)
+		      "Submit"
+		    "Reset")))
+    (widget-create 'push :notify 'w3-form-submit/reset-callback
+		   :button-face face val)))
+
+(defun w3-form-create-file-browser (el face)
+  (widget-create 'file :value-face face :value (w3-form-element-value el)))
+
+
+(defvar w3-form-valid-key-sizes
+  '(
+    ("1024 (Premium)" . 1024)
+    ("896 (Regular)" . 896)
+    ("768 (Unleaded)" . 768)
+    ("512 (Low Grade)" . 512)
+    ("508 (Woos)" . 508)
+    ("256 (Test Grade)" . 256)
+    )
+  "An assoc list of available key sizes and meaningful descriptions.")
+   
+(defun w3-form-create-keygen-list (el face)
+  (let ((tmp w3-form-valid-key-sizes)
+	(longest 0)
+	(options nil))
+    (while tmp
+      (if (> (length (caar tmp)) longest)
+	  (setq longest (length (caar tmp))))
+      (setq options (cons (list 'choice-item :tag (caar tmp)
+				:value (cdar tmp)) options)
+	    tmp (cdr tmp)))
+    (apply 'widget-create 'choice :value 1024
+	   :tag "Key Length"
+	   :size (1+ longest)
+	   :value-face face
+	   options)))
+
+(defun w3-form-create-option-list (el face)
+  (let ((widget (apply 'widget-create 'choice :value (w3-form-element-value el)
+		       :tag "Choose"
+		       :size (w3-form-element-size el)
+		       :value-face face
+		       (mapcar
+			(function
+			 (lambda (x)
+			   (list 'choice-item :format "%[%t%]"
+				 :tag (car x) :value (cdr x))))
+			(reverse (w3-form-element-options el))))))
+    (widget-value-set widget (cdr-safe (assoc (w3-form-element-value el)
+					      (w3-form-element-options el))))
+    (goto-char (point-max))
+    (skip-chars-backward "\r\n")
+    (delete-region (point) (point-max))
+    widget))
+
+;(defun w3-form-create-multiline (el face)
+;  ;; FIX THIS! - need to padd out with newlines or something...
+;  (widget-create 'field :value-face face (w3-form-element-value el)))
+
+(defun w3-form-create-multiline (el face)
+  (widget-create 'push :notify 'w3-do-text-entry "Multiline text area"))
+
+(defun w3-form-default-widget-creator (el face)
+  (widget-create 'link
+		 :notify 'w3-form-default-button-callback
+		 :size (w3-form-element-size el)
+		 :tag (w3-truncate-string (w3-form-element-value el)
+					  (w3-form-element-size el) ?_)
+		 :value-face face
+		 (w3-form-element-value el)))
+
+(defun w3-form-default-button-callback (widget &rest ignore)
+  (let* ((obj (widget-get widget 'w3-form-data))
+	 (typ (w3-form-element-type obj))
+	 (def (widget-value widget))
+	 (val nil)
+	 )
+    (case typ
+      (password
+       (setq val (funcall url-passwd-entry-func "Password: " def))
+       (widget-put widget :tag (w3-truncate-string
+				(make-string (length val) ?*)
+				(w3-form-element-size obj) ?_)))
+      (otherwise
+       (setq val (read-string
+		  (concat (capitalize (symbol-name typ)) ": ") def))
+       (widget-put widget :tag (w3-truncate-string
+				val (w3-form-element-size obj) ?_))))
+    (widget-value-set widget val))
+  (apply 'w3-form-possibly-submit widget ignore))
+
+(defun w3-truncate-string (str len &optional pad)
+  "Truncate string STR so that string-width of STR is not greater than LEN.
+ If width of the truncated string is less than LEN, and if a character PAD is
+ defined, add padding end of it."
+  (if (featurep 'mule)
+      (let ((cl (string-to-char-list str)) (n 0) (sw 0))
+ 	(if (<= (string-width str) len) str
+ 	  (while (<= (setq sw (+ (char-width (nth n cl)) sw)) len)
+ 	    (setq n (1+ n)))
+ 	  (string-match (make-string n ?.) str)
+ 	  (setq str (substring str 0 (match-end 0))))
+ 	(if pad (concat str (make-string (- len (string-width str)) pad)) str))
+    (concat (if (> (length str) len) (substring str 0 len) str)
+ 	    (if (or (null pad) (> (length str) len))
+ 		""
+ 	      (make-string (- len (length str)) pad)))))
+
+(defun w3-form-possibly-submit (widget &rest ignore)
+  (let* ((formobj (widget-get widget 'w3-form-data))
+	 (ident (w3-form-element-action formobj))
+	 (widgets (w3-all-widgets ident))
+	 (text-fields 0)
+	 (text-p nil))
+    ;;
+    ;; Gack.  Netscape auto-submits forms of one text field
+    ;; here we go through the list of widgets in this form and
+    ;; determine which are not submit/reset/button inputs.
+    ;; If the # == 1, then submit the form.
+    ;;
+    (while widgets
+      (setq text-fields (+
+			 text-fields
+			 (case (w3-form-element-type (car widgets))
+			   ((submit reset image button)
+			    0)
+			   (text
+			    (setq text-p t)
+			    1)
+			   (otherwise
+			    1)))
+	    widgets (cdr widgets)))
+    (if (and (= text-fields 1) text-p)
+	(w3-submit-form ident))))
+
+(defun w3-form-submit/reset-callback (widget &rest ignore)
+  (let* ((formobj (widget-get widget 'w3-form-data))
+	 (w3-submit-button formobj))
+    (case (w3-form-element-type formobj)
+      (submit (w3-submit-form (w3-form-element-action formobj)))
+      (reset  (w3-revert-form (w3-form-element-action formobj)))
+      (image  (w3-submit-form (w3-form-element-action formobj)))
+      (otherwise
+       (error
+	"Impossible widget type %s triggered w3-form-submit/reset-callback"
+	(w3-form-element-type formobj))))))
+
+(defun w3-do-text-entry (widget &rest ignore)
+  (let* ((data (list widget (current-buffer)))
+	 (formobj (widget-get widget 'w3-form-data))
+	 (buff (get-buffer-create (format "Form Entry: %s"
+					  (w3-form-element-name formobj)))))
+    (switch-to-buffer-other-window buff)
+    (indented-text-mode)
+    (erase-buffer)
+    (if (w3-form-element-value formobj)
+	(insert (w3-form-element-value formobj)))
+    (setq w3-current-last-buffer data)
+    (message "Press C-c C-c when finished with text entry.")
+    (local-set-key "\C-c\C-c" 'w3-finish-text-entry)))
+
+(defun w3-finish-text-entry ()
+  (interactive)
+  (if w3-current-last-buffer
+      (let* ((widget (nth 0 w3-current-last-buffer))
+	     (formobj (widget-get widget 'w3-form-data))
+	     (buff (nth 1 w3-current-last-buffer))
+	     (valu (buffer-string))
+	     (inhibit-read-only t)
+	     )
+	(local-set-key "\C-c\C-c" 'undefined)
+	(kill-buffer (current-buffer))
+	(condition-case ()
+	    (delete-window)
+	  (error nil))
+	(if (not (and buff (bufferp buff) (buffer-name buff)))
+	    (message "Could not find the form buffer for this text!")
+	  (switch-to-buffer buff)
+	  (w3-form-element-set-value formobj valu)))))
+
+(defsubst w3-all-widgets (actn)
+  ;; Return a list of data entry widgets in form number ACTN
+  (cdr-safe (assoc actn w3-form-elements)))
+
+(defun w3-revert-form (actn)
+  (save-excursion
+    (let* ((formobjs (w3-all-widgets actn))
+	   (inhibit-read-only t)
+	   deft type widget formobj)
+      (while formobjs
+	(setq formobj (car formobjs)
+	      widget (w3-form-element-widget formobj)
+	      formobjs (cdr formobjs)
+	      deft (w3-form-element-default-value formobj)
+	      type (w3-form-element-type formobj))
+	(case type
+	  ((submit reset image) nil)
+	  (radio
+	   ;; Ack - how!?
+	   )
+	  (checkbox
+	   (if deft
+	       (widget-value-set widget t)
+	     (widget-value-set widget nil)))
+	  (file
+	   (widget-value-set widget deft))
+	  (otherwise
+	   (widget-value-set widget deft)))))))
+
+(defun w3-form-encode-helper (formobjs)
+  (let (
+	(submit-button-data w3-submit-button)
+	formobj result widget temp type)
+    (while formobjs
+      (setq formobj (car formobjs)
+	    type (w3-form-element-type formobj)
+	    widget (w3-form-element-widget formobj)
+	    formobjs (cdr formobjs)
+	    temp (case type
+		   (reset nil)
+		   (image
+		    (if (and (eq submit-button-data formobj)
+			     (w3-form-element-name formobj))
+			(setq result (append
+				      (list
+				       (cons
+					(concat (w3-form-element-name formobj)
+						".x") "0")
+				       (cons
+					(concat (w3-form-element-name formobj)
+						".y") "0"))
+				      result)))
+		    nil)
+		   (submit
+		    (if (and (eq submit-button-data formobj)
+			     (w3-form-element-name formobj))
+			(cons (w3-form-element-name formobj)
+			      (w3-form-element-value formobj))))
+		   (radio
+		    ;; this is probably broken
+		    (let ((x (widget-radio-chosen widget)))
+		      (if (or (not x)
+			      (not (eq x (w3-form-element-widget formobj))))
+			  nil
+			(cons (w3-form-element-name formobj)
+			      (w3-form-element-value formobj)))))
+		   (checkbox
+		    (if (widget-value widget)
+			(cons (w3-form-element-name formobj)
+			      (w3-form-element-value formobj))))
+		   (file
+		    (let ((dat nil)
+			  (fname (widget-value widget)))
+		      (save-excursion
+			(set-buffer (get-buffer-create " *w3-temp*"))
+			(erase-buffer)
+			(setq dat
+			      (condition-case ()
+				  (insert-file-contents-literally fname)
+				(error (concat "Error accessing " fname))))
+			(cons (w3-form-element-name formobj) dat))))
+		   (option
+		    (cons (w3-form-element-name formobj)
+			  (widget-value widget)))
+		   (keygen
+		    (cons (w3-form-element-name formobj)
+			  (format "Should create a %d bit RSA key"
+				  (widget-value widget))))
+		   ((multiline hidden)
+		    (cons (w3-form-element-name formobj)
+			  (w3-form-element-value formobj)))
+		   (otherwise
+		    (cons (w3-form-element-name formobj)
+			  (widget-value widget)))))
+      (if temp
+	  (setq result (cons temp result))))
+    result))
+
+(defun w3-form-encode-make-mime-part (id data separator)
+  (concat separator "\nContent-id: " id
+	  "\nContent-length: " (length data)
+	  "\n\n" data))
+
+(defun w3-form-encode-multipart/x-www-form-data (formobjs)
+  ;; Create a multipart form submission.
+  ;; Returns a cons of two strings.  Car is the separator used.
+  ;; cdr is the body of the MIME message."
+  (let ((separator "---some-separator-for-www-form-data"))
+    (cons separator
+	  (mapconcat
+	   (function
+	    (lambda (formobj)
+	      (w3-form-encode-make-mime-part (car formobj) (cdr formobj)
+					     separator)))
+	   (w3-form-encode-helper formobjs)
+	   "\n"))))
+
+(fset 'w3-form-encode-multipart/form-data
+      'w3-form-encode-multipart/x-www-form-data)
+(fset 'w3-form-encode- 'w3-form-encode-application/x-www-form-urlencoded)
+
+(defun w3-next-widget (pos)
+  (let* ((next (cond ((get-text-property pos 'button)
+		      (next-single-property-change pos 'button))
+		     ((get-text-property pos 'field)
+		      (next-single-property-change pos 'field))
+		     (t pos)))
+	 (button (next-single-property-change next 'button))
+	 (field  (next-single-property-change next 'field)))
+    (setq next
+	  (cond
+	   ((and button field) (min button field))
+	   (button button)
+	   (field field)
+	   (t nil)))
+    (and next
+	 (or (get-text-property next 'button)
+	     (get-text-property next 'field)))))
+
+(defun w3-form-encode (result &optional enctype)
+  "Create a string suitably encoded for a URL request."
+  (let ((func (intern (concat "w3-form-encode-" enctype))))
+    (if (fboundp func) (funcall func result))))
+
+(defun w3-form-encode-text/plain (result)
+  (let ((query ""))
+    (setq query
+	  (mapconcat
+	   (function
+	    (lambda (widget)
+	      (let ((nam (car widget))
+		    (val (cdr widget)))
+		(if (string-match "\n" nam)
+		    (setq nam (mapconcat
+			       (function
+				(lambda (x)
+				  (if (= x ?\n) "," (char-to-string x))))
+			       nam "")))
+		(concat nam " " val))))
+	   (w3-form-encode-helper result) "\n"))
+    query))
+
+(defun w3-form-encode-application/x-gopher-query (result)
+  (concat "\t" (nth 5 (car result))))
+
+(defconst w3-xwfu-acceptable-chars
+ (list
+  ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
+  ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
+  ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+  ?_;; BOGUS!  This is for #!%#@!ing netscape compatibility
+  )
+  "A list of characters that we do not have to escape in the media type
+application/x-www/form-urlencoded")
+   
+(defun w3-form-encode-xwfu (chunk)
+  "Escape characters in a string for application/x-www-form-urlencoded.
+Blasphemous crap because someone didn't think %20 was good enough for encoding
+spaces.  Die Die Die."
+  (if (and (featurep 'mule) chunk)
+      (setq chunk (code-convert-string 
+		   chunk *internal* url-mule-retrieval-coding-system)))
+  (mapconcat
+   (function
+    (lambda (char)
+      (cond
+       ((= char ?  ) "+")
+       ((memq char w3-xwfu-acceptable-chars) (char-to-string char))
+       (t (format "%%%02x" char)))))
+   chunk ""))
+
+(defun w3-form-encode-application/x-www-form-urlencoded (result)
+  (mapconcat
+   (function
+    (lambda (data)
+      (concat (w3-form-encode-xwfu (car data)) "="
+	      (w3-form-encode-xwfu (cdr data)))))
+   (w3-form-encode-helper result) "&"))
+
+(defun w3-form-encode-application/x-w3-isindex (result)
+  (let* ((info (w3-form-encode-helper result))
+	 (query (cdr-safe (assoc "isindex" info))))
+    (if query
+	(url-hexify-string query)
+      "")))
+
+(defun w3-form-encode-application/gopher-ask-block (result)
+  (let ((query ""))
+    ;;; gopher+ will expect all the checkboxes/etc, even if they are
+    ;;; not turned on.  Should still ignore RADIO boxes that are not
+    ;;; active though.
+  (while result
+    (if (and (not (and (string= (nth 2 (car result)) "RADIO")
+		       (not (nth 6 (car result)))))
+	     (not (member (nth 2 (car result)) '("SUBMIT" "RESET"))))
+	(setq query (format "%s\r\n%s" query (nth 5 (car result)))))
+    (setq result (cdr result)))
+  (concat query "\r\n.\r\n")))
+
+(defun w3-submit-form (ident)
+  ;; Submit form entry fields matching ACTN as their action identifier.
+  (let* ((result (w3-all-widgets ident))
+	 (enctype (cdr (assq 'enctype ident)))
+	 (query (w3-form-encode result enctype))
+	 (themeth (upcase (or (cdr (assq 'method ident)) "get")))
+	 (theurl (cdr (assq 'action ident))))
+    (if (and (string= "GET" themeth)
+	     (string-match "\\([^\\?]*\\)\\?" theurl))
+	(setq theurl (url-match theurl 1)))
+    (cond
+     ((or (string= "POST" themeth)
+	  (string= "PUT" themeth))
+      (if (consp query)
+	  (setq enctype (concat enctype "; separator=\""
+				(substring (car query) 3 nil)
+				"\"")
+		query (cdr query)))
+      (let ((url-request-method themeth)
+	    (url-request-data query)
+	    (url-request-extra-headers
+	     (cons (cons "Content-type" enctype) url-request-extra-headers)))
+	(w3-fetch theurl)))
+     ((string= "GET" themeth)
+      (let ((theurl (concat theurl "?" query)))
+	(w3-fetch theurl)))
+     (t
+      (w3-warn 'html (format "Unknown submit method: %s" themeth))
+      (let ((theurl (concat theurl "?" query)))
+	(w3-fetch theurl))))))
+
+(provide 'w3-forms)