Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents a145efe76779
children fe104dbd9147
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
1 ;;; w3-display.el --- display engine v99999 1 ;;; w3-display.el --- display engine v99999
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/20 21:48:44 3 ;; Created: 1997/03/06 04:12:42
4 ;; Version: 1.135 4 ;; Version: 1.144
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.
40 (defvar w3-cookie-cache nil) 40 (defvar w3-cookie-cache nil)
41 41
42 (defmacro w3-d-s-var-def (var) 42 (defmacro w3-d-s-var-def (var)
43 (` (make-variable-buffer-local (defvar (, var) nil)))) 43 (` (make-variable-buffer-local (defvar (, var) nil))))
44 44
45 (w3-d-s-var-def w3-display-label-marker)
45 (w3-d-s-var-def w3-display-open-element-stack) 46 (w3-d-s-var-def w3-display-open-element-stack)
46 (w3-d-s-var-def w3-display-alignment-stack) 47 (w3-d-s-var-def w3-display-alignment-stack)
47 (w3-d-s-var-def w3-display-list-stack) 48 (w3-d-s-var-def w3-display-list-stack)
48 (w3-d-s-var-def w3-display-form-id) 49 (w3-d-s-var-def w3-display-form-id)
49 (w3-d-s-var-def w3-display-whitespace-stack) 50 (w3-d-s-var-def w3-display-whitespace-stack)
256 (setq w3-face-face 257 (setq w3-face-face
257 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index)) 258 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index))
258 "An Emacs-W3 face... don't edit by hand." t) 259 "An Emacs-W3 face... don't edit by hand." t)
259 w3-face-index (1+ w3-face-index)) 260 w3-face-index (1+ w3-face-index))
260 (if w3-face-font-spec 261 (if w3-face-font-spec
261 (set-face-font w3-face-face w3-face-font-spec)) 262 (font-set-face-font w3-face-face w3-face-font-spec))
262 (if (car w3-face-color) 263 (if (car w3-face-color)
263 (set-face-foreground w3-face-face (car w3-face-color))) 264 (font-set-face-foreground w3-face-face (car w3-face-color)))
264 (if (car w3-face-background-color) 265 (if (car w3-face-background-color)
265 (set-face-background w3-face-face (car w3-face-background-color))) 266 (font-set-face-background w3-face-face (car w3-face-background-color)))
266 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap) 267 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap)
267 (setq w3-face-cache (cons 268 (setq w3-face-cache (cons
268 (cons w3-face-descr w3-face-face) 269 (cons w3-face-descr w3-face-face)
269 w3-face-cache))) 270 w3-face-cache)))
270 w3-face-face) 271 w3-face-face)
409 (setq check (cons check '(title url text name)))) 410 (setq check (cons check '(title url text name))))
410 (catch 'exit 411 (catch 'exit
411 (while check 412 (while check
412 (and (boundp (car check)) 413 (and (boundp (car check))
413 (stringp (symbol-value (car check))) 414 (stringp (symbol-value (car check)))
415 (> (length (symbol-value (car check))) 0)
414 (throw 'exit (symbol-value (car check)))) 416 (throw 'exit (symbol-value (car check))))
415 (pop check))))) 417 (pop check)))))
416 418
417 (defun w3-follow-hyperlink (widget &rest ignore) 419 (defun w3-follow-hyperlink (widget &rest ignore)
418 (let* ((target (or (widget-get widget 'target) 420 (let* ((target (or (widget-get widget 'target)
424 (w3-fetch-other-frame href)) 426 (w3-fetch-other-frame href))
425 (_top 427 (_top
426 (delete-other-windows) 428 (delete-other-windows)
427 (w3-fetch href)) 429 (w3-fetch href))
428 (otherwise 430 (otherwise
429 (and target 431 (w3-fetch href target)))))
430 (let ((window-distance (cdr-safe (assq target w3-target-window-distances))))
431 (if (numberp window-distance)
432 (other-window window-distance)
433 (error "target %S not found." target))))
434 (w3-fetch href)))))
435 432
436 (defun w3-balloon-help-callback (object &optional event) 433 (defun w3-balloon-help-callback (object &optional event)
437 (let* ((widget (widget-at (extent-start-position object))) 434 (let* ((widget (widget-at (extent-start-position object)))
438 (href (and widget (widget-get widget 'href)))) 435 (href (and widget (widget-get widget 'href))))
439 (if href 436 (if href
620 (cons (cons type (list (cons desc (list plist)))) 617 (cons (cons type (list (cons desc (list plist))))
621 w3-current-links))))) 618 w3-current-links)))))
622 (setq desc (and desc (intern dc-desc))) 619 (setq desc (and desc (intern dc-desc)))
623 (case desc 620 (case desc
624 ((style stylesheet) 621 ((style stylesheet)
625 (w3-handle-style plist)) 622 (if w3-honor-stylesheets
623 (w3-handle-style plist)))
626 (otherwise 624 (otherwise
627 ) 625 )
628 ) 626 )
629 ) 627 )
630 ) 628 )
740 (alt (or (w3-get-attribute 'alt) our-alt)) 738 (alt (or (w3-get-attribute 'alt) our-alt))
741 (ismap (and (assq 'ismap args) 'ismap)) 739 (ismap (and (assq 'ismap args) 'ismap))
742 (usemap (w3-get-attribute 'usemap)) 740 (usemap (w3-get-attribute 'usemap))
743 (base (w3-get-attribute 'base)) 741 (base (w3-get-attribute 'base))
744 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) 742 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
743 (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target)))
745 (widget nil) 744 (widget nil)
746 (align (or (w3-get-attribute 'align) 745 (align (or (w3-get-attribute 'align)
747 (w3-get-style-info 'vertical-align node)))) 746 (w3-get-style-info 'vertical-align node))))
748 (if (assq '*table-autolayout w3-display-open-element-stack) 747 (if (assq '*table-autolayout w3-display-open-element-stack)
749 (insert alt) 748 (insert alt)
752 'src src ; Where to load the image from 751 'src src ; Where to load the image from
753 'alt alt ; Textual replacement 752 'alt alt ; Textual replacement
754 'ismap ismap ; Is it a server-side map? 753 'ismap ismap ; Is it a server-side map?
755 'usemap usemap ; Is it a client-side map? 754 'usemap usemap ; Is it a client-side map?
756 'href href ; Hyperlink destination 755 'href href ; Hyperlink destination
756 'target target
757 )) 757 ))
758 (widget-put widget 'buffer (current-buffer)) 758 (widget-put widget 'buffer (current-buffer))
759 (w3-maybe-start-image-download widget) 759 (w3-maybe-start-image-download widget)
760 (if (widget-get widget :from)
761 (add-text-properties (widget-get widget :from)
762 (widget-get widget :to)
763 (list 'html-stack w3-display-open-element-stack)))
760 (goto-char (point-max)))))) 764 (goto-char (point-max))))))
761 765
762 ;; The table handling 766 ;; The table handling
763 767
764 (defvar w3-display-table-cut-words-p nil 768 (defvar w3-display-table-cut-words-p nil
1076 (x 1080 (x
1077 (let ((id (or (and (find-face 'w3-table-hack-x-face) 1081 (let ((id (or (and (find-face 'w3-table-hack-x-face)
1078 (face-id 'w3-table-hack-x-face)) 1082 (face-id 'w3-table-hack-x-face))
1079 (progn 1083 (progn
1080 (make-face 'w3-table-hack-x-face) 1084 (make-face 'w3-table-hack-x-face)
1081 (set-face-font 'w3-table-hack-x-face 1085 (font-set-face-font 'w3-table-hack-x-face
1082 (make-font :family "terminal")) 1086 (make-font :family "terminal"))
1083 (face-id 'w3-table-hack-x-face))))) 1087 (face-id 'w3-table-hack-x-face)))))
1084 (if (not (face-differs-from-default-p 'w3-table-hack-x-face)) 1088 (if (not (face-differs-from-default-p 'w3-table-hack-x-face))
1085 nil 1089 nil
1086 (aset standard-display-table 1 (vector (+ (* 256 id) ?l))) 1090 (aset standard-display-table 1 (vector (+ (* 256 id) ?l)))
1087 (aset standard-display-table 2 (vector (+ (* 256 id) ?q))) 1091 (aset standard-display-table 2 (vector (+ (* 256 id) ?q)))
1514 hyperlink-info 1518 hyperlink-info
1515 break-style 1519 break-style
1516 cur 1520 cur
1517 id 1521 id
1518 class 1522 class
1523 last-element
1519 ) 1524 )
1520 (while content-stack 1525 (while content-stack
1521 (setq content (pop content-stack)) 1526 (setq content (pop content-stack))
1522 (pop w3-active-faces) 1527 (pop w3-active-faces)
1523 (pop w3-active-voices) 1528 (pop w3-active-voices)
1524 (w3-display-progress-meter) 1529 (w3-display-progress-meter)
1525 (case (car (pop w3-display-open-element-stack)) 1530 (setq last-element (pop w3-display-open-element-stack))
1531 (case (car last-element)
1526 ;; Any weird, post-display-of-content stuff for specific tags 1532 ;; Any weird, post-display-of-content stuff for specific tags
1527 ;; goes here. Couldn't think of any better way to do this when we 1533 ;; goes here. Couldn't think of any better way to do this when we
1528 ;; are iterative. *sigh* 1534 ;; are iterative. *sigh*
1529 (a 1535 (a
1530 (if (not hyperlink-info) 1536 (if (not hyperlink-info)
1543 (widget-put (cadr hyperlink-info) :to (set-marker 1549 (widget-put (cadr hyperlink-info) :to (set-marker
1544 (make-marker) (point)))) 1550 (make-marker) (point))))
1545 (setq hyperlink-info nil)) 1551 (setq hyperlink-info nil))
1546 ((ol ul dl dir menu) 1552 ((ol ul dl dir menu)
1547 (pop w3-display-list-stack)) 1553 (pop w3-display-list-stack))
1554 (label
1555 (if (and (markerp w3-display-label-marker)
1556 (marker-position w3-display-label-marker)
1557 (marker-buffer w3-display-label-marker))
1558 (push (cons (or (cdr-safe (assq 'for (cdr last-element)))
1559 (cdr-safe (assq 'id (cdr last-element)))
1560 "unknown")
1561 (buffer-substring w3-display-label-marker (point)))
1562 w3-form-labels)))
1548 (otherwise 1563 (otherwise
1549 nil)) 1564 nil))
1550 (if (car insert-after) 1565 (if (car insert-after)
1551 (w3-handle-string-content (car insert-after))) 1566 (w3-handle-string-content (car insert-after)))
1552 (pop insert-after) 1567 (pop insert-after)
1617 (before nil) 1632 (before nil)
1618 (after nil) 1633 (after nil)
1619 (face nil) 1634 (face nil)
1620 (voice nil) 1635 (voice nil)
1621 (st nil)) 1636 (st nil))
1622 (setq st (point) 1637 (if (w3-get-attribute 'href)
1623 hyperlink-info (list 1638 (setq st (point)
1624 st 1639 hyperlink-info (list
1625 (append 1640 st
1626 (list 'link :args nil 1641 (append
1627 :value "" :tag "" 1642 (list 'link :args nil
1628 :action 'w3-follow-hyperlink 1643 :value "" :tag ""
1629 :from (set-marker (make-marker) st) 1644 :action 'w3-follow-hyperlink
1630 :help-echo 'w3-widget-echo 1645 :from (set-marker
1631 :emacspeak-help 'w3-widget-echo 1646 (make-marker) st)
1632 ) 1647 :help-echo 'w3-widget-echo
1633 (alist-to-plist args)))) 1648 :emacspeak-help 'w3-widget-echo
1649 )
1650 (alist-to-plist args)))))
1634 (w3-handle-content node) 1651 (w3-handle-content node)
1635 ) 1652 )
1636 ) 1653 )
1637 ((ol ul dl menu) 1654 ((ol ul dl menu)
1638 (push 0 w3-display-list-stack) 1655 (push (if (w3-get-attribute 'seqnum)
1656 (1- (string-to-int (w3-get-attribute 'seqnum)))
1657 0) w3-display-list-stack)
1639 (w3-handle-content node)) 1658 (w3-handle-content node))
1640 (dir 1659 (dir
1641 (push 0 w3-display-list-stack) 1660 (push 0 w3-display-list-stack)
1642 (setq node 1661 (setq node
1643 (list tag args 1662 (list tag args
1689 (cdr w3-frame-labels))))))))))) 1708 (cdr w3-frame-labels)))))))))))
1690 (noframes 1709 (noframes
1691 (if w3-display-frames 1710 (if w3-display-frames
1692 (w3-handle-empty-tag) 1711 (w3-handle-empty-tag)
1693 (w3-handle-content node))) 1712 (w3-handle-content node)))
1713 (applet ; Wow, Java
1714 (w3-handle-content node)
1715 )
1694 (script ; Scripts 1716 (script ; Scripts
1695 (w3-handle-empty-tag)) 1717 (w3-handle-empty-tag))
1696 ((embed object) ; Embedded images/content 1718 ((embed object) ; Embedded images/content
1697 (w3-handle-content node) 1719 (w3-handle-content node)
1698 ) 1720 )
1951 (style 1973 (style
1952 (w3-handle-style (alist-to-plist 1974 (w3-handle-style (alist-to-plist
1953 (cons (cons 'data (apply 'concat (nth 2 node))) 1975 (cons (cons 'data (apply 'concat (nth 2 node)))
1954 (nth 1 node)))) 1976 (nth 1 node))))
1955 (w3-handle-empty-tag)) 1977 (w3-handle-empty-tag))
1978 (label
1979 (if (not (markerp w3-display-label-marker))
1980 (setq w3-display-label-marker (make-marker)))
1981 (set-marker w3-display-label-marker (point))
1982 (w3-handle-content node))
1956 ;; Emacs-W3 stuff that cannot be expressed in a stylesheet 1983 ;; Emacs-W3 stuff that cannot be expressed in a stylesheet
1957 (pinhead 1984 (pinhead
1958 ;; This check is so that we don't screw up table auto-layout 1985 ;; This check is so that we don't screw up table auto-layout
1959 ;; by changing our text midway through the parse/layout/display 1986 ;; by changing our text midway through the parse/layout/display
1960 ;; steps. 1987 ;; steps.
2048 ) 2075 )
2049 2076
2050 (defun w3-region (st nd) 2077 (defun w3-region (st nd)
2051 (if (not w3-setup-done) (w3-do-setup)) 2078 (if (not w3-setup-done) (w3-do-setup))
2052 (let* ((source (buffer-substring st nd)) 2079 (let* ((source (buffer-substring st nd))
2053 (w3-dislplay-same-buffer t) 2080 (w3-display-same-buffer t)
2054 (parse nil)) 2081 (parse nil))
2055 (save-window-excursion 2082 (save-window-excursion
2056 (save-excursion 2083 (save-excursion
2057 (set-buffer (get-buffer-create " *w3-region*")) 2084 (set-buffer (get-buffer-create " *w3-region*"))
2058 (erase-buffer) 2085 (erase-buffer)
2215 (if (zerop nb-stars) 2242 (if (zerop nb-stars)
2216 ;; push => reverse order 2243 ;; push => reverse order
2217 (reverse dimensions) 2244 (reverse dimensions)
2218 ;; substitute numbers for * 2245 ;; substitute numbers for *
2219 (let ((star-replacement (/ remaining-available-dimension nb-stars)) 2246 (let ((star-replacement (/ remaining-available-dimension nb-stars))
2220 (star-dimensions dimensions)) 2247 (star-dimensions dimensions))
2221 (setq dimensions nil) 2248 (setq dimensions nil)
2222 (while star-dimensions 2249 (while star-dimensions
2223 (push (if (eq '* (car star-dimensions)) 2250 (push (if (eq '* (car star-dimensions))
2224 star-replacement 2251 star-replacement
2225 (car star-dimensions)) 2252 (car star-dimensions))
2226 dimensions) 2253 dimensions)
2227 (pop star-dimensions)) 2254 (pop star-dimensions))
2228 ;; push + push => in order 2255 ;; push + push => in order
2229 dimensions)))))) 2256 dimensions))))))
2230 2257
2231 2258
2232 (provide 'w3-display) 2259 (provide 'w3-display)