Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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-display.el --- display engine v99999 1 ;;; w3-display.el --- display engine v99999
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/21 19:45:13 3 ;; Created: 1997/01/26 00:16:07
4 ;; Version: 1.110 4 ;; Version: 1.112
5 ;; Keywords: faces, help, hypermedia 5 ;; Keywords: faces, help, hypermedia
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.
1411 (setq rows (cons (nreverse items) rows) 1411 (setq rows (cons (nreverse items) rows)
1412 items nil)) 1412 items nil))
1413 (while rows 1413 (while rows
1414 (push (list 'tr nil (pop rows)) items)) 1414 (push (list 'tr nil (pop rows)) items))
1415 items)) 1415 items))
1416
1417 (defun w3-display-normalize-form-info (args)
1418 (let* ((plist (alist-to-plist args))
1419 (type (intern (downcase
1420 (or (plist-get plist 'type) "text"))))
1421 (name (plist-get plist 'name))
1422 (value (or (plist-get plist 'value) ""))
1423 (size (if (plist-get plist 'size)
1424 (string-to-int (plist-get plist 'size))))
1425 (maxlength (if (plist-get plist 'maxlength)
1426 (string-to-int
1427 (plist-get plist 'maxlength))))
1428 (default value)
1429 (checked (assq 'checked args)))
1430 (if (memq type '(checkbox radio)) (setq default checked))
1431 (if (and (eq type 'checkbox) (string= value ""))
1432 (setq value "on"))
1433 (if (and (not (memq type '(submit reset button)))
1434 (not name))
1435 (setq name (symbol-name type)))
1436 (while (and name (string-match "[\r\n]+" name))
1437 (setq name (concat (substring name 0 (match-beginning 0))
1438 (substring name (match-end 0) nil))))
1439 (setq plist (plist-put plist 'type type)
1440 plist (plist-put plist 'name name)
1441 plist (plist-put plist 'value value)
1442 plist (plist-put plist 'size size)
1443 plist (plist-put plist 'default default)
1444 plist (plist-put plist 'internal-form-number w3-current-form-number)
1445 plist (plist-put plist 'action w3-display-form-id)
1446 plist (plist-put plist 'maxlength maxlength))
1447 plist))
1416 1448
1417 (defun w3-display-node (node &optional nofaces) 1449 (defun w3-display-node (node &optional nofaces)
1418 (let ( 1450 (let (
1419 (content-stack (list (list node))) 1451 (content-stack (list (list node)))
1420 (right-margin-stack (list fill-column)) 1452 (right-margin-stack (list fill-column))
1760 w3-current-form-number 1792 w3-current-form-number
1761 (w3-get-attribute 'id) ; id 1793 (w3-get-attribute 'id) ; id
1762 nil ; checked 1794 nil ; checked
1763 (car w3-active-faces))) 1795 (car w3-active-faces)))
1764 (input 1796 (input
1765 (let* ( 1797 (w3-form-add-element
1766 (type (intern (downcase (or (w3-get-attribute 'type) 1798 (w3-display-normalize-form-info args)
1767 "text")))) 1799 (car w3-active-faces))
1768 (name (w3-get-attribute 'name))
1769 (value (or (w3-get-attribute 'value) ""))
1770 (size (if (w3-get-attribute 'size)
1771 (string-to-int (w3-get-attribute 'size))))
1772 (maxlength (cdr (assoc 'maxlength args)))
1773 (default value)
1774 (action w3-display-form-id)
1775 (options)
1776 (id (w3-get-attribute 'id))
1777 (checked (assq 'checked args)))
1778 (if (and (string-match "^[ \t\n\r]+$" value)
1779 (not (eq type 'hidden)))
1780 (setq value ""))
1781 (if maxlength (setq maxlength (string-to-int maxlength)))
1782 (if (and name (string-match "[\r\n]" name))
1783 (setq name (mapconcat (function
1784 (lambda (x)
1785 (if (memq x '(?\r ?\n))
1786 ""
1787 (char-to-string x))))
1788 name "")))
1789 (if (memq type '(checkbox radio)) (setq default checked))
1790 (if (and (eq type 'checkbox) (string= value ""))
1791 (setq value "on"))
1792 (w3-form-add-element type name
1793 value size maxlength default action
1794 options w3-current-form-number id checked
1795 (car w3-active-faces))
1796 )
1797 (w3-handle-empty-tag) 1800 (w3-handle-empty-tag)
1798 ) 1801 )
1799 (select 1802 (select
1800 (let* ( 1803 (let* ((plist (w3-display-normalize-form-info args))
1801 (name (w3-get-attribute 'name)) 1804 (tmp nil)
1802 (size (string-to-int (or (w3-get-attribute 'size) 1805 (multiple (assq 'multiple args))
1803 "20")))
1804 (maxlength (cdr (assq 'maxlength args)))
1805 (value nil) 1806 (value nil)
1806 (tmp nil) 1807 (name (plist-get plist 'name))
1807 (action w3-display-form-id) 1808 (options (mapcar
1808 (options) 1809 (function
1809 (id (w3-get-attribute 'id)) 1810 (lambda (n)
1810 (multiple (assq 'multiple args)) 1811 (setq tmp (w3-normalize-spaces
1811 (checked (assq 'checked args))) 1812 (apply 'concat (nth 2 n)))
1812 (if maxlength (setq maxlength (string-to-int maxlength))) 1813 tmp (cons tmp
1813 (if (and name (string-match "[\r\n]" name)) 1814 (or
1814 (setq name (mapconcat (function 1815 (cdr-safe
1815 (lambda (x) 1816 (assq 'value (nth 1 n)))
1816 (if (memq x '(?\r ?\n)) 1817 tmp)))
1817 "" 1818 (if (assq 'selected (nth 1 n))
1818 (char-to-string x)))) 1819 (setq value (car tmp)))
1819 name ""))) 1820 tmp))
1820 (setq options 1821 (nth 2 node))))
1821 (mapcar
1822 (function
1823 (lambda (n)
1824 (setq tmp (w3-normalize-spaces
1825 (apply 'concat (nth 2 n)))
1826 tmp (cons tmp
1827 (or
1828 (cdr-safe (assq 'value (nth 1 n)))
1829 tmp)))
1830 (if (assq 'selected (nth 1 n))
1831 (setq value (car tmp)))
1832 tmp))
1833 (nth 2 node)))
1834 (if (not value) 1822 (if (not value)
1835 (setq value (caar options))) 1823 (setq value (caar options)))
1824 (setq plist (plist-put plist 'value value))
1836 (if multiple 1825 (if multiple
1837 (progn 1826 (progn
1838 (setq options 1827 (setq options
1839 (mapcar 1828 (mapcar
1840 (function 1829 (function
1847 (cons 'value (car opt)))) 1836 (cons 'value (car opt))))
1848 " " (car opt) (list 'br nil nil))))) 1837 " " (car opt) (list 'br nil nil)))))
1849 options)) 1838 options))
1850 (setq node (list 'p nil options)) 1839 (setq node (list 'p nil options))
1851 (w3-handle-content node)) 1840 (w3-handle-content node))
1852 (w3-form-add-element 'option 1841 (setq plist (plist-put plist 'type 'option)
1853 name value size maxlength value 1842 plist (plist-put plist 'options options))
1854 action options 1843 (w3-form-add-element plist (car w3-active-faces))
1855 w3-current-form-number id nil
1856 (car w3-active-faces))
1857 ;; This should really not be necessary, but some versions 1844 ;; This should really not be necessary, but some versions
1858 ;; of the widget library leave point _BEFORE_ the menu 1845 ;; of the widget library leave point _BEFORE_ the menu
1859 ;; widget instead of after. 1846 ;; widget instead of after.
1860 (goto-char (point-max)) 1847 (goto-char (point-max))
1861 (w3-handle-empty-tag)))) 1848 (w3-handle-empty-tag))))
1862 (textarea 1849 (textarea
1863 (let* ( 1850 (let* ((plist (w3-display-normalize-form-info args))
1864 (name (w3-get-attribute 'name))
1865 (size (string-to-int (or (w3-get-attribute 'size)
1866 "22")))
1867 (maxlength (cdr (assq 'maxlength args)))
1868 (value (w3-normalize-spaces 1851 (value (w3-normalize-spaces
1869 (apply 'concat (nth 2 node)))) 1852 (apply 'concat (nth 2 node)))))
1870 (default value) 1853 (setq plist (plist-put plist 'type 'multiline)
1871 (tmp nil) 1854 plist (plist-put plist 'value value))
1872 (action w3-display-form-id) 1855 (w3-form-add-element plist (car w3-active-faces)))
1873 (options)
1874 (id (w3-get-attribute 'id))
1875 (checked (assq 'checked args)))
1876 (if maxlength (setq maxlength (string-to-int maxlength)))
1877 (if (and name (string-match "[\r\n]" name))
1878 (setq name (mapconcat (function
1879 (lambda (x)
1880 (if (memq x '(?\r ?\n))
1881 ""
1882 (char-to-string x))))
1883 name "")))
1884 (w3-form-add-element 'multiline name
1885 value size maxlength value action
1886 options w3-current-form-number id nil
1887 (car w3-active-faces))
1888 )
1889 (w3-handle-empty-tag) 1856 (w3-handle-empty-tag)
1890 ) 1857 )
1891 (style 1858 (style
1892 (w3-handle-style (alist-to-plist 1859 (w3-handle-style (alist-to-plist
1893 (cons (cons 'data (apply 'concat (nth 2 node))) 1860 (cons (cons 'data (apply 'concat (nth 2 node)))