Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 859a2309aef8
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
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/31 04:26:17
4 ;; Version: 1.90 4 ;; Version: 1.115
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
30 (require 'css) 30 (require 'css)
31 (require 'font) 31 (require 'font)
32 (require 'w3-widget) 32 (require 'w3-widget)
33 (require 'w3-imap) 33 (require 'w3-imap)
34 34
35 (autoload 'sentence-ify "flame")
36 (autoload 'string-ify "flame")
37 (autoload '*flame "flame")
38 (if (not (fboundp 'flatten)) (autoload 'flatten "flame"))
39 (defvar w3-cookie-cache nil)
40
35 (defmacro w3-d-s-var-def (var) 41 (defmacro w3-d-s-var-def (var)
36 (` (make-variable-buffer-local (defvar (, var) nil)))) 42 (` (make-variable-buffer-local (defvar (, var) nil))))
37 43
38 (w3-d-s-var-def w3-display-open-element-stack) 44 (w3-d-s-var-def w3-display-open-element-stack)
39 (w3-d-s-var-def w3-display-alignment-stack) 45 (w3-d-s-var-def w3-display-alignment-stack)
40 (w3-d-s-var-def w3-display-list-stack) 46 (w3-d-s-var-def w3-display-list-stack)
41 (w3-d-s-var-def w3-display-form-stack) 47 (w3-d-s-var-def w3-display-form-id)
42 (w3-d-s-var-def w3-display-whitespace-stack) 48 (w3-d-s-var-def w3-display-whitespace-stack)
43 (w3-d-s-var-def w3-display-font-family-stack) 49 (w3-d-s-var-def w3-display-font-family-stack)
44 (w3-d-s-var-def w3-display-font-weight-stack) 50 (w3-d-s-var-def w3-display-font-weight-stack)
45 (w3-d-s-var-def w3-display-font-variant-stack) 51 (w3-d-s-var-def w3-display-font-variant-stack)
46 (w3-d-s-var-def w3-display-font-size-stack) 52 (w3-d-s-var-def w3-display-font-size-stack)
47 (w3-d-s-var-def w3-face-color) 53 (w3-d-s-var-def w3-face-color)
48 (w3-d-s-var-def w3-face-background) 54 (w3-d-s-var-def w3-face-background-color)
49 (w3-d-s-var-def w3-active-faces) 55 (w3-d-s-var-def w3-active-faces)
50 (w3-d-s-var-def w3-active-voices) 56 (w3-d-s-var-def w3-active-voices)
51 (w3-d-s-var-def w3-current-form-number) 57 (w3-d-s-var-def w3-current-form-number)
52 (w3-d-s-var-def w3-face-font-family) 58 (w3-d-s-var-def w3-face-font-family)
53 (w3-d-s-var-def w3-face-font-weight) 59 (w3-d-s-var-def w3-face-font-weight)
54 (w3-d-s-var-def w3-face-font-variant) 60 (w3-d-s-var-def w3-face-font-variant)
55 (w3-d-s-var-def w3-face-font-size) 61 (w3-d-s-var-def w3-face-font-size)
56 (w3-d-s-var-def w3-face-font-family) 62 (w3-d-s-var-def w3-face-font-family)
57 (w3-d-s-var-def w3-face-font-size) 63 (w3-d-s-var-def w3-face-font-size)
64 (w3-d-s-var-def w3-face-font-style)
58 (w3-d-s-var-def w3-face-font-spec) 65 (w3-d-s-var-def w3-face-font-spec)
59 (w3-d-s-var-def w3-face-text-decoration) 66 (w3-d-s-var-def w3-face-text-decoration)
60 (w3-d-s-var-def w3-face-face) 67 (w3-d-s-var-def w3-face-face)
61 (w3-d-s-var-def w3-face-descr) 68 (w3-d-s-var-def w3-face-descr)
62 (w3-d-s-var-def w3-face-pixmap) 69 (w3-d-s-var-def w3-face-pixmap)
77 84
78 (defmacro w3-get-all-face-info () 85 (defmacro w3-get-all-face-info ()
79 (` 86 (`
80 (progn 87 (progn
81 (w3-get-face-info font-family) 88 (w3-get-face-info font-family)
89 (w3-get-face-info font-style)
82 (w3-get-face-info font-weight) 90 (w3-get-face-info font-weight)
83 (w3-get-face-info font-variant) 91 (w3-get-face-info font-variant)
84 (w3-get-face-info font-size) 92 (w3-get-face-info font-size)
85 (w3-get-face-info text-decoration) 93 (w3-get-face-info text-decoration)
86 ;;(w3-get-face-info pixmap) 94 ;;(w3-get-face-info pixmap)
87 (w3-get-face-info color) 95 (w3-get-face-info color)
88 (w3-get-face-info background) 96 (w3-get-face-info background-color)
89 (setq w3-face-font-spec (make-font 97 (setq w3-face-font-spec (make-font
90 :weight (car w3-face-font-weight) 98 :weight (car w3-face-font-weight)
91 :family (car w3-face-font-family) 99 :family (car w3-face-font-family)
92 :size (car w3-face-font-size)))))) 100 :size (car w3-face-font-size))))))
93 101
96 (progn 104 (progn
97 (w3-pop-face-info font-family) 105 (w3-pop-face-info font-family)
98 (w3-pop-face-info font-weight) 106 (w3-pop-face-info font-weight)
99 (w3-pop-face-info font-variant) 107 (w3-pop-face-info font-variant)
100 (w3-pop-face-info font-size) 108 (w3-pop-face-info font-size)
109 (w3-pop-face-info font-style)
101 (w3-pop-face-info text-decoration) 110 (w3-pop-face-info text-decoration)
102 ;;(w3-pop-face-info pixmap) 111 ;;(w3-pop-face-info pixmap)
103 (w3-pop-face-info color) 112 (w3-pop-face-info color)
104 (w3-pop-face-info background)))) 113 (w3-pop-face-info background-color))))
105 114
106 ) 115 )
107 116
117 (defvar w3-display-same-buffer nil)
108 (defvar w3-face-cache nil "Cache for w3-face-for-element") 118 (defvar w3-face-cache nil "Cache for w3-face-for-element")
109 (defvar w3-face-index 0) 119 (defvar w3-face-index 0)
110 (defvar w3-image-widgets-waiting nil) 120 (defvar w3-image-widgets-waiting nil)
111 121
112 (make-variable-buffer-local 'w3-last-fill-pos) 122 (make-variable-buffer-local 'w3-last-fill-pos)
229 (set-font-style-by-keywords w3-face-font-spec 239 (set-font-style-by-keywords w3-face-font-spec
230 (car w3-face-text-decoration))) 240 (car w3-face-text-decoration)))
231 (if w3-face-font-variant 241 (if w3-face-font-variant
232 (set-font-style-by-keywords w3-face-font-spec 242 (set-font-style-by-keywords w3-face-font-spec
233 (car w3-face-font-variant))) 243 (car w3-face-font-variant)))
244 (if w3-face-font-style
245 (set-font-style-by-keywords w3-face-font-spec
246 (car w3-face-font-style)))
234 (setq w3-face-descr (list w3-face-font-spec 247 (setq w3-face-descr (list w3-face-font-spec
235 (car w3-face-color) 248 (car w3-face-color)
236 (car w3-face-background)) 249 (car w3-face-background-color))
237 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache))) 250 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache)))
238 (if (or w3-face-face (not (or (car w3-face-color) 251 (if (or w3-face-face (not (or (car w3-face-color)
239 (car w3-face-background) 252 (car w3-face-background-color)
240 w3-face-font-spec))) 253 w3-face-font-spec)))
241 nil ; Do nothing, we got it already 254 nil ; Do nothing, we got it already
242 (setq w3-face-face 255 (setq w3-face-face
243 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index)) 256 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index))
244 "An Emacs-W3 face... don't edit by hand." t) 257 "An Emacs-W3 face... don't edit by hand." t)
245 w3-face-index (1+ w3-face-index)) 258 w3-face-index (1+ w3-face-index))
246 (if w3-face-font-spec 259 (if w3-face-font-spec
247 (set-face-font w3-face-face w3-face-font-spec)) 260 (set-face-font w3-face-face w3-face-font-spec))
248 (if (car w3-face-color) 261 (if (car w3-face-color)
249 (set-face-foreground w3-face-face (car w3-face-color))) 262 (set-face-foreground w3-face-face (car w3-face-color)))
250 (if (car w3-face-background) 263 (if (car w3-face-background-color)
251 (set-face-background w3-face-face (car w3-face-background))) 264 (set-face-background w3-face-face (car w3-face-background-color)))
252 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap) 265 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap)
253 (setq w3-face-cache (cons 266 (setq w3-face-cache (cons
254 (cons w3-face-descr w3-face-face) 267 (cons w3-face-descr w3-face-face)
255 w3-face-cache))) 268 w3-face-cache)))
256 w3-face-face) 269 w3-face-face)
272 285
273 (defvar w3-bullets 286 (defvar w3-bullets
274 '((disc . ?*) 287 '((disc . ?*)
275 (circle . ?o) 288 (circle . ?o)
276 (square . ?#) 289 (square . ?#)
290 (none . ? )
277 ) 291 )
278 "*An assoc list of unordered list types mapping to characters to use 292 "*An assoc list of unordered list types mapping to characters to use
279 as the bullet character.") 293 as the bullet character.")
280 294
281 295
355 (if (car w3-active-voices) 369 (if (car w3-active-voices)
356 (add-text-properties w3-scratch-start-point (point) 370 (add-text-properties w3-scratch-start-point (point)
357 (list 'personality (car w3-active-voices)))) 371 (list 'personality (car w3-active-voices))))
358 ) 372 )
359 373
374 (defun w3-display-get-cookie (args)
375 (if (not (fboundp 'cookie))
376 "Sorry, no cookies today."
377 (let* ((href (or (w3-get-attribute 'href) (w3-get-attribute 'src)))
378 (fname (or (cdr-safe (assoc href w3-cookie-cache))
379 (url-generate-unique-filename "%s.cki")))
380 (st (or (cdr-safe (assq 'start args)) "Loading cookies..."))
381 (nd (or (cdr-safe (assq 'end args)) "Loading cookies... done.")))
382 (if (not (file-exists-p fname))
383 (save-excursion
384 (set-buffer (generate-new-buffer " *cookie*"))
385 (url-insert-file-contents href)
386 (write-region (point-min) (point-max) fname 5)
387 (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache))))
388 (cookie fname st nd))))
389
360 (defun w3-widget-echo (widget &rest ignore) 390 (defun w3-widget-echo (widget &rest ignore)
361 (let ((href (widget-get widget 'href)) 391 (let ((url (widget-get widget 'href))
362 (name (widget-get widget 'name)) 392 (name (widget-get widget 'name))
363 (text (buffer-substring (widget-get widget :from) 393 (text (buffer-substring (widget-get widget :from)
364 (widget-get widget :to))) 394 (widget-get widget :to)))
365 (title (widget-get widget 'title)) 395 (title (widget-get widget 'title))
396 (check w3-echo-link)
366 (msg nil)) 397 (msg nil))
367 (if href 398 (if url
368 (setq href (url-truncate-url-for-viewing href))) 399 (setq url (url-truncate-url-for-viewing url)))
369 (if name 400 (if name
370 (setq name (concat "anchor:" name))) 401 (setq name (concat "anchor:" name)))
371 (case w3-echo-link 402 (if (not (listp check))
372 (url (or href title text name)) 403 (setq check (cons check '(title url text name))))
373 (text (or text title href name)) 404 (catch 'exit
374 (title (or title text href name)) 405 (while check
375 (otherwise nil)))) 406 (and (boundp (car check))
407 (stringp (symbol-value (car check)))
408 (throw 'exit (symbol-value (car check))))
409 (pop check)))))
376 410
377 (defun w3-follow-hyperlink (widget &rest ignore) 411 (defun w3-follow-hyperlink (widget &rest ignore)
378 (let* ((target (widget-get widget 'target)) 412 (let* ((target (widget-get widget 'target))
379 (href (widget-get widget 'href))) 413 (href (widget-get widget 'href)))
380 (if target (setq target (intern (downcase target)))) 414 (if target (setq target (intern (downcase target))))
421 455
422 (defmacro w3-display-handle-list-type () 456 (defmacro w3-display-handle-list-type ()
423 (` 457 (`
424 (case (car break-style) 458 (case (car break-style)
425 (list-item 459 (list-item
426 (let ((list-style (w3-get-style-info 'list-style node)) 460 (let ((list-style (w3-get-style-info 'list-style-type node))
427 (list-num (if (car w3-display-list-stack) 461 (list-num (if (car w3-display-list-stack)
428 (incf (car w3-display-list-stack)) 462 (incf (car w3-display-list-stack))
429 1)) 463 1))
430 (margin (1- (car left-margin-stack))) 464 (margin (1- (car left-margin-stack)))
431 (indent (w3-get-style-info 'text-indent node 0))) 465 (indent (w3-get-style-info 'text-indent node 0)))
570 (cons (cons type (list (cons desc (list plist)))) 604 (cons (cons type (list (cons desc (list plist))))
571 w3-current-links))))) 605 w3-current-links)))))
572 (setq desc (and desc (intern dc-desc))) 606 (setq desc (and desc (intern dc-desc)))
573 (case desc 607 (case desc
574 ((style stylesheet) 608 ((style stylesheet)
575 (w3-handle-style args)) 609 (w3-handle-style plist))
576 (otherwise 610 (otherwise
577 ) 611 )
578 ) 612 )
579 ) 613 )
580 ) 614 )
689 (base (w3-get-attribute 'base)) 723 (base (w3-get-attribute 'base))
690 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) 724 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
691 (widget nil) 725 (widget nil)
692 (align (or (w3-get-attribute 'align) 726 (align (or (w3-get-attribute 'align)
693 (w3-get-style-info 'vertical-align node)))) 727 (w3-get-style-info 'vertical-align node))))
694 (setq widget (widget-create 'image 728 (if (assq '*table-autolayout w3-display-open-element-stack)
695 :value-face w3-active-faces 729 (insert alt)
696 'src src ; Where to load the image from 730 (setq widget (widget-create 'image
697 'alt alt ; Textual replacement 731 :value-face w3-active-faces
698 'ismap ismap ; Is it a server-side map? 732 'src src ; Where to load the image from
699 'usemap usemap ; Is it a client-side map? 733 'alt alt ; Textual replacement
700 'href href ; Hyperlink destination 734 'ismap ismap ; Is it a server-side map?
701 )) 735 'usemap usemap ; Is it a client-side map?
702 (widget-put widget 'buffer (current-buffer)) 736 'href href ; Hyperlink destination
703 (w3-maybe-start-image-download widget) 737 ))
704 (goto-char (point-max))))) 738 (widget-put widget 'buffer (current-buffer))
739 (w3-maybe-start-image-download widget)
740 (goto-char (point-max))))))
705 741
706 ;; The table handling 742 ;; The table handling
707 743
708 (defvar w3-display-table-cut-words-p nil 744 (defvar w3-display-table-cut-words-p nil
709 "*Whether to cut words that are oversized in table cells") 745 "*Whether to cut words that are oversized in table cells")
1387 (aref timeinfo 1) ; Minute 1423 (aref timeinfo 1) ; Minute
1388 (aref timeinfo 2) ; Second 1424 (aref timeinfo 2) ; Second
1389 ) 1425 )
1390 "HoplesSLYCoNfUSED"))) 1426 "HoplesSLYCoNfUSED")))
1391 1427
1428 (defun w3-display-chop-into-table (node cols)
1429 ;; Chop the content of 'node' up into 'cols' columns suitable for inclusion
1430 ;; as the content of a table
1431 (let ((content (nth 2 node))
1432 (items nil)
1433 (rows nil))
1434 (setq cols (max cols 1))
1435 (while content
1436 (push (list 'td nil (list (pop content))) items)
1437 (if (= (length items) cols)
1438 (setq rows (cons (nreverse items) rows)
1439 items nil)))
1440 (if items ; Store any leftovers
1441 (setq rows (cons (nreverse items) rows)
1442 items nil))
1443 (while rows
1444 (push (list 'tr nil (pop rows)) items))
1445 items))
1446
1447 (defun w3-display-normalize-form-info (args)
1448 (let* ((plist (alist-to-plist args))
1449 (type (intern (downcase
1450 (or (plist-get plist 'type) "text"))))
1451 (name (plist-get plist 'name))
1452 (value (or (plist-get plist 'value) ""))
1453 (size (if (plist-get plist 'size)
1454 (string-to-int (plist-get plist 'size))))
1455 (maxlength (if (plist-get plist 'maxlength)
1456 (string-to-int
1457 (plist-get plist 'maxlength))))
1458 (default value)
1459 (checked (assq 'checked args)))
1460 (if (memq type '(checkbox radio)) (setq default checked))
1461 (if (and (eq type 'checkbox) (string= value ""))
1462 (setq value "on"))
1463 (if (and (not (memq type '(submit reset button)))
1464 (not name))
1465 (setq name (symbol-name type)))
1466 (while (and name (string-match "[\r\n]+" name))
1467 (setq name (concat (substring name 0 (match-beginning 0))
1468 (substring name (match-end 0) nil))))
1469 (setq plist (plist-put plist 'type type)
1470 plist (plist-put plist 'name name)
1471 plist (plist-put plist 'value value)
1472 plist (plist-put plist 'size size)
1473 plist (plist-put plist 'default default)
1474 plist (plist-put plist 'internal-form-number w3-current-form-number)
1475 plist (plist-put plist 'action w3-display-form-id)
1476 plist (plist-put plist 'maxlength maxlength))
1477 plist))
1478
1392 (defun w3-display-node (node &optional nofaces) 1479 (defun w3-display-node (node &optional nofaces)
1393 (let ( 1480 (let (
1394 (content-stack (list (list node))) 1481 (content-stack (list (list node)))
1395 (right-margin-stack (list fill-column)) 1482 (right-margin-stack (list fill-column))
1396 (left-margin-stack (list 0)) 1483 (left-margin-stack (list 0))
1419 nil 1506 nil
1420 (add-text-properties (car hyperlink-info) (point) 1507 (add-text-properties (car hyperlink-info) (point)
1421 (list 1508 (list
1422 'mouse-face 'highlight 1509 'mouse-face 'highlight
1423 'duplicable t 1510 'duplicable t
1511 'start-open t
1512 'end-open t
1513 'rear-nonsticky t
1424 'help-echo 'w3-balloon-help-callback 1514 'help-echo 'w3-balloon-help-callback
1425 'balloon-help 'w3-balloon-help-callback)) 1515 'balloon-help 'w3-balloon-help-callback))
1426 (fillin-text-property (car hyperlink-info) (point) 1516 (fillin-text-property (car hyperlink-info) (point)
1427 'button 'button (cadr hyperlink-info)) 1517 'button 'button (cadr hyperlink-info))
1428 (widget-put (cadr hyperlink-info) :to (set-marker 1518 (widget-put (cadr hyperlink-info) :to (set-marker
1429 (make-marker) (point)))) 1519 (make-marker) (point))))
1430 (setq hyperlink-info nil)) 1520 (setq hyperlink-info nil))
1431 (form
1432 (pop w3-display-form-stack))
1433 ((ol ul dl dir menu) 1521 ((ol ul dl dir menu)
1434 (pop w3-display-list-stack)) 1522 (pop w3-display-list-stack))
1435 (otherwise 1523 (otherwise
1436 nil)) 1524 nil))
1437 (if (car insert-after) 1525 (if (car insert-after)
1452 ;; This little bit of magic takes care of inline styles. 1540 ;; This little bit of magic takes care of inline styles.
1453 ;; Evil Evil Evil, but it appears to work. 1541 ;; Evil Evil Evil, but it appears to work.
1454 (if (w3-get-attribute 'style) 1542 (if (w3-get-attribute 'style)
1455 (let ((unique-id (or (w3-get-attribute 'id) 1543 (let ((unique-id (or (w3-get-attribute 'id)
1456 (w3-display-create-unique-id))) 1544 (w3-display-create-unique-id)))
1457 (sheet "")) 1545 (sheet "")
1546 (class (assq 'class args)))
1458 (setq sheet (format "%s.%s { %s }\n" tag unique-id 1547 (setq sheet (format "%s.%s { %s }\n" tag unique-id
1459 (w3-get-attribute 'style))) 1548 (w3-get-attribute 'style)))
1460 (setf (nth 1 node) (cons (cons 'id unique-id) args)) 1549 (if class
1461 (w3-handle-style (list (cons 'data sheet) 1550 (setcdr class (cons unique-id (cdr class)))
1462 (cons 'notation "css"))))) 1551 (setf (nth 1 node) (cons (cons 'class (list unique-id))
1552 (nth 1 node))))
1553 (setf (nth 1 node) (cons (cons 'id unique-id) (nth 1 node)))
1554 (w3-handle-style (list 'data sheet
1555 'notation "css"))))
1463 (setq w3-display-css-properties (css-get 1556 (setq w3-display-css-properties (css-get
1464 (nth 0 node) (nth 1 node) 1557 (nth 0 node)
1558 (nth 1 node)
1465 w3-current-stylesheet 1559 w3-current-stylesheet
1466 w3-display-open-element-stack)) 1560 w3-display-open-element-stack))
1467 (if nofaces 1561 (if nofaces
1468 nil 1562 nil
1469 (push (w3-face-for-element node) w3-active-faces) 1563 (push (w3-face-for-element node) w3-active-faces)
1512 ) 1606 )
1513 (alist-to-plist args)))) 1607 (alist-to-plist args))))
1514 (w3-handle-content node) 1608 (w3-handle-content node)
1515 ) 1609 )
1516 ) 1610 )
1517 ((ol ul dl dir menu) 1611 ((ol ul dl menu)
1518 (push 0 w3-display-list-stack) 1612 (push 0 w3-display-list-stack)
1613 (w3-handle-content node))
1614 (dir
1615 (push 0 w3-display-list-stack)
1616 (setq node
1617 (list tag args
1618 (list
1619 (list 'table nil
1620 (w3-display-chop-into-table node 3)))))
1621 (w3-handle-content node))
1622 (multicol
1623 (setq node (list tag args
1624 (list
1625 (list 'table nil
1626 (w3-display-chop-into-table node 2)))))
1519 (w3-handle-content node)) 1627 (w3-handle-content node))
1520 (img ; inlined image 1628 (img ; inlined image
1521 (w3-handle-image) 1629 (w3-handle-image)
1522 (w3-handle-empty-tag)) 1630 (w3-handle-empty-tag))
1523 (script ; Scripts 1631 (script ; Scripts
1563 ) 1671 )
1564 (nth 2 node)))) 1672 (nth 2 node))))
1565 (setq w3-imagemaps (cons (cons name areas) w3-imagemaps))) 1673 (setq w3-imagemaps (cons (cons name areas) w3-imagemaps)))
1566 (w3-handle-empty-tag) 1674 (w3-handle-empty-tag)
1567 ) 1675 )
1568 (table ; Yeeee-hah! 1676 (note
1677 ;; Ewwwwhhh. Looks gross, but it works. This converts a
1678 ;; <note> into a two-cell table, so that things look all
1679 ;; pretty.
1680 (setq node
1681 (list 'note nil
1682 (list
1683 (list 'table nil
1684 (list
1685 (list 'tr nil
1686 (list
1687 (list 'td (list 'align 'right)
1688 (list
1689 (concat
1690 (or (w3-get-attribute 'role)
1691 "CAUTION") ":")))
1692 (list 'td nil
1693 (nth 2 node)))))))))
1694 (w3-handle-content node)
1695 )
1696 (table
1569 (w3-display-table node) 1697 (w3-display-table node)
1570 (setq w3-last-fill-pos (point)) 1698 (setq w3-last-fill-pos (point))
1571 (w3-handle-empty-tag) 1699 (w3-handle-empty-tag)
1572 ) 1700 )
1573 (isindex 1701 (isindex
1597 (setq w3-current-isindex (cons action prompt))) 1725 (setq w3-current-isindex (cons action prompt)))
1598 ) 1726 )
1599 (*document 1727 (*document
1600 (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) 1728 (let ((info (mapcar (lambda (x) (cons x (symbol-value x)))
1601 w3-persistent-variables))) 1729 w3-persistent-variables)))
1602 (set-buffer (generate-new-buffer "Untitled")) 1730 (if (not w3-display-same-buffer)
1731 (set-buffer (generate-new-buffer "Untitled")))
1603 (setq w3-current-form-number 0 1732 (setq w3-current-form-number 0
1604 w3-display-open-element-stack nil 1733 w3-display-open-element-stack nil
1605 w3-last-fill-pos (point-min) 1734 w3-last-fill-pos (point-min)
1606 fill-column (min (- (or w3-strict-width (window-width)) 1735 fill-column (min (- (or w3-strict-width (window-width))
1607 w3-right-margin) 1736 w3-right-margin)
1611 (buffer-disable-undo (current-buffer)) 1740 (buffer-disable-undo (current-buffer))
1612 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) 1741 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
1613 ;; ACK! We don't like filladapt mode! 1742 ;; ACK! We don't like filladapt mode!
1614 (set (make-local-variable 'filladapt-mode) nil) 1743 (set (make-local-variable 'filladapt-mode) nil)
1615 (set (make-local-variable 'adaptive-fill-mode) nil) 1744 (set (make-local-variable 'adaptive-fill-mode) nil)
1745 (set (make-local-variable 'voice-lock-mode) t)
1616 (setq w3-current-stylesheet (css-copy-stylesheet 1746 (setq w3-current-stylesheet (css-copy-stylesheet
1617 w3-user-stylesheet) 1747 w3-user-stylesheet)
1618 w3-last-fill-pos (point) 1748 w3-last-fill-pos (point)
1619 fill-column (min (- (or w3-strict-width (window-width)) 1749 fill-column (min (- (or w3-strict-width (window-width))
1620 w3-right-margin) 1750 w3-right-margin)
1658 (content (nth 2 node))) 1788 (content (nth 2 node)))
1659 (while content 1789 (while content
1660 (setq potential-title (concat potential-title (car content)) 1790 (setq potential-title (concat potential-title (car content))
1661 content (cdr content))) 1791 content (cdr content)))
1662 (setq potential-title (w3-normalize-spaces potential-title)) 1792 (setq potential-title (w3-normalize-spaces potential-title))
1663 (if (string-match "^[ \t]*$" potential-title) 1793 (if (or w3-display-same-buffer
1794 (string-match "^[ \t]*$" potential-title))
1664 nil 1795 nil
1665 (rename-buffer (generate-new-buffer-name 1796 (rename-buffer (generate-new-buffer-name
1666 (w3-fix-spaces potential-title))))) 1797 (w3-fix-spaces potential-title)))))
1667 (w3-handle-empty-tag)) 1798 (w3-handle-empty-tag))
1668 (form 1799 (form
1670 (let* ( 1801 (let* (
1671 (action (w3-get-attribute 'action)) 1802 (action (w3-get-attribute 'action))
1672 (url nil)) 1803 (url nil))
1673 (if (not action) 1804 (if (not action)
1674 (setq args (cons (cons 'action (url-view-url t)) args))) 1805 (setq args (cons (cons 'action (url-view-url t)) args)))
1675 (push (cons 1806 (setq w3-display-form-id (cons
1676 (cons 'form-number 1807 (cons 'form-number
1677 w3-current-form-number) 1808 w3-current-form-number)
1678 args) w3-display-form-stack) 1809 args))
1679 (w3-handle-content node))) 1810 (w3-handle-content node)))
1811 (keygen
1812 (w3-form-add-element 'keygen
1813 (or (w3-get-attribute 'name)
1814 (w3-get-attribute 'id)
1815 "keygen")
1816 nil ; value
1817 nil ; size
1818 nil ; maxlength
1819 nil ; default
1820 w3-display-form-id ; action
1821 nil ; options
1822 w3-current-form-number
1823 (w3-get-attribute 'id) ; id
1824 nil ; checked
1825 (car w3-active-faces)))
1680 (input 1826 (input
1681 (if (not (assq 'form w3-display-open-element-stack)) 1827 (w3-form-add-element
1682 (message "Input field outside of a <form>") 1828 (w3-display-normalize-form-info args)
1683 (let* ( 1829 (car w3-active-faces))
1684 (type (intern (downcase (or (w3-get-attribute 'type)
1685 "text"))))
1686 (name (w3-get-attribute 'name))
1687 (value (or (w3-get-attribute 'value) ""))
1688 (size (if (w3-get-attribute 'size)
1689 (string-to-int (w3-get-attribute 'size))))
1690 (maxlength (cdr (assoc 'maxlength args)))
1691 (default value)
1692 (action (car w3-display-form-stack))
1693 (options)
1694 (id (w3-get-attribute 'id))
1695 (checked (assq 'checked args)))
1696 (if (and (string-match "^[ \t\n\r]+$" value)
1697 (not (eq type 'hidden)))
1698 (setq value ""))
1699 (if maxlength (setq maxlength (string-to-int maxlength)))
1700 (if (and name (string-match "[\r\n]" name))
1701 (setq name (mapconcat (function
1702 (lambda (x)
1703 (if (memq x '(?\r ?\n))
1704 ""
1705 (char-to-string x))))
1706 name "")))
1707 (if (memq type '(checkbox radio)) (setq default checked))
1708 (if (and (eq type 'checkbox) (string= value ""))
1709 (setq value "on"))
1710 (w3-form-add-element type name
1711 value size maxlength default action
1712 options w3-current-form-number id checked
1713 (car w3-active-faces))
1714 )
1715 )
1716 (w3-handle-empty-tag) 1830 (w3-handle-empty-tag)
1717 ) 1831 )
1718 (select 1832 (select
1719 (if (not (assq 'form w3-display-open-element-stack)) 1833 (let* ((plist (w3-display-normalize-form-info args))
1720 (message "Input field outside of a <form>") 1834 (tmp nil)
1721 (let* ( 1835 (multiple (assq 'multiple args))
1722 (name (w3-get-attribute 'name)) 1836 (value nil)
1723 (size (string-to-int (or (w3-get-attribute 'size) 1837 (name (plist-get plist 'name))
1724 "20"))) 1838 (options (mapcar
1725 (maxlength (cdr (assq 'maxlength args))) 1839 (function
1726 (value nil) 1840 (lambda (n)
1727 (tmp nil) 1841 (setq tmp (w3-normalize-spaces
1728 (action (car w3-display-form-stack)) 1842 (apply 'concat (nth 2 n)))
1729 (options) 1843 tmp (cons tmp
1730 (id (w3-get-attribute 'id)) 1844 (or
1731 (checked (assq 'checked args))) 1845 (cdr-safe
1732 (if maxlength (setq maxlength (string-to-int maxlength))) 1846 (assq 'value (nth 1 n)))
1733 (if (and name (string-match "[\r\n]" name)) 1847 tmp)))
1734 (setq name (mapconcat (function 1848 (if (assq 'selected (nth 1 n))
1735 (lambda (x) 1849 (setq value (car tmp)))
1736 (if (memq x '(?\r ?\n)) 1850 tmp))
1737 "" 1851 (nth 2 node))))
1738 (char-to-string x)))) 1852 (if (not value)
1739 name ""))) 1853 (setq value (caar options)))
1740 (setq options 1854 (setq plist (plist-put plist 'value value))
1741 (mapcar 1855 (if multiple
1742 (function 1856 (progn
1743 (lambda (n) 1857 (setq options
1744 (setq tmp (w3-normalize-spaces 1858 (mapcar
1745 (apply 'concat (nth 2 n))) 1859 (function
1746 tmp (cons tmp 1860 (lambda (opt)
1747 (or 1861 (list 'div nil
1748 (cdr-safe (assq 'value (nth 1 n))) 1862 (list
1749 tmp))) 1863 (list 'input
1750 (if (assq 'selected (nth 1 n)) 1864 (list (cons 'name name)
1751 (setq value (car tmp))) 1865 (cons 'type "checkbox")
1752 tmp)) 1866 (cons 'value (car opt))))
1753 (nth 2 node))) 1867 " " (car opt) (list 'br nil nil)))))
1754 (if (not value) 1868 options))
1755 (setq value (caar options))) 1869 (setq node (list 'p nil options))
1756 (w3-form-add-element 'option name 1870 (w3-handle-content node))
1757 value size maxlength value action 1871 (setq plist (plist-put plist 'type 'option)
1758 options w3-current-form-number id nil 1872 plist (plist-put plist 'options options))
1759 (car w3-active-faces)) 1873 (w3-form-add-element plist (car w3-active-faces))
1760 ;; This should really not be necessary, but some versions 1874 ;; This should really not be necessary, but some versions
1761 ;; of the widget library leave point _BEFORE_ the menu 1875 ;; of the widget library leave point _BEFORE_ the menu
1762 ;; widget instead of after. 1876 ;; widget instead of after.
1763 (goto-char (point-max)) 1877 (goto-char (point-max))
1764 ) 1878 (w3-handle-empty-tag))))
1765 )
1766 (w3-handle-empty-tag)
1767 )
1768 (textarea 1879 (textarea
1769 (if (not (assq 'form w3-display-open-element-stack)) 1880 (let* ((plist (w3-display-normalize-form-info args))
1770 (message "Input field outside of a <form>") 1881 (value (w3-normalize-spaces
1771 (let* ( 1882 (apply 'concat (nth 2 node)))))
1772 (name (w3-get-attribute 'name)) 1883 (setq plist (plist-put plist 'type 'multiline)
1773 (size (string-to-int (or (w3-get-attribute 'size) 1884 plist (plist-put plist 'value value))
1774 "20"))) 1885 (w3-form-add-element plist (car w3-active-faces)))
1775 (maxlength (cdr (assq 'maxlength args)))
1776 (value (w3-normalize-spaces
1777 (apply 'concat (nth 2 node))))
1778 (default value)
1779 (tmp nil)
1780 (action (car w3-display-form-stack))
1781 (options)
1782 (id (w3-get-attribute 'id))
1783 (checked (assq 'checked args)))
1784 (if maxlength (setq maxlength (string-to-int maxlength)))
1785 (if (and name (string-match "[\r\n]" name))
1786 (setq name (mapconcat (function
1787 (lambda (x)
1788 (if (memq x '(?\r ?\n))
1789 ""
1790 (char-to-string x))))
1791 name "")))
1792 (w3-form-add-element 'multiline name
1793 value size maxlength value action
1794 options w3-current-form-number id nil
1795 (car w3-active-faces))
1796 )
1797 )
1798 (w3-handle-empty-tag) 1886 (w3-handle-empty-tag)
1799 ) 1887 )
1800 (style 1888 (style
1801 (w3-handle-style (cons (cons 'data (apply 'concat (nth 2 node))) 1889 (w3-handle-style (alist-to-plist
1802 (nth 1 node))) 1890 (cons (cons 'data (apply 'concat (nth 2 node)))
1891 (nth 1 node))))
1803 (w3-handle-empty-tag)) 1892 (w3-handle-empty-tag))
1893 ;; Emacs-W3 stuff that cannot be expressed in a stylesheet
1894 (pinhead
1895 ;; This check is so that we don't screw up table auto-layout
1896 ;; by changing our text midway through the parse/layout/display
1897 ;; steps.
1898 (if (nth 2 node)
1899 nil
1900 (setcar (cddr node)
1901 (list
1902 (if (fboundp 'yow)
1903 (yow)
1904 "AIEEEEE! I am having an UNDULATING EXPERIENCE!"))))
1905 (w3-handle-content node))
1906 (flame
1907 (if (nth 2 node)
1908 nil
1909 (setcar
1910 (cddr node)
1911 (list
1912 (condition-case ()
1913 (concat
1914 (sentence-ify
1915 (string-ify
1916 (append-suffixes-hack (flatten (*flame))))))
1917 (error
1918 "You know, everything is really a graphics editor.")))))
1919 (w3-handle-content node))
1920 (cookie
1921 (if (nth 2 node)
1922 nil
1923 (setcar
1924 (cddr node)
1925 (list
1926 (w3-display-get-cookie args))))
1927 (w3-handle-content node))
1928 ;; Generic formatting - all things that can be fully specified
1929 ;; by a CSS stylesheet.
1804 (otherwise 1930 (otherwise
1805 ;; Generic formatting
1806 (w3-handle-content node)) 1931 (w3-handle-content node))
1807 ) ; case tag 1932 ) ; case tag
1808 ) ; stringp content 1933 ) ; stringp content
1809 ) ; while content 1934 ) ; while content
1810 ) ; while content-stack 1935 ) ; while content-stack
1827 (w3-draw-tree (or tree w3-last-parse-tree)) 1952 (w3-draw-tree (or tree w3-last-parse-tree))
1828 (setq nd (nth 1 (current-time))) 1953 (setq nd (nth 1 (current-time)))
1829 (- nd st))) 1954 (- nd st)))
1830 1955
1831 1956
1957 (defsubst w3-finish-drawing ()
1958 (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting)
1959 (let (url glyph widget)
1960 (while w3-image-widgets-waiting
1961 (setq widget (car w3-image-widgets-waiting)
1962 w3-image-widgets-waiting (cdr w3-image-widgets-waiting)
1963 url (widget-get widget 'src)
1964 glyph (cdr-safe (assoc url w3-graphics-list)))
1965 (widget-value-set widget glyph)))
1966 ;;(w3-handle-annotations)
1967 ;;(w3-handle-headers)
1968 )
1969 )
1970
1971 (defun w3-region (st nd)
1972 (if (not w3-setup-done) (w3-do-setup))
1973 (let* ((source (buffer-substring st nd))
1974 (w3-display-same-buffer t)
1975 (parse nil))
1976 (save-excursion
1977 (set-buffer (get-buffer-create " *w3-region*"))
1978 (erase-buffer)
1979 (insert source)
1980 (setq parse (w3-parse-buffer (current-buffer))))
1981 (narrow-to-region st nd)
1982 (delete-region (point-min) (point-max))
1983 (w3-draw-tree parse)
1984 (w3-finish-drawing)))
1985
1986 (defun w3-refresh-buffer ()
1987 (interactive)
1988 (let ((parse w3-current-parse)
1989 (inhibit-read-only t)
1990 (w3-display-same-buffer t))
1991 (if (not parse)
1992 (error "Could not find the parse tree for this buffer. EEEEK!"))
1993 (erase-buffer)
1994 (w3-draw-tree parse)
1995 (w3-finish-drawing)
1996 (w3-mode)
1997 (set-buffer-modified-p nil)))
1998
1832 (defun w3-prepare-buffer (&rest args) 1999 (defun w3-prepare-buffer (&rest args)
1833 ;; The text/html viewer - does all the drawing and displaying of the buffer 2000 ;; 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. 2001 ;; that is necessary to go from raw HTML to a good presentation.
1835 (let* ((source (buffer-string)) 2002 (let* ((source (buffer-string))
1836 (source-buf (current-buffer)) 2003 (source-buf (current-buffer))
1839 (w3-draw-tree parse) 2006 (w3-draw-tree parse)
1840 (kill-buffer source-buf) 2007 (kill-buffer source-buf)
1841 (set-buffer-modified-p nil) 2008 (set-buffer-modified-p nil)
1842 (setq w3-current-source source 2009 (setq w3-current-source source
1843 w3-current-parse parse) 2010 w3-current-parse parse)
1844 (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting) 2011 (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) 2012 (w3-mode)
1853 ;;(w3-handle-annotations)
1854 ;;(w3-handle-headers)
1855 (set-buffer-modified-p nil) 2013 (set-buffer-modified-p nil)
1856 (goto-char (point-min)) 2014 (goto-char (point-min))
1857 (if url-keep-history 2015 (if url-keep-history
1858 (let ((url (url-view-url t))) 2016 (let ((url (url-view-url t)))
1859 (if (not url-history-list) 2017 (if (not url-history-list)