cgit.sxemacs.org Git - packages/blob - xemacs-packages/w3/lisp/w3-forms.el

   1 ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine
   2 ;; Author: $Author: wmperry $
   3 ;; Created: $Date: 2002/10/23 03:33:41 $
   4 ;; Version: $Revision: 1.11 $
   5 ;; Keywords: faces, help, comm, data, languages
   6
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;; Copyright (c) 1996 - 1999, 2008 Free Software Foundation, Inc.
   9 ;;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
  10 ;;;
  11 ;;; This file is part of GNU Emacs.
  12 ;;;
  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
  15 ;;; the Free Software Foundation; either version 2, or (at your option)
  16 ;;; any later version.
  17 ;;;
  18 ;;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;; GNU General Public License for more details.
  22 ;;;
  23 ;;; You should have received a copy of the GNU General Public License
  24 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;;; Boston, MA 02111-1307, USA.
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 ;;; FORMS processing for HTML
  31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32 (eval-when-compile
  33   (require 'cl))
  34
  35 (eval-and-compile
  36   (require 'w3-mouse)
  37   (require 'w3-display)
  38   (require 'url)
  39 ;  (require 'url-util)
  40   (require 'widget)
  41   (require 'wid-edit))
  42
  43 (require 'w3-vars)
  44 (autoload 'custom-magic-reset "cus-edit")
  45 (autoload 'w3-warn "w3")
  46
  47 (defvar w3-form-use-old-style nil
  48   "*Non-nil means use the old way of interacting for form fields.")
  49
  50 (defvar w3-form-keymap
  51   ;; Fixme: Why doesn't this use inheritance?  -- fx
  52   (let ((map (copy-keymap global-map))
  53         (eol-loc (where-is-internal 'end-of-line global-map t)))
  54     (substitute-key-definition 'widget-backward 'w3-widget-backward
  55                                map widget-keymap)
  56     (substitute-key-definition 'widget-forward 'w3-widget-forward
  57                                map widget-keymap)
  58     (define-key map [return]      'w3-form-maybe-submit-by-keypress)
  59     (define-key map "\r"          'w3-form-maybe-submit-by-keypress)
  60     (define-key map "\n"          'w3-form-maybe-submit-by-keypress)
  61     (define-key map "\t"          'w3-widget-forward)
  62     (define-key map "\C-k"        'widget-kill-line)
  63     (define-key map "\C-a"        'widget-beginning-of-line)
  64     (define-key map (vector w3-mouse-button3) 'w3-popup-menu)
  65     (if eol-loc
  66         (define-key map eol-loc   'widget-end-of-line))
  67     map))
  68
  69 ;; A form entry area is a vector
  70 ;; [ type name default-value value maxlength options widget plist]
  71 ;; Where:
  72 ;;          type = symbol defining what type of form entry area it is
  73 ;;                 (ie: file, radio)
  74 ;;          name = the name of the form element
  75 ;; default-value = the value this started out with
  76
  77 (defsubst w3-form-element-type          (obj) (aref obj 0))
  78 (defsubst w3-form-element-name          (obj) (aref obj 1))
  79 (defsubst w3-form-element-default-value (obj) (aref obj 2))
  80 (defsubst w3-form-element-value         (obj) (aref obj 3))
  81 (defsubst w3-form-element-size          (obj) (aref obj 4))
  82 (defsubst w3-form-element-maxlength     (obj) (aref obj 5))
  83 (defsubst w3-form-element-options       (obj) (aref obj 6))
  84 (defsubst w3-form-element-action        (obj) (aref obj 7))
  85 (defsubst w3-form-element-widget        (obj) (aref obj 8))
  86 (defsubst w3-form-element-plist         (obj) (aref obj 9))
  87
  88 (defsubst w3-form-element-set-type          (obj val) (aset obj 0 val))
  89 (defsubst w3-form-element-set-name          (obj val) (aset obj 1 val))
  90 (defsubst w3-form-element-set-default-value (obj val) (aset obj 2 val))
  91 (defsubst w3-form-element-set-value         (obj val) (aset obj 3 val))
  92 (defsubst w3-form-element-set-size          (obj val) (aset obj 4 val))
  93 (defsubst w3-form-element-set-maxlength     (obj val) (aset obj 5 val))
  94 (defsubst w3-form-element-set-options       (obj val) (aset obj 6 val))
  95 (defsubst w3-form-element-set-action        (obj val) (aset obj 7 val))
  96 (defsubst w3-form-element-set-widget        (obj val) (aset obj 8 val))
  97 (defsubst w3-form-element-set-plist         (obj val) (aset obj 9 val))
  98
  99 (defvar w3-form-valid-key-sizes
 100   '(
 101     ("1024 (Premium)" . 1024)
 102     ("896 (Regular)" . 896)
 103     ("768 (Unleaded)" . 768)
 104     ("512 (Low Grade)" . 512)
 105     ("508 (Woos)" . 508)
 106     ("256 (Test Grade)" . 256)
 107     )
 108   "An assoc list of available key sizes and meaningful descriptions.")
 109
 110 (defun w3-form-determine-size (el size)
 111   (if (equal size 0)
 112       (setq size nil))
 113   (case (w3-form-element-type el)
 114     (checkbox 3)
 115     (radio 4)
 116     ((reset submit) (+ 2 (length (or (w3-form-element-value el)
 117                                      (symbol-name
 118                                       (w3-form-element-type el))))))
 119     (multiline 21)
 120     (hidden nil)
 121     (file (or size 26))
 122     ((float password text int)
 123      (if w3-form-use-old-style
 124          (+ 2 (or size 20))
 125        (1+ (or size 19))))
 126     (image (+ 2 (length (or
 127                          (plist-get (w3-form-element-plist el) 'alt)
 128                          "Form-Image"))))
 129     (option
 130      (let ((options (copy-sequence (w3-form-element-options el))))
 131        (length (caar (sort options
 132                            (function
 133                             (lambda (x y)
 134                               (>= (length (car x))
 135                                   (length (car y))))))))))
 136     (keygen
 137      (+ (length "Key Length: ")
 138         (apply 'max
 139                (mapcar (function (lambda (pair)
 140                                    (length (car pair))))
 141                        w3-form-valid-key-sizes))))
 142     (otherwise (or size 22))))
 143
 144 ;;;###autoload
 145 (defun w3-form-add-element (plist face)
 146   (let* ((action (plist-get plist 'action))
 147          (el (vector (plist-get plist 'type)
 148                      (plist-get plist 'name)
 149                      (plist-get plist 'default)
 150                      (plist-get plist 'value)
 151                      (plist-get plist 'size)
 152                      (plist-get plist 'maxlength)
 153                      (plist-get plist 'options)
 154                      action
 155                      nil
 156                      plist))
 157          (size (w3-form-determine-size el (plist-get plist 'size)))
 158          (node (assoc action w3-form-elements)))
 159     (if (not (assq '*table-autolayout w3-display-open-element-stack))
 160         (if node
 161             (setcdr node (cons el (cdr node)))
 162           (setq w3-form-elements (cons (cons action (list el))
 163                                        w3-form-elements))))
 164     (if size
 165         (set-text-properties (point)
 166                              (progn (insert-char ?T size) (point))
 167                              (list 'w3-form-info (cons el face)
 168                                    'start-open t
 169                                    'end-open t
 170                                    'rear-nonsticky t)))))
 171
 172 ;;;###autoload
 173 (defun w3-form-resurrect-widgets ()
 174   (let ((st (point-min))
 175         ;; FIXME! For some reason this loses on long lines right now.
 176         (widget-push-button-gui nil)
 177         info nd node action face)
 178     (while st
 179       (if (setq info (get-text-property st 'w3-form-info))
 180           (progn
 181             (setq nd (or (next-single-property-change st 'w3-form-info)
 182                          (point-max))
 183                   face (cdr info)
 184                   info (car info)
 185                   action (w3-form-element-action info)
 186                   node (assoc action w3-form-elements))
 187             (goto-char st)
 188             (delete-region st nd)
 189             (if (not (w3-form-element-size info))
 190                 (w3-form-element-set-size info 20))
 191             (w3-form-add-element-internal info face)
 192             (setq st (next-single-property-change st 'w3-form-info)))
 193         (setq st (next-single-property-change st 'w3-form-info))))))
 194
 195 (defsubst w3-form-mark-widget (widget el)
 196   (let ((widgets (list widget))
 197         (children (widget-get widget :children))
 198         (parent (widget-get widget :parent)))
 199     (w3-form-element-set-widget el widget)
 200     ;; Get _all_ the children associated with this widget
 201     (while children
 202       (setq widgets (cons (car children) widgets))
 203       (if (widget-get (car children) :children)
 204           (setq children (append children
 205                                  (widget-get (car children) :children))))
 206       (setq children (cdr children)))
 207     (while (widget-get widget :parent)
 208       (setq widget (widget-get widget :parent)
 209             widgets (cons widget widgets)))
 210     (setq children (widget-get widget :buttons))
 211     ;; Special case for radio buttons
 212     (while children
 213       (setq widgets (cons (car children) widgets))
 214       (if (widget-get (car children) :children)
 215           (setq children (append children
 216                                  (widget-get (car children) :children))))
 217       (setq children (cdr children)))
 218     (while widgets
 219       (setq widget (pop widgets))
 220       (widget-put widget :emacspeak-help 'w3-form-summarize-field)
 221       (widget-put widget :help-echo 'w3-form-summarize-field)
 222       (widget-put widget :w3-form-data el))))
 223
 224 (defun w3-form-add-element-internal (el face)
 225   (let* ((widget nil)
 226          (buffer-read-only nil)
 227          (inhibit-read-only t)
 228          (widget-creation-function nil))
 229     (setq widget-creation-function (or (get (w3-form-element-type el)
 230                                             'w3-widget-creation-function)
 231                                        'w3-form-default-widget-creator)
 232           widget (and (fboundp widget-creation-function)
 233                       (funcall widget-creation-function el face)))
 234     (if (not widget)
 235         nil
 236       (w3-form-mark-widget widget el))))
 237
 238 ;; These properties tell the add-element function how to actually create
 239 ;; each type of widget.
 240 (put 'checkbox  'w3-widget-creation-function 'w3-form-create-checkbox)
 241 (put 'multiline 'w3-widget-creation-function 'w3-form-create-multiline)
 242 (put 'radio     'w3-widget-creation-function 'w3-form-create-radio-button)
 243 (put 'reset     'w3-widget-creation-function 'w3-form-create-submit-button)
 244 (put 'submit    'w3-widget-creation-function 'w3-form-create-submit-button)
 245 (put 'hidden    'w3-widget-creation-function 'ignore)
 246 (put 'file      'w3-widget-creation-function 'w3-form-create-file-browser)
 247 (put 'option    'w3-widget-creation-function 'w3-form-create-option-list)
 248 (put 'keygen    'w3-widget-creation-function 'w3-form-create-keygen-list)
 249 (put 'button    'w3-widget-creation-function 'w3-form-create-button)
 250 (put 'image     'w3-widget-creation-function 'w3-form-create-image)
 251 (put 'int       'w3-widget-creation-function 'w3-form-create-integer)
 252 (put 'float     'w3-widget-creation-function 'w3-form-create-float)
 253 (put 'custom    'w3-widget-creation-function 'w3-form-create-custom)
 254 (put 'text      'w3-widget-creation-function 'w3-form-create-text)
 255 (put 'password  'w3-widget-creation-function 'w3-form-create-password)
 256
 257 ;; Custom support.
 258 (defvar w3-custom-options nil)
 259 (make-variable-buffer-local 'w3-custom-options)
 260
 261 (defun w3-form-create-custom (el face)
 262       (require 'cus-edit)
 263   (let* ((name (w3-form-element-name el))
 264          (var-name (w3-form-element-value el))
 265          (type (plist-get (w3-form-element-plist el) 'custom-type))
 266          (widget (widget-create (cond ((string-equal type "variable")
 267                                        'custom-variable)
 268                                       ((string-equal type "face")
 269                                        'custom-face)
 270                                       ((string-equal type "group")
 271                                        'custom-group)
 272                                       (t 'item)) (intern var-name))))
 273     (custom-magic-reset widget)
 274     (push widget w3-custom-options)
 275     widget))
 276
 277 (defun w3-form-create-checkbox (el face)
 278   (widget-create 'checkbox
 279                  :button-face face
 280                  (and (w3-form-element-default-value el) t)))
 281
 282 (defun w3-form-radio-button-update (widget child event)
 283   (widget-radio-action widget child event)
 284   (w3-form-mark-widget widget (widget-get widget :w3-form-data)))
 285
 286 (defun w3-form-create-radio-button (el face)
 287   (let* ((name (w3-form-element-name el))
 288          (action (w3-form-element-action el))
 289          (uniqid (cons name action))
 290          (formobj (cdr (assoc uniqid w3-form-radio-elements)))
 291          (widget nil)
 292          )
 293     (if formobj
 294         (progn
 295           (setq widget (w3-form-element-widget formobj))
 296           (widget-radio-add-item widget
 297                                  (list 'item
 298                                        :button-face face
 299                                        :format "%t"
 300                                        :tag ""
 301                                        :value (w3-form-element-value el)))
 302           (w3-form-mark-widget widget el)
 303           (if (w3-form-element-default-value el)
 304               (progn
 305                 (widget-put widget 'w3-form-default-value
 306                             (w3-form-element-value el))
 307                 (widget-value-set widget (w3-form-element-value el))))
 308           nil)
 309       (setq widget (widget-create
 310                     'radio-button-choice
 311                     :value (w3-form-element-value el)
 312                     :action 'w3-form-radio-button-update
 313                     (list 'item
 314                           :button-face face
 315                           :format "%t"
 316                           :tag ""
 317                           :value (w3-form-element-value el)))
 318             w3-form-radio-elements (cons (cons uniqid el)
 319                                          w3-form-radio-elements))
 320       (widget-put widget 'w3-form-default-value (w3-form-element-value el))
 321       widget)))
 322
 323 (defun w3-form-create-button (el face)
 324   ;; This handles dealing with the bogus Netscape 'button' input type
 325   ;; that lots of places have been using to slap javascript shit onto
 326   (let ((val (w3-form-element-value el)))
 327     (if (or (not val) (string= val ""))
 328         (setq val "Push Me"))
 329     (widget-create 'push-button
 330                    :notify 'ignore
 331                    :button-face face
 332                    :value-face face
 333                    val)))
 334
 335 (defun w3-form-create-image (el face)
 336   (widget-create 'push-button
 337                  :button-face face
 338                  :value-face face
 339                  :notify 'w3-form-submit/reset-callback
 340                  :value (or
 341                          (plist-get (w3-form-element-plist el) 'alt)
 342                          ;; Can it have a value other than "" anyway?
 343                          ;; w3-form-determine-size does not even bother
 344                          ;; to check the value.
 345                          (let ((val (w3-form-element-value el)))
 346                            (and val
 347                                 (stringp val)
 348                                 (not (zerop (length val)))
 349                                 val))
 350                          "Form-Image")))
 351
 352 (defun w3-form-create-submit-button (el face)
 353   (let ((val (w3-form-element-value el)))
 354     (if (or (not val) (string= val ""))
 355         (setq val (if (eq (w3-form-element-type el) 'submit)
 356                       "Submit"
 357                     "Reset")))
 358     (widget-create 'push-button
 359                    :notify 'w3-form-submit/reset-callback
 360                    :button-face face val)))
 361
 362 (defun w3-form-create-file-browser (el face)
 363   (widget-create 'file
 364                  :button-face face
 365                  :value-face face
 366                  :size (w3-form-element-size el)
 367                  :must-match t
 368                  :value (w3-form-element-value el)))
 369
 370 (defun w3-form-create-keygen-list (el face)
 371   (let* ((size (apply 'max (mapcar (lambda (pair) (length (car pair)))
 372                                    w3-form-valid-key-sizes)))
 373          (options (mapcar (lambda (pair)
 374                                       (list 'choice-item
 375                                             :format "%[%t%]"
 376                                             :tab-order -1
 377                                             :button-face face
 378                                             :value-face face
 379                                             :menu-tag-get `(lambda (zed) ,(car pair))
 380                                   :tag (truncate-string-to-width (car pair)
 381                                                                  size nil ? )
 382                                   :value (cdr pair)))
 383                           w3-form-valid-key-sizes)))
 384     (apply 'widget-create 'menu-choice
 385            :emacspeak-help 'w3-form-summarize-field
 386            :value 1024
 387            :ignore-case t
 388            :tag "Key Length"
 389            :size size
 390            :button-face face
 391            :value-face face
 392            options)))
 393
 394 (defun w3-form-create-option-list (el face)
 395   (let* ((size (w3-form-determine-size el nil))
 396          (widget (apply 'widget-create 'menu-choice
 397                        :value (w3-form-element-value el)
 398                        :ignore-case t
 399                        :tag "Choose"
 400                        :format "%v"
 401                        :size size
 402                        :value-face face
 403                        :button-face face
 404                        (mapcar
 405                         (function
 406                          (lambda (x)
 407                            (list 'choice-item
 408                                  :format "%[%t%]"
 409                                  :emacspeak-help 'w3-form-summarize-field
 410                                  :menu-tag-get `(lambda (zed) ,(car x))
 411                                  :tag (truncate-string-to-width (car x)
 412                                                                 size nil ? )
 413                                  :button-face face
 414                                  :value-face face
 415                                  :value (car x))))
 416                         (w3-form-element-options el)))))
 417     (widget-value-set widget (w3-form-element-value el))
 418     widget))
 419
 420 ;(defun w3-form-create-multiline (el face)
 421 ;  (widget-create 'text :value-face face (w3-form-element-value el)))
 422
 423 (defun w3-form-create-multiline (el face)
 424   (widget-create 'push-button
 425                  :button-face face
 426                  :notify 'w3-do-text-entry
 427                  "Multiline text area"))
 428
 429 (defun w3-form-create-integer (el face)
 430   (if w3-form-use-old-style
 431       (w3-form-default-widget-creator el face)
 432     (widget-create 'integer
 433                    :size (w3-form-element-size el)
 434                    :value-face face
 435                    :tag ""
 436                    :format "%v"
 437                    :keymap w3-form-keymap
 438                    :w3-form-data el
 439                    (w3-form-element-value el))))
 440
 441 (defun w3-form-create-float (el face)
 442   (if w3-form-use-old-style
 443       (w3-form-default-widget-creator el face)
 444     (widget-create 'number
 445                    :size (w3-form-element-size el)
 446                    :value-face face
 447                    :format "%v"
 448                    :tag ""
 449                    :keymap w3-form-keymap
 450                    :w3-form-data el
 451                    (w3-form-element-value el))))
 452
 453 (defun w3-form-create-text (el face)
 454   (if w3-form-use-old-style
 455       (w3-form-default-widget-creator el face)
 456     (widget-create 'editable-field
 457                    :keymap w3-form-keymap
 458                    :size (w3-form-element-size el)
 459                    :value-face face
 460                    :w3-form-data el
 461                    (w3-form-element-value el))))
 462
 463 (defun w3-form-create-password (el face)
 464   ;; *sigh*  This will fail under XEmacs, but I can yell at them about
 465   ;; upgrading separately for the release of 19.15 and 20.0
 466   (if w3-form-use-old-style
 467       (w3-form-default-widget-creator el face)
 468     (widget-create 'editable-field
 469                    :secret ?*
 470                    :keymap w3-form-keymap
 471                    :size (w3-form-element-size el)
 472                    :value-face face
 473                    :button-face face
 474                    :w3-form-data el
 475                    (w3-form-element-value el))))
 476
 477 (defun w3-form-default-widget-creator (el face)
 478   (widget-create 'link
 479                  :notify 'w3-form-default-button-callback
 480                  :value-to-internal 'w3-form-default-button-update
 481                  :size (w3-form-element-size el)
 482                  :value-face face
 483                  :button-face face
 484                  :w3-form-data el
 485                  (w3-form-element-value el)))
 486
 487 (defun w3-form-default-button-update (w v)
 488   (let ((info (widget-get w :w3-form-data)))
 489     (widget-put w :tag
 490                 (if info
 491                     (truncate-string-to-width
 492                      (if (eq 'password (w3-form-element-type info))
 493                          (make-string (length v) ?*)
 494                        v)
 495                      (w3-form-element-size info) nil ? )))
 496     v))
 497
 498 (defun w3-form-default-button-callback (widget &rest ignore)
 499   (let* ((obj (widget-get widget :w3-form-data))
 500          (typ (w3-form-element-type obj))
 501          (def (widget-value widget))
 502          (val nil)
 503          )
 504     (case typ
 505       (password
 506        (setq val (funcall url-passwd-entry-func "Password: " def)))
 507       (otherwise
 508        (setq val (read-string
 509                   (concat (capitalize (symbol-name typ)) ": ") def))))
 510     (widget-value-set widget val))
 511   (apply 'w3-form-possibly-submit widget ignore))
 512 \f
 513 ;; These properties tell the help-echo function how to summarize each
 514 ;; type of widget.
 515 (put 'checkbox  'w3-summarize-function 'w3-form-summarize-checkbox)
 516 (put 'multiline 'w3-summarize-function 'w3-form-summarize-multiline)
 517 (put 'radio     'w3-summarize-function 'w3-form-summarize-radio-button)
 518 (put 'reset     'w3-summarize-function 'w3-form-summarize-submit-button)
 519 (put 'submit    'w3-summarize-function 'w3-form-summarize-submit-button)
 520 (put 'button    'w3-summarize-function 'w3-form-summarize-submit-button)
 521 (put 'file      'w3-summarize-function 'w3-form-summarize-file-browser)
 522 (put 'option    'w3-summarize-function 'w3-form-summarize-option-list)
 523 (put 'keygen    'w3-summarize-function 'w3-form-summarize-keygen-list)
 524 (put 'image     'w3-summarize-function 'w3-form-summarize-image)
 525 (put 'password  'w3-summarize-function 'w3-form-summarize-password)
 526 (put 'hidden    'w3-summarize-function 'ignore)
 527
 528 (defun w3-form-summarize-field (widget &rest ignore)
 529   "Sumarize a widget that should be a W3 form entry area.
 530 This can be used as the :help-echo property of all w3 form entry widgets."
 531   (let ((info nil)
 532         (func nil)
 533         (msg nil)
 534         )
 535     (setq info (widget-get widget :w3-form-data))
 536     (if info
 537         nil
 538       (while (widget-get widget :parent)
 539         (setq widget (widget-get widget :parent)))
 540       (setq info (widget-get widget :w3-form-data)))
 541     (if (not info)
 542         (signal 'wrong-type-argument (list 'w3-form-widget widget)))
 543     (setq func (or (get (w3-form-element-type info) 'w3-summarize-function)
 544                    'w3-form-summarize-default)
 545           msg (and (fboundp func) (funcall func info widget)))
 546     ;; FIXME!  This should be removed once emacspeak is updated to
 547     ;; more closely follow the widget-y way of just returning the string
 548     ;; instead of having the underlying :help-echo or :emacspeak-help
 549     ;; implementation do it.
 550     (and msg (message "%s" msg))))
 551
 552 (defsubst w3-form-field-label (data)
 553   ;;; FIXXX!!! Need to reimplement using the new forms implementation!
 554   (declare (special w3-form-labels))
 555   (cdr-safe
 556    (assoc (or (plist-get (w3-form-element-plist data) 'id)
 557               (plist-get (w3-form-element-plist data) 'label))
 558           w3-form-labels)))
 559
 560 (defun w3-form-summarize-default (data widget)
 561   (let ((label (w3-form-field-label data))
 562         (name  (w3-form-element-name data))
 563         (value (widget-value (w3-form-element-widget data))))
 564     (format "Text field %s set to: %s" (or label (concat "called " name))
 565             value)))
 566
 567 (defun w3-form-summarize-password (data widget)
 568   (let ((label (w3-form-field-label data))
 569         (name  (w3-form-element-name data)))
 570     (format "Password field %s is a secret.  Shhh."
 571             (or label (concat "called " name)))))
 572
 573 (defun w3-form-summarize-multiline (data widget)
 574   (let ((name (w3-form-element-name data))
 575         (label (w3-form-field-label data))
 576         (value (w3-form-element-value data)))
 577     (format "Multiline text input %s set to: %s"
 578             (or label (concat "called " name))
 579             value)))
 580
 581 (defun w3-form-summarize-checkbox (data widget)
 582   (let ((name (w3-form-element-name data))
 583         (label (w3-form-field-label data))
 584         (checked (widget-value (w3-form-element-widget data))))
 585     (format "Checkbox %s is %s" (or label name) (if checked "on" "off"))))
 586
 587 (defun w3-form-summarize-option-list (data widget)
 588   (let ((name (w3-form-element-name data))
 589         (label (w3-form-field-label data))
 590         (default (w3-form-element-default-value data)))
 591     (format "Option list (%s) set to: %s" (or label name)
 592             (widget-value (w3-form-element-widget data)))))
 593
 594 (defun w3-form-summarize-image (data widget)
 595   (let ((name (w3-form-element-name data))
 596         (label (w3-form-field-label data)))
 597     (concat "Image entry " (or label (concat "called " name)))))
 598
 599 (defun w3-form-summarize-submit-button (data widget)
 600   (let*  ((type (w3-form-element-type data))
 601           (label (w3-form-field-label data))
 602           (button-text (widget-value (w3-form-element-widget data)))
 603           (type-desc (case type
 604                        (submit "Submit Form")
 605                        (reset "Reset Form")
 606                        (button "A Button"))))
 607     (format "%s: %s" type-desc (or label button-text ""))))
 608
 609 (defun w3-form-summarize-radio-button (data widget)
 610   (let ((name (w3-form-element-name data))
 611         (label (w3-form-field-label data))
 612         (cur-value (widget-value (w3-form-element-widget data)))
 613         (this-value (widget-value (widget-get-sibling widget))))
 614     (if (equal this-value cur-value)
 615         (format "Radio group %s has  %s pressed"
 616                 (or label name) this-value)
 617       (format "Press this  to change radio group %s from %s to %s" (or label name) cur-value
 618               this-value))))
 619
 620 (defun w3-form-summarize-file-browser (data widget)
 621   (let ((name (w3-form-element-name data))
 622         (label (w3-form-field-label data))
 623         (file (widget-value (w3-form-element-widget data))))
 624     (format "File entry %s pointing to: %s" (or label name) (or file
 625                                                                 "[nothing]"))))
 626
 627 (defun w3-form-summarize-keygen-list (data widget)
 628   (format "Submitting this form will generate a %d bit key (not)"
 629           (widget-value (w3-form-element-widget data))))
 630 \f
 631 (defun w3-form-maybe-submit-by-keypress ()
 632   (interactive)
 633   (let ((widget (widget-at (point))))
 634     (if widget
 635         (w3-form-possibly-submit widget))))
 636
 637 (defsubst w3-all-widgets (actn)
 638   ;; Return a list of data entry widgets in form number ACTN
 639   (cdr-safe (assoc actn w3-form-elements)))
 640
 641 (defun w3-form-possibly-submit (widget &rest ignore)
 642   (let* ((formobj (widget-get widget :w3-form-data))
 643          (ident (w3-form-element-action formobj))
 644          (widgets (w3-all-widgets ident))
 645          (text-fields 0)
 646          (text-p nil))
 647     ;;
 648     ;; Gack.  Netscape auto-submits forms of one text field
 649     ;; here we go through the list of widgets in this form and
 650     ;; determine which are not submit/reset/button inputs.
 651     ;; If the # == 1, then submit the form.
 652     ;;
 653     (while widgets
 654       (setq text-fields (+
 655                          text-fields
 656                          (case (w3-form-element-type (car widgets))
 657                            ((submit reset image button)
 658                             0)
 659                            (text
 660                             (setq text-p t)
 661                             1)
 662                            (otherwise
 663                             1)))
 664             widgets (cdr widgets)))
 665     (if (and (= text-fields 1) text-p)
 666         (w3-submit-form ident))))
 667
 668 (defun w3-form-submit/reset-callback (widget &rest ignore)
 669   (let* ((formobj (widget-get widget :w3-form-data))
 670          (w3-submit-button formobj))
 671     (case (w3-form-element-type formobj)
 672       (submit (w3-submit-form (w3-form-element-action formobj)))
 673       (reset  (w3-revert-form (w3-form-element-action formobj)))
 674       (image  (w3-submit-form (w3-form-element-action formobj)))
 675       (otherwise
 676        (error
 677         "Impossible widget type %s triggered w3-form-submit/reset-callback"
 678         (w3-form-element-type formobj))))))
 679
 680 ;;;###autoload
 681 (defun w3-do-text-entry (widget &rest ignore)
 682   (let* ((data (list widget (current-buffer)))
 683          (formobj (widget-get widget :w3-form-data))
 684          (buff (get-buffer-create (format "Form Entry: %s"
 685                                           (w3-form-element-name formobj)))))
 686     (switch-to-buffer-other-window buff)
 687     (indented-text-mode)
 688     (erase-buffer)
 689     (if (w3-form-element-value formobj)
 690         (insert (w3-form-element-value formobj)))
 691     (setq w3-current-last-buffer data)
 692     (message "Press C-c C-c when finished with text entry.")
 693     (local-set-key "\C-c\C-c" 'w3-finish-text-entry)))
 694
 695 (defun w3-finish-text-entry ()
 696   (interactive)
 697   (if w3-current-last-buffer
 698       (let* ((widget (nth 0 w3-current-last-buffer))
 699              (formobj (widget-get widget :w3-form-data))
 700              (buff (nth 1 w3-current-last-buffer))
 701              (valu (buffer-string))
 702              (inhibit-read-only t)
 703              )
 704         (local-set-key "\C-c\C-c" 'undefined)
 705         (kill-buffer (current-buffer))
 706         (condition-case ()
 707             (delete-window)
 708           (error nil))
 709         (if (not (and buff (bufferp buff) (buffer-name buff)))
 710             (message "Could not find the form buffer for this text!")
 711           (switch-to-buffer buff)
 712           (w3-form-element-set-value formobj valu)))))
 713
 714 (defun w3-revert-form (actn)
 715   (save-excursion
 716     (let* ((formobjs (w3-all-widgets actn))
 717            (inhibit-read-only t)
 718            deft type widget formobj)
 719       (while formobjs
 720         (setq formobj (car formobjs)
 721               widget (w3-form-element-widget formobj)
 722               formobjs (cdr formobjs)
 723               deft (w3-form-element-default-value formobj)
 724               type (w3-form-element-type formobj))
 725         (case type
 726           ((submit reset image hidden) nil)
 727           (radio
 728            (setq deft (widget-get widget 'w3-form-default-value))
 729            (if (and widget deft)
 730                (widget-value-set widget deft)))
 731           (checkbox
 732            (if deft
 733                (widget-value-set widget t)
 734              (widget-value-set widget nil)))
 735           (multiline
 736            (w3-form-element-set-value formobj (w3-form-element-default-value
 737                                                formobj)))
 738           (file
 739            (widget-value-set widget deft))
 740           (otherwise
 741            (widget-value-set widget deft))))
 742       (widget-setup))))
 743
 744 (defun w3-form-encode-helper (formobjs)
 745   (let (
 746         (submit-button-data w3-submit-button)
 747         formobj result widget temp type)
 748     (while formobjs
 749       (setq formobj (car formobjs)
 750             type (w3-form-element-type formobj)
 751             widget (w3-form-element-widget formobj)
 752             formobjs (cdr formobjs)
 753             temp (case type
 754                    (reset nil)
 755                    (button nil)
 756                    (image
 757                     (if (and (eq submit-button-data formobj)
 758                              (w3-form-element-name formobj))
 759                         (setq result (append
 760                                       (list
 761                                        (cons
 762                                         (concat (w3-form-element-name formobj)
 763                                                 ".x") "0")
 764                                        (cons
 765                                         (concat (w3-form-element-name formobj)
 766                                                 ".y") "0"))
 767                                       result)))
 768                     nil)
 769                    (submit
 770                     (if (and (eq submit-button-data formobj)
 771                              (w3-form-element-name formobj))
 772                         (cons (w3-form-element-name formobj)
 773                               (w3-form-element-value formobj))))
 774                    (radio
 775                     (let* ((radio-name (w3-form-element-name formobj))
 776                            (radio-object (cdr-safe
 777                                           (assoc
 778                                            (cons
 779                                             radio-name
 780                                             (w3-form-element-action formobj))
 781                                            w3-form-radio-elements)))
 782                            (chosen-widget (and radio-object
 783                                                (widget-radio-chosen
 784                                                 (w3-form-element-widget
 785                                                  radio-object)))))
 786                       (if (assoc radio-name result)
 787                           nil
 788                         (cons radio-name (widget-value chosen-widget)))))
 789                    ((int float)
 790                     (cons (w3-form-element-name formobj)
 791                           (number-to-string (or (condition-case ()
 792                                                     (widget-value widget)
 793                                                   (error nil)) 0))))
 794                    (checkbox
 795                     (if (widget-value widget)
 796                         (cons (w3-form-element-name formobj)
 797                               (w3-form-element-value formobj))))
 798                    (file
 799                     (let ((dat nil)
 800                           (fname (widget-value widget)))
 801                       (save-excursion
 802                         (set-buffer (get-buffer-create " *w3-temp*"))
 803                         (erase-buffer)
 804                         (setq dat
 805                               (condition-case ()
 806                                   (insert-file-contents-literally fname)
 807                                 (error (concat "Error accessing " fname))))
 808                         (cons (w3-form-element-name formobj)
 809                               (cons (list (cons
 810                                            "filename"
 811                                            (file-name-nondirectory fname)))
 812                                     (buffer-string))))))
 813                    (option
 814                     (cons (w3-form-element-name formobj)
 815                           (cdr-safe
 816                            (assoc (widget-value widget)
 817                                   (w3-form-element-options formobj)))))
 818                    (keygen
 819                     (condition-case ()
 820                         (require 'ssl)
 821                       (error (error "Not configured for SSL, please read the info pages")))
 822                     (if (fboundp 'ssl-req-user-cert) nil
 823                       (error "This version of SSL isn't capable of requesting certificates"))
 824                     (let ((challenge (plist-get (w3-form-element-plist formobj) 'challenge))
 825                           (size (widget-value widget)))
 826                       (cons (w3-form-element-name formobj)
 827                             (ssl-req-user-cert size challenge))))
 828                    ((multiline hidden)
 829                     (cons (w3-form-element-name formobj)
 830                           (w3-form-element-value formobj)))
 831                    (otherwise
 832                     (cons (w3-form-element-name formobj)
 833                           (widget-value widget)))))
 834       (if temp
 835           (setq result (cons temp result))))
 836     result))
 837
 838 (defun w3-form-encode-make-mime-part (id data separator)
 839   (let (addons)
 840     (if (listp data)
 841         (progn
 842           (setq addons (mapconcat (lambda (x)
 843                                     (format "; %s=\"%s\"" (car x) (cdr x)))
 844                                   (car data) " "))
 845           (setq data (cdr data)))
 846       (setq addons ""))
 847     (format "%s\r\nContent-Disposition: form-data; name=\"%s\"%s\r\n\r\n%s"
 848             separator id addons data)))
 849
 850 (defun w3-form-encode-multipart/x-www-form-data (formobjs)
 851   ;; Create a multipart form submission.
 852   ;; Returns a cons of two strings.  Car is the separator used.
 853   ;; cdr is the body of the MIME message."
 854   (let ((separator (format-time-string "---separator-%Y%j%H%M%S-for-www-form-data")))
 855     (cons separator
 856           (concat
 857            (mapconcat
 858             (function
 859              (lambda (formobj)
 860                (w3-form-encode-make-mime-part (car formobj) (cdr formobj)
 861                                               separator)))
 862             (w3-form-encode-helper formobjs)
 863             "\r\n")
 864            "\r\n" separator "--\r\n"))))
 865
 866 (fset 'w3-form-encode-multipart/form-data
 867       'w3-form-encode-multipart/x-www-form-data)
 868 (fset 'w3-form-encode- 'w3-form-encode-application/x-www-form-urlencoded)
 869
 870 (defun w3-form-encode (result &optional enctype)
 871   "Create a string suitably encoded for a URL request."
 872   (let ((func (intern (concat "w3-form-encode-" enctype))))
 873     (if (fboundp func)
 874         (funcall func result)
 875       (w3-warn 'html (format "Bad encoding type for form data: %s" enctype))
 876       (w3-form-encode-application/x-www-form-urlencoded result))))
 877
 878 (defun w3-form-encode-text/plain (result)
 879   (let ((query ""))
 880     (setq query
 881           (mapconcat
 882            (function
 883             (lambda (widget)
 884               (let ((nam (car widget))
 885                     (val (cdr widget)))
 886                 (if (string-match "\n" nam)
 887                     (setq nam (mapconcat
 888                                (function
 889                                 (lambda (x)
 890                                   (if (= x ?\n) "," (char-to-string x))))
 891                                nam "")))
 892                 (concat nam " " val))))
 893            (w3-form-encode-helper result) "\n"))
 894     query))
 895
 896 ;; Fixme: check the charset issues on form submission
 897 ;; http://ppewww.ph.gla.ac.uk/%7Eflavell/charset/form-i18n.html
 898
 899 (defun w3-form-encode-xwfu (chunk)
 900   "Escape characters in a string for application/x-www-form-urlencoded.
 901 Blasphemous crap because someone didn't think %20 was good enough for encoding
 902 spaces.  Die Die Die."
 903   ;; This will get rid of the 'attributes' specified by the file type,
 904   ;; which are useless for an application/x-www-form-urlencoded form.
 905   (if (consp chunk)
 906       (setq chunk (cdr chunk)))
 907
 908   (mapconcat
 909     (lambda (char)
 910       (cond
 911        ((= char ?  ) "+")
 912        ((memq char url-unreserved-chars) (char-to-string char))
 913       (t (upcase (format "%%%02x" char)))))
 914    ;; Fixme: Should this actually be accepting multibyte?  Is there a
 915    ;; better way in XEmacs?
 916    (if (featurep 'mule)
 917        (encode-coding-string chunk
 918                              (if (fboundp 'find-coding-systems-string)
 919                                  (car (find-coding-systems-string chunk))
 920                                  buffer-file-coding-system))
 921      chunk)
 922    ""))
 923
 924 (defun w3-form-encode-application/x-www-form-urlencoded (result)
 925   (mapconcat
 926    (function
 927     (lambda (data)
 928       (concat (w3-form-encode-xwfu (car data)) "="
 929               (w3-form-encode-xwfu (cdr data)))))
 930    (w3-form-encode-helper result) "&"))
 931
 932 (defun w3-form-encode-application/x-w3-isindex (result)
 933   (let* ((info (w3-form-encode-helper result))
 934          (query (cdr-safe (assoc "isindex" info))))
 935     (if query
 936         (url-hexify-string query)
 937       "")))
 938
 939 (defun w3-submit-form (ident)
 940   ;; Submit form entry fields matching ACTN as their action identifier.
 941   (let* ((result (w3-all-widgets ident))
 942          (enctype (or (cdr (assq 'enctype ident))
 943                       "application/x-www-form-urlencoded"))
 944          (query (w3-form-encode result enctype))
 945          (themeth (upcase (or (cdr (assq 'method ident)) "get")))
 946          (theurl (cdr (assq 'action ident))))
 947     (if (and (string= "GET" themeth)
 948              (string-match "\\([^\\?]*\\)\\?" theurl))
 949         (setq theurl (match-string 1 theurl)))
 950     (cond
 951      ((or (string= "POST" themeth)
 952           (string= "PUT" themeth))
 953       (if (consp query)
 954           (setq enctype (concat enctype "; boundary="
 955                                 (substring (car query) 2 nil)
 956                                 "")
 957                 query (cdr query)))
 958       (let ((url-request-method themeth)
 959             (url-request-data query)
 960             (url-request-extra-headers
 961              (cons (cons "Content-type" enctype) url-request-extra-headers)))
 962         (w3-fetch theurl)))
 963      ((string= "GET" themeth)
 964       (let ((theurl (concat theurl "?" query)))
 965         (w3-fetch theurl)))
 966      (t
 967       (w3-warn 'html (format "Unknown submit method: %s" themeth))
 968       (let ((theurl (concat theurl "?" query)))
 969         (w3-fetch theurl))))))
 970
 971 (provide 'w3-forms)