Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 6608ceec7cf8
children 15872534500d
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
1 ;;; w3-display.el --- display engine v99999 1 ;;; w3-display.el --- display engine v99999
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/04/24 16:51:06 3 ;; Created: 1997/06/25 14:30:16
4 ;; Version: 1.176 4 ;; Version: 1.189
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.
32 (require 'css) 32 (require 'css)
33 (require 'font) 33 (require 'font)
34 (require 'w3-widget) 34 (require 'w3-widget)
35 (require 'w3-imap) 35 (require 'w3-imap)
36 36
37 (define-widget-keywords :emacspeak-help) 37 (define-widget-keywords :active-face :emacspeak-help :href
38 :name :target :title :src)
38 (autoload 'sentence-ify "flame") 39 (autoload 'sentence-ify "flame")
39 (autoload 'string-ify "flame") 40 (autoload 'string-ify "flame")
40 (autoload '*flame "flame") 41 (autoload '*flame "flame")
41 (if (not (fboundp 'flatten)) (autoload 'flatten "flame")) 42 (if (not (fboundp 'flatten)) (autoload 'flatten "flame"))
42 (defvar w3-cookie-cache nil) 43 (defvar w3-cookie-cache nil)
68 (w3-d-s-var-def w3-face-font-style) 69 (w3-d-s-var-def w3-face-font-style)
69 (w3-d-s-var-def w3-face-font-spec) 70 (w3-d-s-var-def w3-face-font-spec)
70 (w3-d-s-var-def w3-face-text-decoration) 71 (w3-d-s-var-def w3-face-text-decoration)
71 (w3-d-s-var-def w3-face-face) 72 (w3-d-s-var-def w3-face-face)
72 (w3-d-s-var-def w3-face-descr) 73 (w3-d-s-var-def w3-face-descr)
73 (w3-d-s-var-def w3-face-pixmap) 74 (w3-d-s-var-def w3-face-background-image)
74 (w3-d-s-var-def w3-display-css-properties) 75 (w3-d-s-var-def w3-display-css-properties)
75 (w3-d-s-var-def w3-display-background-properties) 76 (w3-d-s-var-def w3-display-background-properties)
76 77
77 (eval-when-compile 78 (eval-when-compile
78 (defmacro w3-get-attribute (attr) 79 (defmacro w3-get-attribute (attr)
105 (w3-get-face-info font-style) 106 (w3-get-face-info font-style)
106 (w3-get-face-info font-weight) 107 (w3-get-face-info font-weight)
107 (w3-get-face-info font-variant) 108 (w3-get-face-info font-variant)
108 (w3-get-face-info font-size) 109 (w3-get-face-info font-size)
109 (w3-get-face-info text-decoration) 110 (w3-get-face-info text-decoration)
110 ;;(w3-get-face-info pixmap) 111 (w3-get-face-info background-image)
111 (w3-get-face-info color color) 112 (w3-get-face-info color color)
112 (w3-get-face-info background-color bgcolor) 113 (w3-get-face-info background-color bgcolor)
113 (setq w3-face-font-spec (make-font 114 (setq w3-face-font-spec (make-font
114 :weight (car w3-face-font-weight) 115 :weight (car w3-face-font-weight)
115 :family (car w3-face-font-family) 116 :family (car w3-face-font-family)
122 (w3-pop-face-info font-weight) 123 (w3-pop-face-info font-weight)
123 (w3-pop-face-info font-variant) 124 (w3-pop-face-info font-variant)
124 (w3-pop-face-info font-size) 125 (w3-pop-face-info font-size)
125 (w3-pop-face-info font-style) 126 (w3-pop-face-info font-style)
126 (w3-pop-face-info text-decoration) 127 (w3-pop-face-info text-decoration)
127 ;;(w3-pop-face-info pixmap) 128 (w3-pop-face-info background-image)
128 (w3-pop-face-info color) 129 (w3-pop-face-info color)
129 (w3-pop-face-info background-color)))) 130 (w3-pop-face-info background-color))))
130 131
131 ) 132 )
132 133
151 (while (< len 10) 152 (while (< len 10)
152 (aset breaks-vector len (make-string len ?\n)) 153 (aset breaks-vector len (make-string len ?\n))
153 (setq len (1+ len))) 154 (setq len (1+ len)))
154 breaks-vector)) 155 breaks-vector))
155 156
156 (defun w3-pause () 157 (defsubst w3-pause ()
157 (cond 158 (save-excursion
158 (w3-running-FSF19 (sit-for 0)) 159 (goto-char (or (symbol-value 'cur-viewing-pos) (point-min)))
159 (w3-running-xemacs 160 (cond
160 (sit-for 0)) 161 (w3-running-FSF19
161 ;; (if (and (not (sit-for 0)) (input-pending-p)) 162 (if (and (not (sit-for 0)) (input-pending-p))
162 ;; (condition-case () 163 (condition-case ()
163 ;; (dispatch-event (next-command-event)) 164 (progn
164 ;; (error nil))) 165 (set 'cur-viewing-pos
165 (t (sit-for 0)))) 166 (lookup-key w3-mode-map (vector (read-event))))
167 (case (symbol-value 'cur-viewing-pos)
168 ((w3-quit w3-leave-buffer) nil)
169 (otherwise (call-interactively (symbol-value 'cur-viewing-pos)))))
170 (error nil))))
171 (w3-running-xemacs
172 (if (and (not (sit-for 0)) (input-pending-p))
173 (condition-case ()
174 (dispatch-event (next-command-event))
175 (error nil))))
176 (t (sit-for 0)))
177 (set 'cur-viewing-pos (point))))
166 178
167 (defmacro w3-get-pad-string (len) 179 (defmacro w3-get-pad-string (len)
168 (` (cond 180 (` (cond
169 ((< (, len) 0) 181 ((< (, len) 0)
170 "") 182 "")
259 (car w3-face-font-variant))) 271 (car w3-face-font-variant)))
260 (if w3-face-font-style 272 (if w3-face-font-style
261 (set-font-style-by-keywords w3-face-font-spec 273 (set-font-style-by-keywords w3-face-font-spec
262 (car w3-face-font-style))) 274 (car w3-face-font-style)))
263 (setq w3-face-descr (list w3-face-font-spec 275 (setq w3-face-descr (list w3-face-font-spec
276 (car w3-face-background-image)
264 (car w3-face-color) 277 (car w3-face-color)
265 (car w3-face-background-color)) 278 (car w3-face-background-color))
266 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache))) 279 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache)))
267 (if (or w3-face-face (not (or (car w3-face-color) 280 (if (or w3-face-face (not (or (car w3-face-color)
281 (car w3-face-background-image)
268 (car w3-face-background-color) 282 (car w3-face-background-color)
269 w3-face-font-spec))) 283 w3-face-font-spec)))
270 nil ; Do nothing, we got it already 284 nil ; Do nothing, we got it already
271 (setq w3-face-face 285 (setq w3-face-face
272 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index)) 286 (w3-make-face (intern (format "w3-style-face-%05d" w3-face-index))
273 "An Emacs-W3 face... don't edit by hand." t) 287 "An Emacs-W3 face... don't edit by hand." t)
274 w3-face-index (1+ w3-face-index)) 288 w3-face-index (1+ w3-face-index))
289 (if (car w3-face-background-image)
290 (w3-maybe-start-background-image-download
291 (car w3-face-background-image) w3-face-face))
275 (if w3-face-font-spec 292 (if w3-face-font-spec
276 (font-set-face-font w3-face-face w3-face-font-spec)) 293 (font-set-face-font w3-face-face w3-face-font-spec))
277 (if (car w3-face-color) 294 (if (car w3-face-color)
278 (font-set-face-foreground w3-face-face (car w3-face-color))) 295 (font-set-face-foreground w3-face-face (car w3-face-color)))
279 (if (car w3-face-background-color) 296 (if (car w3-face-background-color)
280 (font-set-face-background w3-face-face (car w3-face-background-color))) 297 (font-set-face-background w3-face-face (car w3-face-background-color)))
281 ;;(set-face-background-pixmap w3-face-face w3-face-pixmap)
282 (setq w3-face-cache (cons 298 (setq w3-face-cache (cons
283 (cons w3-face-descr w3-face-face) 299 (cons w3-face-descr w3-face-face)
284 w3-face-cache))) 300 w3-face-cache)))
285 w3-face-face) 301 w3-face-face)
286 302
298 (if (string-match "[ \t\n\r]+$" string) 314 (if (string-match "[ \t\n\r]+$" string)
299 (setq string (substring string 0 (match-beginning 0)))) 315 (setq string (substring string 0 (match-beginning 0))))
300 string) 316 string)
301 317
302 318
319 (if (not (fboundp 'char-before))
320 (fset 'char-before 'preceding-char))
321
303 (defsubst w3-display-line-break (n) 322 (defsubst w3-display-line-break (n)
304 (if (or 323 (if (or
305 (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told 324 (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told
306 (= w3-last-fill-pos (point)) 325 (= w3-last-fill-pos (point))
307 (> w3-last-fill-pos (point-max))) 326 (> w3-last-fill-pos (point-max)))
308 (if (/= (preceding-char) ?\n) (setq n (1+ n))) ; at least put one line in 327 (if (not (eq (char-before) ?\n))
328 (setq n (1+ n))) ; at least put one line in
309 (let ((fill-column (max (1+ (length fill-prefix)) fill-column)) 329 (let ((fill-column (max (1+ (length fill-prefix)) fill-column))
310 width) 330 width)
311 (case (car w3-display-alignment-stack) 331 (case (car w3-display-alignment-stack)
312 (center 332 (center
313 (fill-region-as-paragraph w3-last-fill-pos (point)) 333 (fill-region-as-paragraph w3-last-fill-pos (point))
399 (write-region (point-min) (point-max) fname 5) 419 (write-region (point-min) (point-max) fname 5)
400 (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache)))) 420 (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache))))
401 (cookie fname st nd)))) 421 (cookie fname st nd))))
402 422
403 (defun w3-widget-echo (widget &rest ignore) 423 (defun w3-widget-echo (widget &rest ignore)
404 (let ((url (widget-get widget 'href)) 424 (let* ((url (widget-get widget :href))
405 (name (widget-get widget 'name)) 425 (name (widget-get widget :name))
406 (text (buffer-substring (widget-get widget :from) 426 (text (buffer-substring (widget-get widget :from)
407 (widget-get widget :to))) 427 (widget-get widget :to)))
408 (title (widget-get widget 'title)) 428 (title (widget-get widget :title))
409 (check w3-echo-link) 429 (check w3-echo-link)
410 (msg nil)) 430 (msg nil))
411 (if url 431 (if url
412 (setq url (url-truncate-url-for-viewing url))) 432 (setq url (url-truncate-url-for-viewing url)))
413 (if name 433 (if name
414 (setq name (concat "anchor:" name))) 434 (setq name (concat "anchor:" name)))
415 (if (not (listp check)) 435 (if (not (listp check))
421 (> (length (symbol-value (car check))) 0) 441 (> (length (symbol-value (car check))) 0)
422 (throw 'exit (symbol-value (car check)))) 442 (throw 'exit (symbol-value (car check))))
423 (pop check))))) 443 (pop check)))))
424 444
425 (defun w3-follow-hyperlink (widget &rest ignore) 445 (defun w3-follow-hyperlink (widget &rest ignore)
426 (let* ((target (or (widget-get widget 'target) 446 (let* ((target (or (widget-get widget :target) w3-base-target))
427 w3-base-target)) 447 (href (widget-get widget :href)))
428 (href (widget-get widget 'href)))
429 (if target (setq target (intern (downcase target)))) 448 (if target (setq target (intern (downcase target))))
430 (case target 449 (case target
431 ((_blank external) 450 ((_blank external)
432 (w3-fetch-other-frame href)) 451 (w3-fetch-other-frame href))
433 (_top 452 (_top
436 (otherwise 455 (otherwise
437 (w3-fetch href target))))) 456 (w3-fetch href target)))))
438 457
439 (defun w3-balloon-help-callback (object &optional event) 458 (defun w3-balloon-help-callback (object &optional event)
440 (let* ((widget (widget-at (extent-start-position object))) 459 (let* ((widget (widget-at (extent-start-position object)))
441 (href (and widget (widget-get widget 'href)))) 460 (href (widget-get widget :href)))
442 (if href 461 (if href
443 (url-truncate-url-for-viewing href) 462 (url-truncate-url-for-viewing href)
444 nil))) 463 nil)))
445 464
446 465
635 ) 654 )
636 655
637 656
638 ;; Image handling 657 ;; Image handling
639 (defun w3-maybe-start-image-download (widget) 658 (defun w3-maybe-start-image-download (widget)
640 (let* ((src (widget-get widget 'src)) 659 (let* ((src (widget-get widget :src))
641 (cached-glyph (w3-image-cached-p src))) 660 (cached-glyph (w3-image-cached-p src)))
642 (cond 661 (cond
643 ((and cached-glyph 662 ((and cached-glyph
644 (widget-glyphp cached-glyph) 663 (widget-glyphp cached-glyph)
645 (not (eq 'nothing 664 (not (eq 'nothing
649 ((or w3-delay-image-loads ; Delaying images 668 ((or w3-delay-image-loads ; Delaying images
650 (not (fboundp 'valid-specifier-domain-p)) ; Can't do images 669 (not (fboundp 'valid-specifier-domain-p)) ; Can't do images
651 (eq (device-type) 'tty)) ; Why bother? 670 (eq (device-type) 'tty)) ; Why bother?
652 (w3-add-delayed-graphic widget)) 671 (w3-add-delayed-graphic widget))
653 ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it! 672 ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it!
654 (message "Skipping image %s" (url-basepath src t)) 673 (mesage "Skipping image %s" (url-basepath src t))
655 (w3-add-delayed-graphic widget)) 674 (w3-add-delayed-graphic widget))
656 (t ; Grab the images 675 (t ; Grab the images
657 (let ( 676 (let (
658 (url-request-method "GET") 677 (url-request-method "GET")
659 (old-asynch url-be-asynchronous) 678 (old-asynch url-be-asynchronous)
673 (setq-default url-be-asynchronous t) 692 (setq-default url-be-asynchronous t)
674 (setq w3-graphics-list (cons (cons src (make-glyph)) 693 (setq w3-graphics-list (cons (cons src (make-glyph))
675 w3-graphics-list)) 694 w3-graphics-list))
676 (save-excursion 695 (save-excursion
677 (set-buffer (get-buffer-create url-working-buffer)) 696 (set-buffer (get-buffer-create url-working-buffer))
678 (setq url-current-callback-data (list widget) 697 (setq url-current-callback-data (list src (widget-get widget 'buffer)
698 widget)
679 url-be-asynchronous t 699 url-be-asynchronous t
680 url-current-callback-func 'w3-finalize-image-download) 700 url-current-callback-func 'w3-finalize-image-download)
681 (url-retrieve src)) 701 (url-retrieve src))
682 (setq-default url-be-asynchronous old-asynch)))))) 702 (setq-default url-be-asynchronous old-asynch))))))
683 703
684 (defun w3-finalize-image-download (widget) 704 (defun w3-maybe-start-background-image-download (src face)
705 (let* ((cached-glyph (w3-image-cached-p src))
706 (buf (current-buffer)))
707 (cond
708 ((and cached-glyph
709 (widget-glyphp cached-glyph)
710 (not (eq 'nothing
711 (image-instance-type
712 (glyph-image-instance cached-glyph)))))
713 (set-face-background-pixmap face
714 (glyph-image-instance cached-glyph) buf))
715 ((or (not (fboundp 'valid-specifier-domain-p)) ; Can't do images
716 (eq (device-type) 'tty)) ; Why bother?
717 nil)
718 ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it!
719 (mesage "Skipping image %s" (url-basepath src t))
720 nil)
721 (t ; Grab the images
722 (let (
723 (url-request-method "GET")
724 (old-asynch url-be-asynchronous)
725 (url-request-data nil)
726 (url-request-extra-headers nil)
727 (url-source t)
728 (url-mime-accept-string (substring
729 (mapconcat
730 (function
731 (lambda (x)
732 (if x
733 (concat (car x) ",")
734 "")))
735 w3-allowed-image-types "")
736 0 -1))
737 (url-working-buffer (generate-new-buffer-name " *W3GRAPH*")))
738 (setq-default url-be-asynchronous t)
739 (setq w3-graphics-list (cons (cons src (make-glyph))
740 w3-graphics-list))
741 (save-excursion
742 (set-buffer (get-buffer-create url-working-buffer))
743 (setq url-current-callback-data (list src buf 'background face)
744 url-be-asynchronous t
745 url-current-callback-func 'w3-finalize-image-download)
746 (url-retrieve src))
747 (setq-default url-be-asynchronous old-asynch))))))
748
749 (defun w3-finalize-image-download (url buffer &optional widget face)
685 (let ((glyph nil) 750 (let ((glyph nil)
686 (url (widget-get widget 'src)) 751 (node nil))
687 (node nil)
688 (buffer (widget-get widget 'buffer)))
689 (message "Enhancing image...") 752 (message "Enhancing image...")
690 (setq glyph (image-normalize (cdr-safe (assoc url-current-mime-type 753 (setq glyph (image-normalize (cdr-safe (assoc url-current-mime-type
691 w3-image-mappings)) 754 w3-image-mappings))
692 (buffer-string))) 755 (buffer-string)))
693 (message "Enhancing image... done") 756 (message "Enhancing image... done")
717 (set-glyph-image (cdr node) (glyph-image glyph))) 780 (set-glyph-image (cdr node) (glyph-image glyph)))
718 (glyph 781 (glyph
719 (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list))) 782 (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list)))
720 (t nil)) 783 (t nil))
721 784
722 (if (and (buffer-name buffer) ; Dest. buffer exists 785 (cond
723 (widget-glyphp glyph)) ; got a valid glyph 786 ((or (not buffer)
724 (save-excursion 787 (not (widget-glyphp glyph))
725 (set-buffer buffer) 788 (not (buffer-name buffer)))
726 (if (eq major-mode 'w3-mode) 789 nil)
727 (widget-value-set widget glyph) 790 ((and (eq widget 'background)
728 (setq w3-image-widgets-waiting 791 w3-running-xemacs)
729 (cons widget w3-image-widgets-waiting))))))) 792 (set-face-background-pixmap face
793 (glyph-image-instance glyph)
794 buffer))
795 ((not (eq widget 'background))
796 (save-excursion
797 (set-buffer buffer)
798 (if (eq major-mode 'w3-mode)
799 (widget-value-set widget glyph)
800 (setq w3-image-widgets-waiting
801 (cons widget w3-image-widgets-waiting))))))))
730 802
731 (defmacro w3-handle-image () 803 (defmacro w3-handle-image ()
732 (` 804 (`
733 (let* ((height (w3-get-attribute 'height)) 805 (let* ((height (w3-get-attribute 'height))
734 (width (w3-get-attribute 'width)) 806 (width (w3-get-attribute 'width))
742 (alt (or (w3-get-attribute 'alt) our-alt)) 814 (alt (or (w3-get-attribute 'alt) our-alt))
743 (c nil) 815 (c nil)
744 (ismap (and (assq 'ismap args) 'ismap)) 816 (ismap (and (assq 'ismap args) 'ismap))
745 (usemap (w3-get-attribute 'usemap)) 817 (usemap (w3-get-attribute 'usemap))
746 (base (w3-get-attribute 'base)) 818 (base (w3-get-attribute 'base))
747 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) 819 (href (and hyperlink-info (widget-get (cadr hyperlink-info) :href)))
748 (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target))) 820 (target (and hyperlink-info (widget-get (cadr hyperlink-info) :target)))
749 (widget nil) 821 (widget nil)
750 (align (or (w3-get-attribute 'align) 822 (align (or (w3-get-attribute 'align)
751 (w3-get-style-info 'vertical-align node)))) 823 (w3-get-style-info 'vertical-align node))))
752 (while (setq c (string-match "[\C-i\C-j\C-l\C-m]" alt)) 824 (while (setq c (string-match "[\C-i\C-j\C-l\C-m]" alt))
753 (aset alt c ? )) 825 (aset alt c ? ))
754 (if (assq '*table-autolayout w3-display-open-element-stack) 826 (if (assq '*table-autolayout w3-display-open-element-stack)
755 (insert alt) 827 (insert alt)
756 (setq widget (widget-create 'image 828 (setq widget (widget-create 'image
757 :value-face w3-active-faces 829 :value-face w3-active-faces
758 'src src ; Where to load the image from 830 :src src ; Where to load the image from
759 'alt alt ; Textual replacement 831 'alt alt ; Textual replacement
760 'ismap ismap ; Is it a server-side map? 832 'ismap ismap ; Is it a server-side map?
761 'usemap usemap ; Is it a client-side map? 833 'usemap usemap ; Is it a client-side map?
762 'href href ; Hyperlink destination 834 :href href ; Hyperlink destination
763 'target target 835 :target target
764 )) 836 ))
765 (widget-put widget 'buffer (current-buffer)) 837 (widget-put widget 'buffer (current-buffer))
766 (w3-maybe-start-image-download widget) 838 (w3-maybe-start-image-download widget)
767 (if (widget-get widget :from) 839 (if (widget-get widget :from)
768 (add-text-properties (widget-get widget :from) 840 (add-text-properties (widget-get widget :from)
770 (list 'html-stack w3-display-open-element-stack))) 842 (list 'html-stack w3-display-open-element-stack)))
771 (goto-char (point-max)))))) 843 (goto-char (point-max))))))
772 844
773 ;; The table handling 845 ;; The table handling
774 846
775 (if (and w3-running-xemacs (featurep 'mule)) 847 (if (and w3-running-xemacs (featurep 'mule)
848 (not (find-charset 'w3-dingbats)))
776 (make-charset 'w3-dingbats "Dingbats character set for Emacs/W3" 849 (make-charset 'w3-dingbats "Dingbats character set for Emacs/W3"
777 '(registry "" dimension 1 chars 96 final ?:))) 850 '(registry "" dimension 1 chars 96 final ?:)))
778 851
779 (defun w3-make-char (oct) 852 (defun w3-make-char (oct)
780 (if (and w3-running-xemacs (featurep 'mule)) 853 (if (and w3-running-xemacs (featurep 'mule))
781 (make-char 'w3-dingbats (if (characterp oct) (char-int oct) oct)) 854 (make-char 'w3-dingbats (if (characterp oct) (char-int oct) oct))
782 oct)) 855 oct))
783 856
784 (defvar w3-table-ascii-border-chars 857 (defvar w3-table-ascii-border-chars
785 [nil nil nil ?/ nil ?- ?\\ ?- nil ?\\ ?| ?| ?/ ?- ?| ?+] 858 [nil nil nil ?' nil ?- ?` ?- nil ?\\ ?| ?| ?/ ?- ?| ?+]
786 "*Vector of ascii characters to use to draw table borders. 859 "*Vector of ascii characters to use to draw table borders.
787 This vector is used when terminal characters are unavailable") 860 This vector is used when terminal characters are unavailable")
788 861
789 (defvar w3-table-glyph-border-chars 862 (defvar w3-table-glyph-border-chars
790 [nil nil nil 11 nil 2 7 14 nil 3 8 6 1 15 4 5] 863 [nil nil nil 11 nil 2 7 14 nil 3 8 6 1 15 4 5]
817 w3-setup-terminal-chars sets this to one of 890 w3-setup-terminal-chars sets this to one of
818 w3-table-ascii-border-chars, 891 w3-table-ascii-border-chars,
819 w3-table-glyph-border-chars, or 892 w3-table-glyph-border-chars, or
820 w3-table-graphic-border-chars.") 893 w3-table-graphic-border-chars.")
821 894
822 (defsubst w3-table-lookup-char (l u r b) 895 (defsubst w3-table-lookup-char (l u r b &optional char)
823 (aref w3-table-border-chars (logior (if l 1 0) 896 (aref w3-table-border-chars (logior (if l 1 0)
824 (if u 2 0) 897 (if u 2 0)
825 (if r 4 0) 898 (if r 4 0)
826 (if b 8 0)))) 899 (if b 8 0))))
827 900
838 (insert-char (or character ? ) (or count 1) inherit))) 911 (insert-char (or character ? ) (or count 1) inherit)))
839 912
840 (defsubst w3-horizontal-rule-char nil 913 (defsubst w3-horizontal-rule-char nil
841 (or w3-horizontal-rule-char (w3-table-lookup-char t nil t nil))) 914 (or w3-horizontal-rule-char (w3-table-lookup-char t nil t nil)))
842 915
843 (defun w3-setup-terminal-chars nil 916 (defun w3-setup-terminal-chars ()
844 "Try to find the best set of characters to draw table borders with. 917 "Try to find the best set of characters to draw table borders with.
845 On a console, this can trigger some Emacs display bugs. 918 On a console, this can trigger some Emacs display bugs.
846 919
847 Initializes a number of variables: 920 Initializes a number of variables:
848 w3-terminal-properties to either nil or a list of properties including 'face 921 w3-terminal-properties to either nil or a list of properties including 'face
1610 plist (plist-put plist 'internal-form-number w3-current-form-number) 1683 plist (plist-put plist 'internal-form-number w3-current-form-number)
1611 plist (plist-put plist 'action w3-display-form-id) 1684 plist (plist-put plist 'action w3-display-form-id)
1612 plist (plist-put plist 'maxlength maxlength)) 1685 plist (plist-put plist 'maxlength maxlength))
1613 plist)) 1686 plist))
1614 1687
1688 (defun w3-resurrect-hyperlinks ()
1689 (let ((st (point-min))
1690 (inhibit-read-only t)
1691 info nd node face)
1692 (while st
1693 (if (setq info (get-text-property st 'w3-hyperlink-info))
1694 (progn
1695 (setq nd (or (next-single-property-change st 'w3-hyperlink-info)
1696 (point-max)))
1697 (apply 'widget-convert-text 'link st nd st nd info)))
1698 (setq st (next-single-property-change st 'w3-hyperlink-info)))))
1699
1700 (defun w3-display-convert-arglist (args)
1701 (let ((rval nil)
1702 (newsym nil)
1703 (cur nil))
1704 (while (setq cur (pop args))
1705 (setq newsym (intern (concat ":" (symbol-name (car cur))))
1706 rval (plist-put rval newsym (cdr cur))))
1707 rval))
1708
1615 (defun w3-display-node (node &optional nofaces) 1709 (defun w3-display-node (node &optional nofaces)
1616 (let ( 1710 (let (
1617 (content-stack (list (list node))) 1711 (content-stack (list (list node)))
1618 (right-margin-stack (list fill-column)) 1712 (right-margin-stack (list fill-column))
1619 (left-margin-stack (list 0)) 1713 (left-margin-stack (list 0))
1645 (a 1739 (a
1646 (if (not hyperlink-info) 1740 (if (not hyperlink-info)
1647 nil 1741 nil
1648 (add-text-properties (car hyperlink-info) (point) 1742 (add-text-properties (car hyperlink-info) (point)
1649 (list 1743 (list
1650 'mouse-face 'highlight
1651 'duplicable t 1744 'duplicable t
1652 'start-open t 1745 'start-open t
1653 'end-open t 1746 'end-open t
1654 'rear-nonsticky t 1747 'rear-nonsticky t
1655 'help-echo 'w3-balloon-help-callback 1748 'w3-hyperlink-info (cadr hyperlink-info))))
1656 'balloon-help 'w3-balloon-help-callback))
1657 (fillin-text-property (car hyperlink-info) (point)
1658 'button 'button (cadr hyperlink-info))
1659 (widget-put (cadr hyperlink-info) :to (set-marker
1660 (make-marker) (point))))
1661 (setq hyperlink-info nil)) 1749 (setq hyperlink-info nil))
1662 ((ol ul dl dir menu) 1750 ((ol ul dl dir menu)
1663 (pop w3-display-list-stack)) 1751 (pop w3-display-list-stack))
1664 (label 1752 (label
1665 (if (and (markerp w3-display-label-marker) 1753 (if (and (markerp w3-display-label-marker)
1707 (setq w3-display-css-properties (css-get 1795 (setq w3-display-css-properties (css-get
1708 (nth 0 node) 1796 (nth 0 node)
1709 (nth 1 node) 1797 (nth 1 node)
1710 w3-current-stylesheet 1798 w3-current-stylesheet
1711 w3-display-open-element-stack)) 1799 w3-display-open-element-stack))
1712 (if nofaces
1713 nil
1714 (push (w3-face-for-element node) w3-active-faces)
1715 (push (w3-voice-for-element node) w3-active-voices))
1716 (push (w3-get-style-info 'display node) break-style) 1800 (push (w3-get-style-info 'display node) break-style)
1717 (push (w3-get-style-info 'insert-after node) insert-after) 1801 (push (w3-get-style-info 'insert-after node) insert-after)
1718 (setq insert-before (w3-get-style-info 'insert-before node)) 1802 (setq insert-before (w3-get-style-info 'insert-before node))
1719 (w3-display-handle-break) 1803 (w3-display-handle-break)
1720 (if (w3-node-visible-p) 1804 (if (w3-node-visible-p)
1722 (setq insert-before nil 1806 (setq insert-before nil
1723 tag '*invisible) 1807 tag '*invisible)
1724 (setcar insert-after nil)) 1808 (setcar insert-after nil))
1725 (if insert-before 1809 (if insert-before
1726 (w3-handle-string-content insert-before)) 1810 (w3-handle-string-content insert-before))
1811 (if nofaces
1812 nil
1813 (push (w3-face-for-element node) w3-active-faces)
1814 (push (w3-voice-for-element node) w3-active-voices))
1727 (setq insert-before nil) 1815 (setq insert-before nil)
1728 (if id 1816 (if id
1729 (setq w3-id-positions (cons 1817 (setq w3-id-positions (cons
1730 (cons (intern id) 1818 (cons (intern id)
1731 (set-marker (make-marker) 1819 (set-marker (make-marker)
1741 class 1829 class
1742 (before nil) 1830 (before nil)
1743 (after nil) 1831 (after nil)
1744 (face nil) 1832 (face nil)
1745 (voice nil) 1833 (voice nil)
1746 (st nil)) 1834 (st nil)
1835 (old-props w3-display-css-properties)
1836 (active-face nil)
1837 (munged (copy-list args)))
1838 (if (assq 'class munged)
1839 (push ":active" (cdr (assq 'class munged)))
1840 (setq munged (cons (cons 'class '(":active")) munged)))
1841 (setq w3-display-css-properties (css-get
1842 tag
1843 munged
1844 w3-current-stylesheet
1845 w3-display-open-element-stack))
1846 (setq active-face (w3-face-for-element (list tag munged nil)))
1847 (w3-pop-all-face-info)
1848 (setq w3-display-css-properties old-props)
1747 (if (w3-get-attribute 'href) 1849 (if (w3-get-attribute 'href)
1748 (setq st (point) 1850 (setq st (point)
1749 hyperlink-info (list 1851 hyperlink-info (list
1750 st 1852 st
1751 (append 1853 (append
1752 (list 'link :args nil 1854 (list :args nil
1753 :value "" :tag "" 1855 :value "" :tag ""
1754 :action 'w3-follow-hyperlink 1856 :action 'w3-follow-hyperlink
1857 :button-face '(nil)
1858 :active-face active-face
1755 :from (set-marker 1859 :from (set-marker
1756 (make-marker) st) 1860 (make-marker) st)
1757 :help-echo 'w3-widget-echo 1861 :help-echo 'w3-widget-echo
1758 :emacspeak-help 'w3-widget-echo 1862 :emacspeak-help 'w3-widget-echo
1759 ) 1863 )
1760 (alist-to-plist args))))) 1864 (w3-display-convert-arglist args)))))
1761 (w3-handle-content node) 1865 (w3-handle-content node)
1762 ) 1866 )
1763 ) 1867 )
1764 ((ol ul dl menu) 1868 ((ol ul dl menu)
1765 (push (if (w3-get-attribute 'seqnum) 1869 (push (if (w3-get-attribute 'seqnum)
1825 (hr ; Cause line break & insert rule 1929 (hr ; Cause line break & insert rule
1826 (let* ((perc (or (w3-get-attribute 'width) 1930 (let* ((perc (or (w3-get-attribute 'width)
1827 (w3-get-style-info 'width node) 1931 (w3-get-style-info 'width node)
1828 "100%")) 1932 "100%"))
1829 (width nil)) 1933 (width nil))
1830 (setq perc (/ (min (string-to-int perc) 100) 100.0) 1934 (if (stringp perc)
1831 width (truncate (* fill-column perc))) 1935 (setq perc (/ (min (string-to-int perc) 100) 100.0)
1936 width (truncate (* fill-column perc)))
1937 (setq width perc))
1832 (w3-insert-terminal-char (w3-horizontal-rule-char) width) 1938 (w3-insert-terminal-char (w3-horizontal-rule-char) width)
1833 (w3-handle-empty-tag))) 1939 (w3-handle-empty-tag)))
1834 (map ; Client side imagemaps 1940 (map ; Client side imagemaps
1835 (let ((name (or (w3-get-attribute 'name) 1941 (let ((name (or (w3-get-attribute 'name)
1836 (w3-get-attribute 'id) 1942 (w3-get-attribute 'id)
1911 (setq w3-current-isindex (cons action prompt))) 2017 (setq w3-current-isindex (cons action prompt)))
1912 ) 2018 )
1913 ((html body) 2019 ((html body)
1914 (let ((fore (car (delq nil (copy-list w3-face-color)))) 2020 (let ((fore (car (delq nil (copy-list w3-face-color))))
1915 (back (car (delq nil (copy-list w3-face-background-color)))) 2021 (back (car (delq nil (copy-list w3-face-background-color))))
2022 (pixm (car (delq nil (copy-list w3-face-background-image))))
1916 (alink (w3-get-attribute 'alink)) 2023 (alink (w3-get-attribute 'alink))
1917 (vlink (w3-get-attribute 'vlink)) 2024 (vlink (w3-get-attribute 'vlink))
1918 (link (w3-get-attribute 'link)) 2025 (link (w3-get-attribute 'link))
1919 (sheet "") 2026 (sheet "")
1920 ) 2027 )
1925 (setq sheet (format "%sa:visited { color: %s }\n" sheet 2032 (setq sheet (format "%sa:visited { color: %s }\n" sheet
1926 (w3-fix-color vlink)))) 2033 (w3-fix-color vlink))))
1927 (if alink 2034 (if alink
1928 (setq sheet (format "%sa:active { color: %s }\n" sheet 2035 (setq sheet (format "%sa:active { color: %s }\n" sheet
1929 (w3-fix-color alink)))) 2036 (w3-fix-color alink))))
1930 (if (and (not w3-user-colors-take-precedence) 2037 (if w3-user-colors-take-precedence
1931 (/= (length sheet) 0)) 2038 nil
1932 (w3-handle-style (list 'data sheet 2039 (if (/= (length sheet) 0)
1933 'notation "text/css"))) 2040 (w3-handle-style (list 'data sheet
1934 (if (and (not w3-user-colors-take-precedence) 2041 'notation "text/css")))
1935 (w3-get-attribute 'text) 2042 (if (and (w3-get-attribute 'background)
1936 (not fore)) 2043 (not pixm))
1937 (progn 2044 (progn
1938 (setq fore (w3-fix-color (w3-get-attribute 'text))) 2045 (setq pixm (w3-get-attribute 'background))
1939 (setf (car w3-face-color) fore))) 2046 (setf (car w3-face-background-image) pixm)))
1940 (if (not font-running-xemacs) 2047 (if (and (w3-get-attribute 'text) (not fore))
1941 (setq w3-display-background-properties (cons fore back)) 2048 (progn
1942 (if fore 2049 (setq fore (w3-fix-color (w3-get-attribute 'text)))
1943 (font-set-face-foreground 'default fore (current-buffer))) 2050 (setf (car w3-face-color) fore)))
1944 (if back 2051 (if (not font-running-xemacs)
1945 (font-set-face-background 'default back (current-buffer)))) 2052 (setq w3-display-background-properties (cons fore back))
2053 (if pixm
2054 (w3-maybe-start-background-image-download pixm 'default))
2055 (if fore
2056 (font-set-face-foreground 'default fore (current-buffer)))
2057 (if back
2058 (font-set-face-background 'default back (current-buffer)))))
1946 (w3-handle-content node))) 2059 (w3-handle-content node)))
1947 (*document 2060 (*document
1948 (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) 2061 (let ((info (mapcar (lambda (x) (cons x (symbol-value x)))
1949 w3-persistent-variables))) 2062 w3-persistent-variables)))
1950 (if (not w3-display-same-buffer) 2063 (if (not w3-display-same-buffer)
1965 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) 2078 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
1966 ;; ACK! We don't like filladapt mode! 2079 ;; ACK! We don't like filladapt mode!
1967 (set (make-local-variable 'filladapt-mode) nil) 2080 (set (make-local-variable 'filladapt-mode) nil)
1968 (set (make-local-variable 'adaptive-fill-mode) nil) 2081 (set (make-local-variable 'adaptive-fill-mode) nil)
1969 (set (make-local-variable 'voice-lock-mode) t) 2082 (set (make-local-variable 'voice-lock-mode) t)
2083 (set (make-local-variable 'cur-viewing-pos) (point-min))
1970 (setq w3-current-stylesheet (css-copy-stylesheet 2084 (setq w3-current-stylesheet (css-copy-stylesheet
1971 w3-user-stylesheet) 2085 w3-user-stylesheet)
1972 w3-last-fill-pos (point) 2086 w3-last-fill-pos (point)
1973 fill-prefix "") 2087 fill-prefix "")
1974 ) 2088 )
2064 (if (assq 'selected (nth 1 n)) 2178 (if (assq 'selected (nth 1 n))
2065 (setq value (aref tmp 0))) 2179 (setq value (aref tmp 0)))
2066 tmp)) 2180 tmp))
2067 (nth 2 node)))) 2181 (nth 2 node))))
2068 (if (not value) 2182 (if (not value)
2069 (setq value (aref (car options) 0))) 2183 (setq value (and options (aref (car options) 0))))
2070 (setq plist (plist-put plist 'value value)) 2184 (setq plist (plist-put plist 'value value))
2071 (if multiple 2185 (if multiple
2072 (progn 2186 (progn
2073 (setq options 2187 (setq options
2074 (mapcar 2188 (mapcar
2168 (setq w3-current-stylesheet w3-user-stylesheet) 2282 (setq w3-current-stylesheet w3-user-stylesheet)
2169 (while tree 2283 (while tree
2170 (w3-display-node (car tree)) 2284 (w3-display-node (car tree))
2171 (setq tree (cdr tree))) 2285 (setq tree (cdr tree)))
2172 (w3-display-fix-widgets) 2286 (w3-display-fix-widgets)
2287 (w3-resurrect-hyperlinks)
2173 (w3-form-resurrect-widgets)) 2288 (w3-form-resurrect-widgets))
2174 2289
2175 (defun time-display (&optional tree) 2290 (defun time-display (&optional tree)
2176 ;; Return the # of seconds it took to draw 'tree' 2291 ;; Return the # of seconds it took to draw 'tree'
2177 (let ((st (nth 1 (current-time))) 2292 (let ((st (nth 1 (current-time)))
2194 (defsubst w3-finish-drawing () 2309 (defsubst w3-finish-drawing ()
2195 (let (url glyph widget) 2310 (let (url glyph widget)
2196 (while w3-image-widgets-waiting 2311 (while w3-image-widgets-waiting
2197 (setq widget (car w3-image-widgets-waiting) 2312 (setq widget (car w3-image-widgets-waiting)
2198 w3-image-widgets-waiting (cdr w3-image-widgets-waiting) 2313 w3-image-widgets-waiting (cdr w3-image-widgets-waiting)
2199 url (widget-get widget 'src) 2314 url (widget-get widget :src)
2200 glyph (cdr-safe (assoc url w3-graphics-list))) 2315 glyph (cdr-safe (assoc url w3-graphics-list)))
2201 (condition-case nil 2316 (condition-case nil
2202 (widget-value-set widget glyph) 2317 (widget-value-set widget glyph)
2203 (error nil)))) 2318 (error nil))))
2204 (if (and url-current-object (url-target url-current-object)) 2319 (if (and url-current-object (url-target url-current-object))