Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 82:6a378aca36af r20-0b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 9ee227acff29
children 364816949b59
comparison
equal deleted inserted replaced
81:ebca3d831cea 82:6a378aca36af
1 ;;; w3-display.el --- display engine v99999 1 ;;; w3-display.el --- display engine v99999
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/02 20:20:45 3 ;; Created: 1997/01/21 19:45:13
4 ;; Version: 1.90 4 ;; Version: 1.110
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 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 ;;; 11 ;;;
12 ;;; This file is part of GNU Emacs. 12 ;;; This file is part of GNU Emacs.
13 ;;; 13 ;;;
14 ;;; GNU Emacs is free software; you can redistribute it and/or modify 14 ;;; GNU Emacs is free software; you can redistribute it and/or modify
36 (` (make-variable-buffer-local (defvar (, var) nil)))) 36 (` (make-variable-buffer-local (defvar (, var) nil))))
37 37
38 (w3-d-s-var-def w3-display-open-element-stack) 38 (w3-d-s-var-def w3-display-open-element-stack)
39 (w3-d-s-var-def w3-display-alignment-stack) 39 (w3-d-s-var-def w3-display-alignment-stack)
40 (w3-d-s-var-def w3-display-list-stack) 40 (w3-d-s-var-def w3-display-list-stack)
41 (w3-d-s-var-def w3-display-form-stack) 41 (w3-d-s-var-def w3-display-form-id)
42 (w3-d-s-var-def w3-display-whitespace-stack) 42 (w3-d-s-var-def w3-display-whitespace-stack)
43 (w3-d-s-var-def w3-display-font-family-stack) 43 (w3-d-s-var-def w3-display-font-family-stack)
44 (w3-d-s-var-def w3-display-font-weight-stack) 44 (w3-d-s-var-def w3-display-font-weight-stack)
45 (w3-d-s-var-def w3-display-font-variant-stack) 45 (w3-d-s-var-def w3-display-font-variant-stack)
46 (w3-d-s-var-def w3-display-font-size-stack) 46 (w3-d-s-var-def w3-display-font-size-stack)
47 (w3-d-s-var-def w3-face-color) 47 (w3-d-s-var-def w3-face-color)
48 (w3-d-s-var-def w3-face-background) 48 (w3-d-s-var-def w3-face-background-color)
49 (w3-d-s-var-def w3-active-faces) 49 (w3-d-s-var-def w3-active-faces)
50 (w3-d-s-var-def w3-active-voices) 50 (w3-d-s-var-def w3-active-voices)
51 (w3-d-s-var-def w3-current-form-number) 51 (w3-d-s-var-def w3-current-form-number)
52 (w3-d-s-var-def w3-face-font-family) 52 (w3-d-s-var-def w3-face-font-family)
53 (w3-d-s-var-def w3-face-font-weight) 53 (w3-d-s-var-def w3-face-font-weight)
83 (w3-get-face-info font-variant) 83 (w3-get-face-info font-variant)
84 (w3-get-face-info font-size) 84 (w3-get-face-info font-size)
85 (w3-get-face-info text-decoration) 85 (w3-get-face-info text-decoration)
86 ;;(w3-get-face-info pixmap) 86 ;;(w3-get-face-info pixmap)
87 (w3-get-face-info color) 87 (w3-get-face-info color)
88 (w3-get-face-info background) 88 (w3-get-face-info background-color)
89 (setq w3-face-font-spec (make-font 89 (setq w3-face-font-spec (make-font
90 :weight (car w3-face-font-weight) 90 :weight (car w3-face-font-weight)
91 :family (car w3-face-font-family) 91 :family (car w3-face-font-family)
92 :size (car w3-face-font-size)))))) 92 :size (car w3-face-font-size))))))
93 93
99 (w3-pop-face-info font-variant) 99 (w3-pop-face-info font-variant)
100 (w3-pop-face-info font-size) 100 (w3-pop-face-info font-size)
101 (w3-pop-face-info text-decoration) 101 (w3-pop-face-info text-decoration)
102 ;;(w3-pop-face-info pixmap) 102 ;;(w3-pop-face-info pixmap)
103 (w3-pop-face-info color) 103 (w3-pop-face-info color)
104 (w3-pop-face-info background)))) 104 (w3-pop-face-info background-color))))
105 105
106 ) 106 )
107 107
108 (defvar w3-display-same-buffer nil)
108 (defvar w3-face-cache nil "Cache for w3-face-for-element") 109 (defvar w3-face-cache nil "Cache for w3-face-for-element")
109 (defvar w3-face-index 0) 110 (defvar w3-face-index 0)
110 (defvar w3-image-widgets-waiting nil) 111 (defvar w3-image-widgets-waiting nil)
111 112
112 (make-variable-buffer-local 'w3-last-fill-pos) 113 (make-variable-buffer-local 'w3-last-fill-pos)
231 (if w3-face-font-variant 232 (if w3-face-font-variant
232 (set-font-style-by-keywords w3-face-font-spec 233 (set-font-style-by-keywords w3-face-font-spec
233 (car w3-face-font-variant))) 234 (car w3-face-font-variant)))
234 (setq w3-face-descr (list w3-face-font-spec 235 (setq w3-face-descr (list w3-face-font-spec
235 (car w3-face-color) 236 (car w3-face-color)
236 (car w3-face-background)) 237 (car w3-face-background-color))
237 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache))) 238 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache)))
238 (if (or w3-face-face (not (or (car w3-face-color) 239 (if (or w3-face-face (not (or (car w3-face-color)
239 (car w3-face-background) 240 (car w3-face-background-color)
240 w3-face-font-spec))) 241 w3-face-font-spec)))
241 nil ; Do nothing, we got it already 242 nil ; Do nothing, we got it already
242 (setq w3-face-face 243 (setq w3-face-face
243 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index)) 244 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index))
244 "An Emacs-W3 face... don't edit by hand." t) 245 "An Emacs-W3 face... don't edit by hand." t)
245 w3-face-index (1+ w3-face-index)) 246 w3-face-index (1+ w3-face-index))
246 (if w3-face-font-spec 247 (if w3-face-font-spec
247 (set-face-font w3-face-face w3-face-font-spec)) 248 (set-face-font w3-face-face w3-face-font-spec))
248 (if (car w3-face-color) 249 (if (car w3-face-color)
249 (set-face-foreground w3-face-face (car w3-face-color))) 250 (set-face-foreground w3-face-face (car w3-face-color)))
250 (if (car w3-face-background) 251 (if (car w3-face-background-color)
251 (set-face-background w3-face-face (car w3-face-background))) 252 (set-face-background w3-face-face (car w3-face-background-color)))
252 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap) 253 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap)
253 (setq w3-face-cache (cons 254 (setq w3-face-cache (cons
254 (cons w3-face-descr w3-face-face) 255 (cons w3-face-descr w3-face-face)
255 w3-face-cache))) 256 w3-face-cache)))
256 w3-face-face) 257 w3-face-face)
272 273
273 (defvar w3-bullets 274 (defvar w3-bullets
274 '((disc . ?*) 275 '((disc . ?*)
275 (circle . ?o) 276 (circle . ?o)
276 (square . ?#) 277 (square . ?#)
278 (none . ? )
277 ) 279 )
278 "*An assoc list of unordered list types mapping to characters to use 280 "*An assoc list of unordered list types mapping to characters to use
279 as the bullet character.") 281 as the bullet character.")
280 282
281 283
356 (add-text-properties w3-scratch-start-point (point) 358 (add-text-properties w3-scratch-start-point (point)
357 (list 'personality (car w3-active-voices)))) 359 (list 'personality (car w3-active-voices))))
358 ) 360 )
359 361
360 (defun w3-widget-echo (widget &rest ignore) 362 (defun w3-widget-echo (widget &rest ignore)
361 (let ((href (widget-get widget 'href)) 363 (let ((url (widget-get widget 'href))
362 (name (widget-get widget 'name)) 364 (name (widget-get widget 'name))
363 (text (buffer-substring (widget-get widget :from) 365 (text (buffer-substring (widget-get widget :from)
364 (widget-get widget :to))) 366 (widget-get widget :to)))
365 (title (widget-get widget 'title)) 367 (title (widget-get widget 'title))
368 (check w3-echo-link)
366 (msg nil)) 369 (msg nil))
367 (if href 370 (if url
368 (setq href (url-truncate-url-for-viewing href))) 371 (setq url (url-truncate-url-for-viewing url)))
369 (if name 372 (if name
370 (setq name (concat "anchor:" name))) 373 (setq name (concat "anchor:" name)))
371 (case w3-echo-link 374 (if (not (listp check))
372 (url (or href title text name)) 375 (setq check (cons check '(title url text name))))
373 (text (or text title href name)) 376 (catch 'exit
374 (title (or title text href name)) 377 (while check
375 (otherwise nil)))) 378 (and (boundp (car check))
379 (stringp (symbol-value (car check)))
380 (throw 'exit (symbol-value (car check))))
381 (pop check)))))
376 382
377 (defun w3-follow-hyperlink (widget &rest ignore) 383 (defun w3-follow-hyperlink (widget &rest ignore)
378 (let* ((target (widget-get widget 'target)) 384 (let* ((target (widget-get widget 'target))
379 (href (widget-get widget 'href))) 385 (href (widget-get widget 'href)))
380 (if target (setq target (intern (downcase target)))) 386 (if target (setq target (intern (downcase target))))
421 427
422 (defmacro w3-display-handle-list-type () 428 (defmacro w3-display-handle-list-type ()
423 (` 429 (`
424 (case (car break-style) 430 (case (car break-style)
425 (list-item 431 (list-item
426 (let ((list-style (w3-get-style-info 'list-style node)) 432 (let ((list-style (w3-get-style-info 'list-style-type node))
427 (list-num (if (car w3-display-list-stack) 433 (list-num (if (car w3-display-list-stack)
428 (incf (car w3-display-list-stack)) 434 (incf (car w3-display-list-stack))
429 1)) 435 1))
430 (margin (1- (car left-margin-stack))) 436 (margin (1- (car left-margin-stack)))
431 (indent (w3-get-style-info 'text-indent node 0))) 437 (indent (w3-get-style-info 'text-indent node 0)))
570 (cons (cons type (list (cons desc (list plist)))) 576 (cons (cons type (list (cons desc (list plist))))
571 w3-current-links))))) 577 w3-current-links)))))
572 (setq desc (and desc (intern dc-desc))) 578 (setq desc (and desc (intern dc-desc)))
573 (case desc 579 (case desc
574 ((style stylesheet) 580 ((style stylesheet)
575 (w3-handle-style args)) 581 (w3-handle-style plist))
576 (otherwise 582 (otherwise
577 ) 583 )
578 ) 584 )
579 ) 585 )
580 ) 586 )
1387 (aref timeinfo 1) ; Minute 1393 (aref timeinfo 1) ; Minute
1388 (aref timeinfo 2) ; Second 1394 (aref timeinfo 2) ; Second
1389 ) 1395 )
1390 "HoplesSLYCoNfUSED"))) 1396 "HoplesSLYCoNfUSED")))
1391 1397
1398 (defun w3-display-chop-into-table (node cols)
1399 ;; Chop the content of 'node' up into 'cols' columns suitable for inclusion
1400 ;; as the content of a table
1401 (let ((content (nth 2 node))
1402 (items nil)
1403 (rows nil))
1404 (setq cols (max cols 1))
1405 (while content
1406 (push (list 'td nil (list (pop content))) items)
1407 (if (= (length items) cols)
1408 (setq rows (cons (nreverse items) rows)
1409 items nil)))
1410 (if items ; Store any leftovers
1411 (setq rows (cons (nreverse items) rows)
1412 items nil))
1413 (while rows
1414 (push (list 'tr nil (pop rows)) items))
1415 items))
1416
1392 (defun w3-display-node (node &optional nofaces) 1417 (defun w3-display-node (node &optional nofaces)
1393 (let ( 1418 (let (
1394 (content-stack (list (list node))) 1419 (content-stack (list (list node)))
1395 (right-margin-stack (list fill-column)) 1420 (right-margin-stack (list fill-column))
1396 (left-margin-stack (list 0)) 1421 (left-margin-stack (list 0))
1419 nil 1444 nil
1420 (add-text-properties (car hyperlink-info) (point) 1445 (add-text-properties (car hyperlink-info) (point)
1421 (list 1446 (list
1422 'mouse-face 'highlight 1447 'mouse-face 'highlight
1423 'duplicable t 1448 'duplicable t
1449 'start-open t
1450 'end-open t
1451 'rear-nonsticky t
1424 'help-echo 'w3-balloon-help-callback 1452 'help-echo 'w3-balloon-help-callback
1425 'balloon-help 'w3-balloon-help-callback)) 1453 'balloon-help 'w3-balloon-help-callback))
1426 (fillin-text-property (car hyperlink-info) (point) 1454 (fillin-text-property (car hyperlink-info) (point)
1427 'button 'button (cadr hyperlink-info)) 1455 'button 'button (cadr hyperlink-info))
1428 (widget-put (cadr hyperlink-info) :to (set-marker 1456 (widget-put (cadr hyperlink-info) :to (set-marker
1429 (make-marker) (point)))) 1457 (make-marker) (point))))
1430 (setq hyperlink-info nil)) 1458 (setq hyperlink-info nil))
1431 (form
1432 (pop w3-display-form-stack))
1433 ((ol ul dl dir menu) 1459 ((ol ul dl dir menu)
1434 (pop w3-display-list-stack)) 1460 (pop w3-display-list-stack))
1435 (otherwise 1461 (otherwise
1436 nil)) 1462 nil))
1437 (if (car insert-after) 1463 (if (car insert-after)
1452 ;; This little bit of magic takes care of inline styles. 1478 ;; This little bit of magic takes care of inline styles.
1453 ;; Evil Evil Evil, but it appears to work. 1479 ;; Evil Evil Evil, but it appears to work.
1454 (if (w3-get-attribute 'style) 1480 (if (w3-get-attribute 'style)
1455 (let ((unique-id (or (w3-get-attribute 'id) 1481 (let ((unique-id (or (w3-get-attribute 'id)
1456 (w3-display-create-unique-id))) 1482 (w3-display-create-unique-id)))
1457 (sheet "")) 1483 (sheet "")
1484 (class (assq 'class args)))
1458 (setq sheet (format "%s.%s { %s }\n" tag unique-id 1485 (setq sheet (format "%s.%s { %s }\n" tag unique-id
1459 (w3-get-attribute 'style))) 1486 (w3-get-attribute 'style)))
1460 (setf (nth 1 node) (cons (cons 'id unique-id) args)) 1487 (if class
1461 (w3-handle-style (list (cons 'data sheet) 1488 (setcdr class (cons unique-id (cdr class)))
1462 (cons 'notation "css"))))) 1489 (setf (nth 1 node) (cons (cons 'class (list unique-id))
1490 (nth 1 node))))
1491 (setf (nth 1 node) (cons (cons 'id unique-id) (nth 1 node)))
1492 (w3-handle-style (list 'data sheet
1493 'notation "css"))))
1463 (setq w3-display-css-properties (css-get 1494 (setq w3-display-css-properties (css-get
1464 (nth 0 node) (nth 1 node) 1495 (nth 0 node)
1496 (nth 1 node)
1465 w3-current-stylesheet 1497 w3-current-stylesheet
1466 w3-display-open-element-stack)) 1498 w3-display-open-element-stack))
1467 (if nofaces 1499 (if nofaces
1468 nil 1500 nil
1469 (push (w3-face-for-element node) w3-active-faces) 1501 (push (w3-face-for-element node) w3-active-faces)
1512 ) 1544 )
1513 (alist-to-plist args)))) 1545 (alist-to-plist args))))
1514 (w3-handle-content node) 1546 (w3-handle-content node)
1515 ) 1547 )
1516 ) 1548 )
1517 ((ol ul dl dir menu) 1549 ((ol ul dl menu)
1518 (push 0 w3-display-list-stack) 1550 (push 0 w3-display-list-stack)
1551 (w3-handle-content node))
1552 (dir
1553 (push 0 w3-display-list-stack)
1554 (setq node
1555 (list tag args
1556 (list
1557 (list 'table nil
1558 (w3-display-chop-into-table node 3)))))
1559 (w3-handle-content node))
1560 (multicol
1561 (setq node (list tag args
1562 (list
1563 (list 'table nil
1564 (w3-display-chop-into-table node 2)))))
1519 (w3-handle-content node)) 1565 (w3-handle-content node))
1520 (img ; inlined image 1566 (img ; inlined image
1521 (w3-handle-image) 1567 (w3-handle-image)
1522 (w3-handle-empty-tag)) 1568 (w3-handle-empty-tag))
1523 (script ; Scripts 1569 (script ; Scripts
1563 ) 1609 )
1564 (nth 2 node)))) 1610 (nth 2 node))))
1565 (setq w3-imagemaps (cons (cons name areas) w3-imagemaps))) 1611 (setq w3-imagemaps (cons (cons name areas) w3-imagemaps)))
1566 (w3-handle-empty-tag) 1612 (w3-handle-empty-tag)
1567 ) 1613 )
1568 (table ; Yeeee-hah! 1614 (note
1615 ;; Ewwwwhhh. Looks gross, but it works. This converts a
1616 ;; <note> into a two-cell table, so that things look all
1617 ;; pretty.
1618 (setq node
1619 (list 'note nil
1620 (list
1621 (list 'table nil
1622 (list
1623 (list 'tr nil
1624 (list
1625 (list 'td (list 'align 'right)
1626 (list
1627 (concat
1628 (or (w3-get-attribute 'role)
1629 "CAUTION") ":")))
1630 (list 'td nil
1631 (nth 2 node)))))))))
1632 (w3-handle-content node)
1633 )
1634 (table
1569 (w3-display-table node) 1635 (w3-display-table node)
1570 (setq w3-last-fill-pos (point)) 1636 (setq w3-last-fill-pos (point))
1571 (w3-handle-empty-tag) 1637 (w3-handle-empty-tag)
1572 ) 1638 )
1573 (isindex 1639 (isindex
1597 (setq w3-current-isindex (cons action prompt))) 1663 (setq w3-current-isindex (cons action prompt)))
1598 ) 1664 )
1599 (*document 1665 (*document
1600 (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) 1666 (let ((info (mapcar (lambda (x) (cons x (symbol-value x)))
1601 w3-persistent-variables))) 1667 w3-persistent-variables)))
1602 (set-buffer (generate-new-buffer "Untitled")) 1668 (if (not w3-display-same-buffer)
1669 (set-buffer (generate-new-buffer "Untitled")))
1603 (setq w3-current-form-number 0 1670 (setq w3-current-form-number 0
1604 w3-display-open-element-stack nil 1671 w3-display-open-element-stack nil
1605 w3-last-fill-pos (point-min) 1672 w3-last-fill-pos (point-min)
1606 fill-column (min (- (or w3-strict-width (window-width)) 1673 fill-column (min (- (or w3-strict-width (window-width))
1607 w3-right-margin) 1674 w3-right-margin)
1611 (buffer-disable-undo (current-buffer)) 1678 (buffer-disable-undo (current-buffer))
1612 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) 1679 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
1613 ;; ACK! We don't like filladapt mode! 1680 ;; ACK! We don't like filladapt mode!
1614 (set (make-local-variable 'filladapt-mode) nil) 1681 (set (make-local-variable 'filladapt-mode) nil)
1615 (set (make-local-variable 'adaptive-fill-mode) nil) 1682 (set (make-local-variable 'adaptive-fill-mode) nil)
1683 (set (make-local-variable 'voice-lock-mode) t)
1616 (setq w3-current-stylesheet (css-copy-stylesheet 1684 (setq w3-current-stylesheet (css-copy-stylesheet
1617 w3-user-stylesheet) 1685 w3-user-stylesheet)
1618 w3-last-fill-pos (point) 1686 w3-last-fill-pos (point)
1619 fill-column (min (- (or w3-strict-width (window-width)) 1687 fill-column (min (- (or w3-strict-width (window-width))
1620 w3-right-margin) 1688 w3-right-margin)
1658 (content (nth 2 node))) 1726 (content (nth 2 node)))
1659 (while content 1727 (while content
1660 (setq potential-title (concat potential-title (car content)) 1728 (setq potential-title (concat potential-title (car content))
1661 content (cdr content))) 1729 content (cdr content)))
1662 (setq potential-title (w3-normalize-spaces potential-title)) 1730 (setq potential-title (w3-normalize-spaces potential-title))
1663 (if (string-match "^[ \t]*$" potential-title) 1731 (if (or w3-display-same-buffer
1732 (string-match "^[ \t]*$" potential-title))
1664 nil 1733 nil
1665 (rename-buffer (generate-new-buffer-name 1734 (rename-buffer (generate-new-buffer-name
1666 (w3-fix-spaces potential-title))))) 1735 (w3-fix-spaces potential-title)))))
1667 (w3-handle-empty-tag)) 1736 (w3-handle-empty-tag))
1668 (form 1737 (form
1670 (let* ( 1739 (let* (
1671 (action (w3-get-attribute 'action)) 1740 (action (w3-get-attribute 'action))
1672 (url nil)) 1741 (url nil))
1673 (if (not action) 1742 (if (not action)
1674 (setq args (cons (cons 'action (url-view-url t)) args))) 1743 (setq args (cons (cons 'action (url-view-url t)) args)))
1675 (push (cons 1744 (setq w3-display-form-id (cons
1676 (cons 'form-number 1745 (cons 'form-number
1677 w3-current-form-number) 1746 w3-current-form-number)
1678 args) w3-display-form-stack) 1747 args))
1679 (w3-handle-content node))) 1748 (w3-handle-content node)))
1749 (keygen
1750 (w3-form-add-element 'keygen
1751 (or (w3-get-attribute 'name)
1752 (w3-get-attribute 'id)
1753 "keygen")
1754 nil ; value
1755 nil ; size
1756 nil ; maxlength
1757 nil ; default
1758 w3-display-form-id ; action
1759 nil ; options
1760 w3-current-form-number
1761 (w3-get-attribute 'id) ; id
1762 nil ; checked
1763 (car w3-active-faces)))
1680 (input 1764 (input
1681 (if (not (assq 'form w3-display-open-element-stack)) 1765 (let* (
1682 (message "Input field outside of a <form>") 1766 (type (intern (downcase (or (w3-get-attribute 'type)
1683 (let* ( 1767 "text"))))
1684 (type (intern (downcase (or (w3-get-attribute 'type) 1768 (name (w3-get-attribute 'name))
1685 "text")))) 1769 (value (or (w3-get-attribute 'value) ""))
1686 (name (w3-get-attribute 'name)) 1770 (size (if (w3-get-attribute 'size)
1687 (value (or (w3-get-attribute 'value) "")) 1771 (string-to-int (w3-get-attribute 'size))))
1688 (size (if (w3-get-attribute 'size) 1772 (maxlength (cdr (assoc 'maxlength args)))
1689 (string-to-int (w3-get-attribute 'size)))) 1773 (default value)
1690 (maxlength (cdr (assoc 'maxlength args))) 1774 (action w3-display-form-id)
1691 (default value) 1775 (options)
1692 (action (car w3-display-form-stack)) 1776 (id (w3-get-attribute 'id))
1693 (options) 1777 (checked (assq 'checked args)))
1694 (id (w3-get-attribute 'id)) 1778 (if (and (string-match "^[ \t\n\r]+$" value)
1695 (checked (assq 'checked args))) 1779 (not (eq type 'hidden)))
1696 (if (and (string-match "^[ \t\n\r]+$" value) 1780 (setq value ""))
1697 (not (eq type 'hidden))) 1781 (if maxlength (setq maxlength (string-to-int maxlength)))
1698 (setq value "")) 1782 (if (and name (string-match "[\r\n]" name))
1699 (if maxlength (setq maxlength (string-to-int maxlength))) 1783 (setq name (mapconcat (function
1700 (if (and name (string-match "[\r\n]" name)) 1784 (lambda (x)
1701 (setq name (mapconcat (function 1785 (if (memq x '(?\r ?\n))
1702 (lambda (x) 1786 ""
1703 (if (memq x '(?\r ?\n)) 1787 (char-to-string x))))
1704 "" 1788 name "")))
1705 (char-to-string x)))) 1789 (if (memq type '(checkbox radio)) (setq default checked))
1706 name ""))) 1790 (if (and (eq type 'checkbox) (string= value ""))
1707 (if (memq type '(checkbox radio)) (setq default checked)) 1791 (setq value "on"))
1708 (if (and (eq type 'checkbox) (string= value "")) 1792 (w3-form-add-element type name
1709 (setq value "on")) 1793 value size maxlength default action
1710 (w3-form-add-element type name 1794 options w3-current-form-number id checked
1711 value size maxlength default action 1795 (car w3-active-faces))
1712 options w3-current-form-number id checked
1713 (car w3-active-faces))
1714 )
1715 ) 1796 )
1716 (w3-handle-empty-tag) 1797 (w3-handle-empty-tag)
1717 ) 1798 )
1718 (select 1799 (select
1719 (if (not (assq 'form w3-display-open-element-stack)) 1800 (let* (
1720 (message "Input field outside of a <form>") 1801 (name (w3-get-attribute 'name))
1721 (let* ( 1802 (size (string-to-int (or (w3-get-attribute 'size)
1722 (name (w3-get-attribute 'name)) 1803 "20")))
1723 (size (string-to-int (or (w3-get-attribute 'size) 1804 (maxlength (cdr (assq 'maxlength args)))
1724 "20"))) 1805 (value nil)
1725 (maxlength (cdr (assq 'maxlength args))) 1806 (tmp nil)
1726 (value nil) 1807 (action w3-display-form-id)
1727 (tmp nil) 1808 (options)
1728 (action (car w3-display-form-stack)) 1809 (id (w3-get-attribute 'id))
1729 (options) 1810 (multiple (assq 'multiple args))
1730 (id (w3-get-attribute 'id)) 1811 (checked (assq 'checked args)))
1731 (checked (assq 'checked args))) 1812 (if maxlength (setq maxlength (string-to-int maxlength)))
1732 (if maxlength (setq maxlength (string-to-int maxlength))) 1813 (if (and name (string-match "[\r\n]" name))
1733 (if (and name (string-match "[\r\n]" name)) 1814 (setq name (mapconcat (function
1734 (setq name (mapconcat (function 1815 (lambda (x)
1735 (lambda (x) 1816 (if (memq x '(?\r ?\n))
1736 (if (memq x '(?\r ?\n)) 1817 ""
1737 "" 1818 (char-to-string x))))
1738 (char-to-string x)))) 1819 name "")))
1739 name ""))) 1820 (setq options
1740 (setq options 1821 (mapcar
1741 (mapcar 1822 (function
1742 (function 1823 (lambda (n)
1743 (lambda (n) 1824 (setq tmp (w3-normalize-spaces
1744 (setq tmp (w3-normalize-spaces 1825 (apply 'concat (nth 2 n)))
1745 (apply 'concat (nth 2 n))) 1826 tmp (cons tmp
1746 tmp (cons tmp 1827 (or
1747 (or 1828 (cdr-safe (assq 'value (nth 1 n)))
1748 (cdr-safe (assq 'value (nth 1 n))) 1829 tmp)))
1749 tmp))) 1830 (if (assq 'selected (nth 1 n))
1750 (if (assq 'selected (nth 1 n)) 1831 (setq value (car tmp)))
1751 (setq value (car tmp))) 1832 tmp))
1752 tmp)) 1833 (nth 2 node)))
1753 (nth 2 node))) 1834 (if (not value)
1754 (if (not value) 1835 (setq value (caar options)))
1755 (setq value (caar options))) 1836 (if multiple
1756 (w3-form-add-element 'option name 1837 (progn
1757 value size maxlength value action 1838 (setq options
1758 options w3-current-form-number id nil 1839 (mapcar
1840 (function
1841 (lambda (opt)
1842 (list 'div nil
1843 (list
1844 (list 'input
1845 (list (cons 'name name)
1846 (cons 'type "checkbox")
1847 (cons 'value (car opt))))
1848 " " (car opt) (list 'br nil nil)))))
1849 options))
1850 (setq node (list 'p nil options))
1851 (w3-handle-content node))
1852 (w3-form-add-element 'option
1853 name value size maxlength value
1854 action options
1855 w3-current-form-number id nil
1759 (car w3-active-faces)) 1856 (car w3-active-faces))
1760 ;; This should really not be necessary, but some versions 1857 ;; This should really not be necessary, but some versions
1761 ;; of the widget library leave point _BEFORE_ the menu 1858 ;; of the widget library leave point _BEFORE_ the menu
1762 ;; widget instead of after. 1859 ;; widget instead of after.
1763 (goto-char (point-max)) 1860 (goto-char (point-max))
1764 ) 1861 (w3-handle-empty-tag))))
1765 )
1766 (w3-handle-empty-tag)
1767 )
1768 (textarea 1862 (textarea
1769 (if (not (assq 'form w3-display-open-element-stack)) 1863 (let* (
1770 (message "Input field outside of a <form>") 1864 (name (w3-get-attribute 'name))
1771 (let* ( 1865 (size (string-to-int (or (w3-get-attribute 'size)
1772 (name (w3-get-attribute 'name)) 1866 "22")))
1773 (size (string-to-int (or (w3-get-attribute 'size) 1867 (maxlength (cdr (assq 'maxlength args)))
1774 "20"))) 1868 (value (w3-normalize-spaces
1775 (maxlength (cdr (assq 'maxlength args))) 1869 (apply 'concat (nth 2 node))))
1776 (value (w3-normalize-spaces 1870 (default value)
1777 (apply 'concat (nth 2 node)))) 1871 (tmp nil)
1778 (default value) 1872 (action w3-display-form-id)
1779 (tmp nil) 1873 (options)
1780 (action (car w3-display-form-stack)) 1874 (id (w3-get-attribute 'id))
1781 (options) 1875 (checked (assq 'checked args)))
1782 (id (w3-get-attribute 'id)) 1876 (if maxlength (setq maxlength (string-to-int maxlength)))
1783 (checked (assq 'checked args))) 1877 (if (and name (string-match "[\r\n]" name))
1784 (if maxlength (setq maxlength (string-to-int maxlength))) 1878 (setq name (mapconcat (function
1785 (if (and name (string-match "[\r\n]" name)) 1879 (lambda (x)
1786 (setq name (mapconcat (function 1880 (if (memq x '(?\r ?\n))
1787 (lambda (x) 1881 ""
1788 (if (memq x '(?\r ?\n)) 1882 (char-to-string x))))
1789 "" 1883 name "")))
1790 (char-to-string x)))) 1884 (w3-form-add-element 'multiline name
1791 name ""))) 1885 value size maxlength value action
1792 (w3-form-add-element 'multiline name 1886 options w3-current-form-number id nil
1793 value size maxlength value action 1887 (car w3-active-faces))
1794 options w3-current-form-number id nil
1795 (car w3-active-faces))
1796 )
1797 ) 1888 )
1798 (w3-handle-empty-tag) 1889 (w3-handle-empty-tag)
1799 ) 1890 )
1800 (style 1891 (style
1801 (w3-handle-style (cons (cons 'data (apply 'concat (nth 2 node))) 1892 (w3-handle-style (alist-to-plist
1802 (nth 1 node))) 1893 (cons (cons 'data (apply 'concat (nth 2 node)))
1894 (nth 1 node))))
1803 (w3-handle-empty-tag)) 1895 (w3-handle-empty-tag))
1804 (otherwise 1896 (otherwise
1805 ;; Generic formatting 1897 ;; Generic formatting
1806 (w3-handle-content node)) 1898 (w3-handle-content node))
1807 ) ; case tag 1899 ) ; case tag
1827 (w3-draw-tree (or tree w3-last-parse-tree)) 1919 (w3-draw-tree (or tree w3-last-parse-tree))
1828 (setq nd (nth 1 (current-time))) 1920 (setq nd (nth 1 (current-time)))
1829 (- nd st))) 1921 (- nd st)))
1830 1922
1831 1923
1924 (defsubst w3-finish-drawing ()
1925 (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting)
1926 (let (url glyph widget)
1927 (while w3-image-widgets-waiting
1928 (setq widget (car w3-image-widgets-waiting)
1929 w3-image-widgets-waiting (cdr w3-image-widgets-waiting)
1930 url (widget-get widget 'src)
1931 glyph (cdr-safe (assoc url w3-graphics-list)))
1932 (widget-value-set widget glyph)))
1933 ;;(w3-handle-annotations)
1934 ;;(w3-handle-headers)
1935 )
1936 )
1937
1938 (defun w3-region (st nd)
1939 (if (not w3-setup-done) (w3-do-setup))
1940 (let* ((source (buffer-substring st nd))
1941 (w3-display-same-buffer t)
1942 (parse nil))
1943 (save-excursion
1944 (set-buffer (get-buffer-create " *w3-region*"))
1945 (erase-buffer)
1946 (insert source)
1947 (setq parse (w3-parse-buffer (current-buffer))))
1948 (narrow-to-region st nd)
1949 (delete-region (point-min) (point-max))
1950 (w3-draw-tree parse)
1951 (w3-finish-drawing)))
1952
1953 (defun w3-refresh-buffer ()
1954 (interactive)
1955 (let ((parse w3-current-parse)
1956 (inhibit-read-only t)
1957 (w3-display-same-buffer t))
1958 (if (not parse)
1959 (error "Could not find the parse tree for this buffer. EEEEK!"))
1960 (erase-buffer)
1961 (w3-draw-tree parse)
1962 (w3-finish-drawing)
1963 (w3-mode)
1964 (set-buffer-modified-p nil)))
1965
1832 (defun w3-prepare-buffer (&rest args) 1966 (defun w3-prepare-buffer (&rest args)
1833 ;; The text/html viewer - does all the drawing and displaying of the buffer 1967 ;; The text/html viewer - does all the drawing and displaying of the buffer
1834 ;; that is necessary to go from raw HTML to a good presentation. 1968 ;; that is necessary to go from raw HTML to a good presentation.
1835 (let* ((source (buffer-string)) 1969 (let* ((source (buffer-string))
1836 (source-buf (current-buffer)) 1970 (source-buf (current-buffer))
1839 (w3-draw-tree parse) 1973 (w3-draw-tree parse)
1840 (kill-buffer source-buf) 1974 (kill-buffer source-buf)
1841 (set-buffer-modified-p nil) 1975 (set-buffer-modified-p nil)
1842 (setq w3-current-source source 1976 (setq w3-current-source source
1843 w3-current-parse parse) 1977 w3-current-parse parse)
1844 (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting) 1978 (w3-finish-drawing)
1845 (let (url glyph widget)
1846 (while w3-image-widgets-waiting
1847 (setq widget (car w3-image-widgets-waiting)
1848 w3-image-widgets-waiting (cdr w3-image-widgets-waiting)
1849 url (widget-get widget 'src)
1850 glyph (cdr-safe (assoc url w3-graphics-list)))
1851 (widget-value-set widget glyph))))
1852 (w3-mode) 1979 (w3-mode)
1853 ;;(w3-handle-annotations)
1854 ;;(w3-handle-headers)
1855 (set-buffer-modified-p nil) 1980 (set-buffer-modified-p nil)
1856 (goto-char (point-min)) 1981 (goto-char (point-min))
1857 (if url-keep-history 1982 (if url-keep-history
1858 (let ((url (url-view-url t))) 1983 (let ((url (url-view-url t)))
1859 (if (not url-history-list) 1984 (if (not url-history-list)