Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-forms.el @ 116:9f59509498e1 r20-1b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b10
author cvs
date Mon, 13 Aug 2007 09:23:06 +0200
parents 8619ce7e4c50
children 7d55a9ba150c
comparison
equal deleted inserted replaced
115:f109f7dabbe2 116:9f59509498e1
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/03/18 23:20:04 3 ;; Created: 1997/03/25 23:33:51
4 ;; Version: 1.79 4 ;; Version: 1.81
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.
47 47
48 (define-widget-keywords :emacspeak-help :w3-form-data) 48 (define-widget-keywords :emacspeak-help :w3-form-data)
49 49
50 (defvar w3-form-keymap 50 (defvar w3-form-keymap
51 (let ((map (copy-keymap global-map)) 51 (let ((map (copy-keymap global-map))
52 (eol-loc (where-is-internal 'end-of-line nil t))) 52 (eol-loc (where-is-internal 'end-of-line global-map t)))
53 (if widget-keymap 53 (if widget-keymap
54 (cl-map-keymap (function 54 (cl-map-keymap (function
55 (lambda (key binding) 55 (lambda (key binding)
56 (define-key map 56 (define-key map
57 (if (vectorp key) key (vector key)) 57 (if (vectorp key) key (vector key))
98 (defsubst w3-form-element-set-options (obj val) (aset obj 6 val)) 98 (defsubst w3-form-element-set-options (obj val) (aset obj 6 val))
99 (defsubst w3-form-element-set-action (obj val) (aset obj 7 val)) 99 (defsubst w3-form-element-set-action (obj val) (aset obj 7 val))
100 (defsubst w3-form-element-set-widget (obj val) (aset obj 8 val)) 100 (defsubst w3-form-element-set-widget (obj val) (aset obj 8 val))
101 (defsubst w3-form-element-set-plist (obj val) (aset obj 9 val)) 101 (defsubst w3-form-element-set-plist (obj val) (aset obj 9 val))
102 102
103 (defvar w3-form-valid-key-sizes
104 '(
105 ("1024 (Premium)" . 1024)
106 ("896 (Regular)" . 896)
107 ("768 (Unleaded)" . 768)
108 ("512 (Low Grade)" . 512)
109 ("508 (Woos)" . 508)
110 ("256 (Test Grade)" . 256)
111 )
112 "An assoc list of available key sizes and meaningful descriptions.")
113
103 (defun w3-form-determine-size (el size) 114 (defun w3-form-determine-size (el size)
104 (case (w3-form-element-type el) 115 (case (w3-form-element-type el)
105 (checkbox 3) 116 (checkbox 3)
106 (radio 4) 117 (radio 4)
107 ((reset submit) (+ 2 (length (or (w3-form-element-value el) 118 ((reset submit) (+ 2 (length (or (w3-form-element-value el)
123 (length (caar (sort options 134 (length (caar (sort options
124 (function 135 (function
125 (lambda (x y) 136 (lambda (x y)
126 (>= (length (car x)) 137 (>= (length (car x))
127 (length (car y))))))))))) 138 (length (car y)))))))))))
139 (keygen
140 (+ (length "Key Length: ")
141 (apply 'max
142 (mapcar (function (lambda (pair)
143 (length (car pair))))
144 w3-form-valid-key-sizes))))
128 (otherwise (or size 22)))) 145 (otherwise (or size 22))))
129 146
130 ;;###autoload 147 ;;###autoload
131 (defun w3-form-add-element (plist face) 148 (defun w3-form-add-element (plist face)
132 (let* ((action (plist-get plist 'action)) 149 (let* ((action (plist-get plist 'action))
346 :value-face face 363 :value-face face
347 :size (w3-form-element-size el) 364 :size (w3-form-element-size el)
348 :must-match t 365 :must-match t
349 :value (w3-form-element-value el))) 366 :value (w3-form-element-value el)))
350 367
351 (defvar w3-form-valid-key-sizes
352 '(
353 ("1024 (Premium)" . 1024)
354 ("896 (Regular)" . 896)
355 ("768 (Unleaded)" . 768)
356 ("512 (Low Grade)" . 512)
357 ("508 (Woos)" . 508)
358 ("256 (Test Grade)" . 256)
359 )
360 "An assoc list of available key sizes and meaningful descriptions.")
361
362 (defun w3-form-create-keygen-list (el face) 368 (defun w3-form-create-keygen-list (el face)
363 (let ((tmp w3-form-valid-key-sizes) 369 (let* ((size (apply 'max (mapcar (function (lambda (pair) (length (car pair))))
364 (longest 0) 370 w3-form-valid-key-sizes)))
365 (options nil)) 371 (options (mapcar (function (lambda (pair)
366 (while tmp 372 (list 'choice-item
367 (if (> (length (caar tmp)) longest) 373 :format "%[%t%]"
368 (setq longest (length (caar tmp)))) 374 :menu-tag-get `(lambda (zed) ,(car pair))
369 (setq options (cons (list 'choice-item :tag (caar tmp) 375 :tag (mule-truncate-string (car pair) size ? )
370 :value (cdar tmp)) options) 376 :value (cdr pair))))
371 tmp (cdr tmp))) 377 w3-form-valid-key-sizes)))
372 (apply 'widget-create 'menu-choice 378 (apply 'widget-create 'menu-choice
373 :value 1024 379 :value 1024
374 :ignore-case t 380 :ignore-case t
375 :tag "Key Length" 381 :tag "Key Length"
376 :size (1+ longest) 382 :size size
377 :button-face face 383 :button-face face
378 :value-face face 384 :value-face face
379 options))) 385 options)))
380 386
381 (defun w3-form-create-option-list (el face) 387 (defun w3-form-create-option-list (el face)
793 (cons (w3-form-element-name formobj) 799 (cons (w3-form-element-name formobj)
794 (cdr-safe 800 (cdr-safe
795 (assoc (widget-value widget) 801 (assoc (widget-value widget)
796 (w3-form-element-options formobj))))) 802 (w3-form-element-options formobj)))))
797 (keygen 803 (keygen
798 (cons (w3-form-element-name formobj) 804 (condition-case ()
799 (format "Should create a %d bit RSA key" 805 (require 'ssl)
800 (widget-value widget)))) 806 (error (error "Not configured for SSL, please read the info pages.")))
807 (if (fboundp 'ssl-req-user-cert) nil
808 (error "This version of SSL isn't capable of requesting certificates."))
809 (let ((challenge (plist-get (w3-form-element-plist formobj) 'challenge))
810 (size (widget-value widget)))
811 (cons (w3-form-element-name formobj)
812 (ssl-req-user-cert size challenge))))
801 ((multiline hidden) 813 ((multiline hidden)
802 (cons (w3-form-element-name formobj) 814 (cons (w3-form-element-name formobj)
803 (w3-form-element-value formobj))) 815 (w3-form-element-value formobj)))
804 (otherwise 816 (otherwise
805 (cons (w3-form-element-name formobj) 817 (cons (w3-form-element-name formobj)