Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 116:9f59509498e1 r20-1b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b10
author cvs
date Mon, 13 Aug 2007 09:23:06 +0200
parents 8619ce7e4c50
children 7d55a9ba150c
comparison
equal deleted inserted replaced
115:f109f7dabbe2 116:9f59509498e1
1 ;;; w3-display.el --- display engine v99999 1 ;;; w3-display.el --- display engine v99999
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/18 23:20:40 3 ;; Created: 1997/03/26 15:24:53
4 ;; Version: 1.150 4 ;; Version: 1.157
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.
73 73
74 (eval-when-compile 74 (eval-when-compile
75 (defmacro w3-get-attribute (attr) 75 (defmacro w3-get-attribute (attr)
76 (` (cdr-safe (assq (, attr) args)))) 76 (` (cdr-safe (assq (, attr) args))))
77 77
78 (defmacro w3-get-face-info (info) 78 (defmacro w3-get-face-info (info &optional other)
79 (let ((var (intern (format "w3-face-%s" info)))) 79 (let ((var (intern (format "w3-face-%s" info))))
80 (` (push (w3-get-style-info (quote (, info)) node (car (, var))) 80 (` (push (w3-get-style-info (quote (, info)) node
81 (or (cdr-safe (assq (quote (, other))
82 (nth 1 node)))
83 (car (, var))))
81 (, var))))) 84 (, var)))))
82 85
83 (defmacro w3-pop-face-info (info) 86 (defmacro w3-pop-face-info (info)
84 (let ((var (intern (format "w3-face-%s" info)))) 87 (let ((var (intern (format "w3-face-%s" info))))
85 (` (pop (, var))))) 88 (` (pop (, var)))))
92 (w3-get-face-info font-weight) 95 (w3-get-face-info font-weight)
93 (w3-get-face-info font-variant) 96 (w3-get-face-info font-variant)
94 (w3-get-face-info font-size) 97 (w3-get-face-info font-size)
95 (w3-get-face-info text-decoration) 98 (w3-get-face-info text-decoration)
96 ;;(w3-get-face-info pixmap) 99 ;;(w3-get-face-info pixmap)
97 (w3-get-face-info color) 100 (w3-get-face-info color color)
98 (w3-get-face-info background-color) 101 (w3-get-face-info background-color bgcolor)
99 (setq w3-face-font-spec (make-font 102 (setq w3-face-font-spec (make-font
100 :weight (car w3-face-font-weight) 103 :weight (car w3-face-font-weight)
101 :family (car w3-face-font-family) 104 :family (car w3-face-font-family)
102 :size (car w3-face-font-size)))))) 105 :size (car w3-face-font-size))))))
103 106
282 285
283 ;; nuke spaces at the end 286 ;; nuke spaces at the end
284 (if (string-match "[ \t\n\r]+$" string) 287 (if (string-match "[ \t\n\r]+$" string)
285 (setq string (substring string 0 (match-beginning 0)))) 288 (setq string (substring string 0 (match-beginning 0))))
286 string) 289 string)
287
288 (defvar w3-bullets
289 '((disc . ?*)
290 (circle . ?o)
291 (square . ?#)
292 (none . ? )
293 )
294 "*An assoc list of unordered list types mapping to characters to use
295 as the bullet character.")
296 290
297 291
298 (defsubst w3-display-line-break (n) 292 (defsubst w3-display-line-break (n)
299 (if (or 293 (if (or
300 (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told 294 (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told
726 ((eq t w3-auto-image-alt) 720 ((eq t w3-auto-image-alt)
727 (concat "[IMAGE(" (url-basepath src t) ")] ")) 721 (concat "[IMAGE(" (url-basepath src t) ")] "))
728 ((stringp w3-auto-image-alt) 722 ((stringp w3-auto-image-alt)
729 (format w3-auto-image-alt (url-basepath src t))))) 723 (format w3-auto-image-alt (url-basepath src t)))))
730 (alt (or (w3-get-attribute 'alt) our-alt)) 724 (alt (or (w3-get-attribute 'alt) our-alt))
725 (c nil)
731 (ismap (and (assq 'ismap args) 'ismap)) 726 (ismap (and (assq 'ismap args) 'ismap))
732 (usemap (w3-get-attribute 'usemap)) 727 (usemap (w3-get-attribute 'usemap))
733 (base (w3-get-attribute 'base)) 728 (base (w3-get-attribute 'base))
734 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) 729 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
735 (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target))) 730 (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target)))
736 (widget nil) 731 (widget nil)
737 (align (or (w3-get-attribute 'align) 732 (align (or (w3-get-attribute 'align)
738 (w3-get-style-info 'vertical-align node)))) 733 (w3-get-style-info 'vertical-align node))))
734 (while (setq c (string-match "[\C-i\C-j\C-l\C-m]" alt))
735 (aset alt c ? ))
739 (if (assq '*table-autolayout w3-display-open-element-stack) 736 (if (assq '*table-autolayout w3-display-open-element-stack)
740 (insert alt) 737 (insert alt)
741 (setq widget (widget-create 'image 738 (setq widget (widget-create 'image
742 :value-face w3-active-faces 739 :value-face w3-active-faces
743 'src src ; Where to load the image from 740 'src src ; Where to load the image from
755 (list 'html-stack w3-display-open-element-stack))) 752 (list 'html-stack w3-display-open-element-stack)))
756 (goto-char (point-max)))))) 753 (goto-char (point-max))))))
757 754
758 ;; The table handling 755 ;; The table handling
759 756
757 (defvar w3-table-ascii-border-chars
758 [nil nil nil ?/ nil ?- ?\\ ?- nil ?\\ ?| ?| ?/ ?- ?| ?+]
759 "*Vector of ascii characters to use to draw table borders.
760 This vector is used when terminal characters are unavailable")
761
762 (defvar w3-table-glyph-border-chars
763 [nil nil nil 11 nil 2 7 14 nil 3 8 6 1 15 4 5]
764 "Vector of characters to use to draw table borders.
765 This vector is used when terminal characters are used via glyphs")
766
767 (defvar w3-table-graphic-border-chars
768 [nil nil nil ?j nil ?q ?m ?v nil ?k ?x ?u ?l ?w ?t ?n]
769 "Vector of characters to use to draw table borders.
770 This vector is used when terminal characters are used directly")
771
772 (defvar w3-table-border-chars w3-table-ascii-border-chars
773 "Vector of characters to use to draw table borders.
774 w3-setup-terminal-chars sets this to one of
775 w3-table-ascii-border-chars,
776 w3-table-glyph-border-chars, or
777 w3-table-graphic-border-chars.")
778
779 (defsubst w3-table-lookup-char (l u r b)
780 (aref w3-table-border-chars (logior (if l 1 0)
781 (if u 2 0)
782 (if r 4 0)
783 (if b 8 0))))
784
785 (defvar w3-terminal-properties nil)
786
787 (defsubst w3-insert-terminal-char (character &optional count inherit)
788 (if w3-terminal-properties
789 (set-text-properties (point)
790 (progn
791 (insert-char (or character ? )
792 (or count 1) inherit)
793 (point))
794 w3-terminal-properties)
795 (insert-char (or character ? ) (or count 1) inherit)))
796
797 (defsubst w3-horizontal-rule-char nil
798 (or w3-horizontal-rule-char (w3-table-lookup-char t nil t nil)))
799
800 (defun w3-setup-terminal-chars nil
801 "Try to find the best set of characters to draw table borders with.
802 On a console, this can trigger some Emacs display bugs.
803
804 Initializes a number of variables:
805 w3-terminal-properties to either nil or a list of properties including 'face
806 w3-table-border-chars to one of the the three other vectors"
807 (interactive)
808 (setq w3-table-border-chars w3-table-ascii-border-chars
809 w3-terminal-properties nil)
810 (cond
811 ((and w3-use-terminal-characters
812 (eq (device-type) 'x))
813 (if (find-face 'w3-table-hack-x-face) nil
814 (make-face 'w3-table-hack-x-face)
815 (font-set-face-font 'w3-table-hack-x-face
816 (make-font :family "terminal")))
817 (cond
818 ((not (face-differs-from-default-p 'w3-table-hack-x-face))
819 nil)
820 ((and w3-use-terminal-glyphs (fboundp 'face-id))
821 (let ((id (face-id 'w3-table-hack-x-face))
822 (c (length w3-table-border-chars)))
823 (while (> (decf c) 0)
824 (if (aref w3-table-glyph-border-chars c)
825 (aset standard-display-table (aref w3-table-glyph-border-chars c)
826 (vector (+ (* 256 id)
827 (aref w3-table-graphic-border-chars c))))))
828 (setq w3-table-border-chars w3-table-glyph-border-chars
829 w3-terminal-properties nil)))
830 (t
831 (setq w3-table-border-chars w3-table-graphic-border-chars
832 w3-terminal-properties (list 'start-open t
833 'end-open t
834 'rear-nonsticky t
835 'w3-table-border t
836 'face 'w3-table-hack-x-face)))))
837 ((and w3-use-terminal-characters-on-tty
838 (eq (device-type) 'tty))
839 (let ((c (length w3-table-border-chars)))
840 (while (> (decf c) 0)
841 (and (aref w3-table-glyph-border-chars c)
842 (aref w3-table-graphic-border-chars c)
843 (standard-display-g1 (aref w3-table-glyph-border-chars c)
844 (aref w3-table-graphic-border-chars c)))))
845 (setq w3-table-border-chars w3-table-glyph-border-chars
846 w3-terminal-properties (list 'w3-table-border t)))
847 (t
848 nil))
849 w3-table-border-chars)
850
851 (defun w3-unsetup-terminal-characters nil
852 (interactive)
853 (w3-excise-terminal-characters (buffer-list))
854 (standard-display-default 1 15)
855 (setq w3-table-border-chars w3-table-ascii-border-chars))
856
857 (defun w3-excise-terminal-characters (buffs)
858 "Replace hacked characters with ascii characters in buffers BUFFS.
859 Should be run before restoring w3-table-border-chars to ascii characters.
860 This will only work if we used glyphs rather than text properties"
861 (interactive (list (list (current-buffer))))
862 (let ((inhibit-read-only t)
863 (tr (make-string 16 ? ))
864 (i 0))
865 (while (< i (length tr))
866 (aset tr i i)
867 (setq i (1+ i)))
868 (setq i 0)
869 (while (< i (length w3-table-border-chars))
870 (and (aref w3-table-border-chars i)
871 (< (aref w3-table-border-chars i) 16)
872 (aset tr
873 (aref w3-table-glyph-border-chars i)
874 (aref w3-table-ascii-border-chars i)))
875 (setq i (1+ i)))
876 (mapcar (function (lambda (buf)
877 (save-excursion
878 (set-buffer buf)
879 (if (eq major-mode 'w3-mode)
880 (translate-region (point-min)
881 (point-max)
882 tr)))))
883 buffs)))
884
885
760 (defvar w3-display-table-cut-words-p nil 886 (defvar w3-display-table-cut-words-p nil
761 "*Whether to cut words that are oversized in table cells") 887 "*Whether to cut words that are oversized in table cells")
762 888
763 (defvar w3-display-table-force-borders nil 889 (defvar w3-display-table-force-borders nil
764 "*Whether to always draw table borders") 890 "*Whether to always draw table borders
891 Can sometimes make the structure of a document clearer")
765 892
766 (defun w3-display-table-cut () 893 (defun w3-display-table-cut ()
767 (save-excursion 894 (save-excursion
768 (goto-char (point-min)) 895 (goto-char (point-min))
769 (let ((offset -1)) 896 (let ((offset -1))
826 (w3-last-fill-pos (point-min)) 953 (w3-last-fill-pos (point-min))
827 a retval 954 a retval
828 (w3-do-incremental-display nil) 955 (w3-do-incremental-display nil)
829 (hr-regexp (concat "^" 956 (hr-regexp (concat "^"
830 (regexp-quote 957 (regexp-quote
831 (make-string 5 w3-horizontal-rule-char)) 958 (make-string 5 (w3-horizontal-rule-char)))
832 "*$")) 959 "*$"))
833 ) 960 )
834 ;;(push 'left w3-display-alignment-stack) 961 ;;(push 'left w3-display-alignment-stack)
835 (push (if (eq minmax 'max) 'nowrap) w3-display-whitespace-stack) 962 (push (if (eq minmax 'max) 'nowrap) w3-display-whitespace-stack)
836 (while tree 963 (while tree
1040 (setq extra (1- extra) 1167 (setq extra (1- extra)
1041 col (1+ col))) 1168 col (1+ col)))
1042 ))) 1169 )))
1043 (list rows cols ret-vector)))) 1170 (list rows cols ret-vector))))
1044 1171
1045 (defvar w3-table-ascii-border-chars
1046 [? ? ? ?/ ? ?- ?\\ ?- ? ?\\ ?| ?| ?/ ?- ?| ?-]
1047 "Vector of ascii characters to use to draw table borders.
1048 w3-table-unhack-border-chars uses this to restore w3-table-border-chars.")
1049
1050 (defvar w3-table-border-chars w3-table-ascii-border-chars
1051 "Vector of characters to use to draw table borders.
1052 If you set this you should set w3-table-ascii-border-chars to the same value
1053 so that w3-table-unhack-borders can restore the value if necessary.
1054
1055 A reasonable value is [? ? ? ?/ ? ?- ?\\\\ ?^ ? ?\\\\ ?| ?< ?/ ?- ?> ?-]
1056 Though i recommend replacing the ^ with - and the < and > with |")
1057
1058 (defsubst w3-table-lookup-char (l u r b)
1059 (aref w3-table-border-chars (logior (if l 1 0)
1060 (if u 2 0)
1061 (if r 4 0)
1062 (if b 8 0))))
1063
1064 (defun w3-table-hack-borders nil
1065 "Try to find the best set of characters to draw table borders with.
1066 I definitely recommend trying this on X.
1067 On a console, this can trigger some Emacs display bugs.
1068
1069 I haven't tried this on XEmacs or any window-system other than X."
1070 (interactive)
1071 (case (device-type)
1072 (x
1073 (let ((id (or (and (find-face 'w3-table-hack-x-face)
1074 (face-id 'w3-table-hack-x-face))
1075 (progn
1076 (make-face 'w3-table-hack-x-face)
1077 (font-set-face-font 'w3-table-hack-x-face
1078 (make-font :family "terminal"))
1079 (face-id 'w3-table-hack-x-face)))))
1080 (if (not (face-differs-from-default-p 'w3-table-hack-x-face))
1081 nil
1082 (aset standard-display-table 1 (vector (+ (* 256 id) ?l)))
1083 (aset standard-display-table 2 (vector (+ (* 256 id) ?q)))
1084 (aset standard-display-table 3 (vector (+ (* 256 id) ?k)))
1085 (aset standard-display-table 4 (vector (+ (* 256 id) ?t)))
1086 (aset standard-display-table 5 (vector (+ (* 256 id) ?n)))
1087 (aset standard-display-table 6 (vector (+ (* 256 id) ?u)))
1088 (aset standard-display-table 7 (vector (+ (* 256 id) ?m)))
1089 (aset standard-display-table 8 (vector (+ (* 256 id) ?x)))
1090 (aset standard-display-table 11 (vector (+ (* 256 id) ?j)))
1091 (aset standard-display-table 14 (vector (+ (* 256 id) ?v)))
1092 (aset standard-display-table 15 (vector (+ (* 256 id) ?w)))
1093 (setq w3-table-border-chars [? ? ? 11 ? 2 7 14 ? 3 8 6 1 15 4 5])
1094 (setq w3-horizontal-rule-char 2))))
1095 (tty
1096 (standard-display-g1 1 108) ; ulcorner
1097 (standard-display-g1 2 113) ; hline
1098 (standard-display-g1 3 107) ; urcorner
1099 (standard-display-g1 4 116) ; leftt
1100 (standard-display-g1 5 110) ; intersection
1101 (standard-display-g1 6 117) ; rightt
1102 (standard-display-g1 7 109) ; llcorner
1103 (standard-display-g1 8 120) ; vline
1104 (standard-display-g1 11 106) ; lrcorner
1105 (standard-display-g1 14 118) ; upt
1106 (standard-display-g1 15 119) ; downt
1107 (setq w3-table-border-chars [? ? ? 11 ? 2 7 14 ? 3 8 6 1 15 4 5])
1108 (setq w3-horizontal-rule-char 2))
1109 (otherwise
1110 (error "Unknown window-system, can't do any better than ascii borders")))
1111 )
1112
1113 (defun w3-table-unhack-borders nil
1114 (interactive)
1115 (w3-table-excise-hack (buffer-list))
1116 (standard-display-default 1 15)
1117 (setq w3-table-border-chars w3-table-ascii-border-chars)
1118 (setq w3-horizontal-rule-char ?-))
1119
1120 (defun w3-table-excise-hack (buffs)
1121 "Replace hacked characters with ascii characters in buffers BUFFS.
1122 Should be run before restoring w3-table-border-chars to ascii characters."
1123 (interactive (list (list (current-buffer))))
1124 (let ((inhibit-read-only t)
1125 (tr (make-string 16 ? ))
1126 (i 0))
1127 (while (< i (length tr))
1128 (aset tr i i)
1129 (setq i (1+ i)))
1130 (setq i 0)
1131 (while (< i (length w3-table-border-chars))
1132 (if (< (aref w3-table-border-chars i) 16)
1133 (aset tr
1134 (aref w3-table-border-chars i)
1135 (aref w3-table-ascii-border-chars i)))
1136 (setq i (1+ i)))
1137 (mapcar (function (lambda (buf)
1138 (save-excursion
1139 (set-buffer buf)
1140 (if (eq major-mode 'w3-mode)
1141 (translate-region (point-min)
1142 (point-max)
1143 tr)))))
1144 buffs)))
1145
1146 (defun w3-display-table (node) 1172 (defun w3-display-table (node)
1147 (let* ((dimensions (w3-display-table-dimensions node)) 1173 (let* ((dimensions (w3-display-table-dimensions node))
1148 (num-cols (max (cadr dimensions) 1)) 1174 (num-cols (max (cadr dimensions) 1))
1149 (num-rows (max (car dimensions) 1)) 1175 (num-rows (max (car dimensions) 1))
1150 (column-dimensions (caddr dimensions)) 1176 (column-dimensions (caddr dimensions))
1347 1373
1348 (setq rflag (= (aref prev-rowspans i) 0)) 1374 (setq rflag (= (aref prev-rowspans i) 0))
1349 (setq bflag (/= (aref table-colspans i) 0)) 1375 (setq bflag (/= (aref table-colspans i) 0))
1350 (setq tflag (/= (aref prev-colspans i) 0)) 1376 (setq tflag (/= (aref prev-colspans i) 0))
1351 1377
1352 (insert (w3-table-lookup-char lflag tflag rflag bflag)) 1378 (w3-insert-terminal-char (w3-table-lookup-char lflag tflag rflag bflag))
1353 (setq lflag t) 1379 (setq lflag t)
1354 (cond ((= (aref prev-rowspans i) 0) 1380 (cond ((= (aref prev-rowspans i) 0)
1355 (insert-char (w3-table-lookup-char t nil t nil) 1381 (w3-insert-terminal-char
1356 (aref column-dimensions i)) 1382 (w3-table-lookup-char t nil t nil)
1383 (aref column-dimensions i))
1357 (setq i (1+ i))) 1384 (setq i (1+ i)))
1358 ((car (aref formatted-cols i)) 1385 ((car (aref formatted-cols i))
1359 (insert (pop (aref formatted-cols i))) 1386 (insert (pop (aref formatted-cols i)))
1360 (setq lflag nil) 1387 (setq lflag nil)
1361 (setq i (+ i (max (aref table-colspans i) 1388 (setq i (+ i (max (aref table-colspans i)
1363 (t 1390 (t
1364 (insert-char ? (aref table-colwidth i)) 1391 (insert-char ? (aref table-colwidth i))
1365 (setq lflag nil) 1392 (setq lflag nil)
1366 (setq i (+ i (max (aref table-colspans i) 1393 (setq i (+ i (max (aref table-colspans i)
1367 (aref prev-colspans i) 1)))))) 1394 (aref prev-colspans i) 1))))))
1368 (insert (w3-table-lookup-char lflag (/= row 1) nil t) "\n")) 1395 (w3-insert-terminal-char (w3-table-lookup-char lflag (/= row 1) nil t))
1369 1396 (insert "\n"))
1397
1370 ;; recalculate height (in case we've shortened a rowspanning cell 1398 ;; recalculate height (in case we've shortened a rowspanning cell
1371 (setq height 0 1399 (setq height 0
1372 i 0) 1400 i 0)
1373 (while (< i num-cols) 1401 (while (< i num-cols)
1374 (if (= 1 (aref table-rowspans i)) 1402 (if (= 1 (aref table-rowspans i))
1375 (setq height (max height (length (aref formatted-cols i))))) 1403 (setq height (max height (length (aref formatted-cols i)))))
1376 (setq i (+ i (max 1 (aref table-colspans i))))) 1404 (setq i (+ i (max 1 (aref table-colspans i)))))
1377 1405
1378 ;; Insert a row back in original buffer 1406 ;; Insert a row back in original buffer
1379 (while (> height 0) 1407 (while (> height 0)
1380 (insert fill-prefix (w3-table-lookup-char nil t nil t)) 1408 (insert fill-prefix)
1409 (w3-insert-terminal-char (w3-table-lookup-char nil t nil t))
1381 (setq i 0) 1410 (setq i 0)
1382 (while (< i num-cols) 1411 (while (< i num-cols)
1383 (if (car (aref formatted-cols i)) 1412 (if (car (aref formatted-cols i))
1384 (insert (pop (aref formatted-cols i))) 1413 (insert (pop (aref formatted-cols i)))
1385 (insert-char ? (aref table-colwidth i))) 1414 (insert-char ? (aref table-colwidth i)))
1386 (insert (w3-table-lookup-char nil t nil t)) 1415 (w3-insert-terminal-char (w3-table-lookup-char nil t nil t))
1387 (setq i (+ i (max (aref table-colspans i) 1)))) 1416 (setq i (+ i (max (aref table-colspans i) 1))))
1388 (insert "\n") 1417 (insert "\n")
1389 ;;(and w3-do-incremental-display (w3-pause)) 1418 ;;(and w3-do-incremental-display (w3-pause))
1390 (setq height (1- height))) 1419 (setq height (1- height)))
1391 1420
1416 (insert fill-prefix) 1445 (insert fill-prefix)
1417 (setq i 0) 1446 (setq i 0)
1418 (let (tflag lflag) 1447 (let (tflag lflag)
1419 (while (< i num-cols) 1448 (while (< i num-cols)
1420 (setq tflag (/= (aref prev-colspans i) 0)) 1449 (setq tflag (/= (aref prev-colspans i) 0))
1421 (insert (w3-table-lookup-char lflag tflag t nil)) 1450 (w3-insert-terminal-char (w3-table-lookup-char lflag tflag t nil))
1422 (setq lflag t) 1451 (setq lflag t)
1423 (insert-char (w3-table-lookup-char t nil t nil) 1452 (w3-insert-terminal-char
1424 (aref column-dimensions i)) 1453 (w3-table-lookup-char t nil t nil)
1454 (aref column-dimensions i))
1425 (setq i (1+ i))) 1455 (setq i (1+ i)))
1426 (insert (w3-table-lookup-char t t nil nil) "\n"))) 1456 (w3-insert-terminal-char
1457 (w3-table-lookup-char t t nil nil))
1458 (insert "\n")))
1427 ) 1459 )
1428 (pop w3-display-open-element-stack))))) 1460 (pop w3-display-open-element-stack)))))
1429 1461
1430 1462
1431 1463
1706 ) 1738 )
1707 (hr ; Cause line break & insert rule 1739 (hr ; Cause line break & insert rule
1708 (let* ((perc (or (w3-get-attribute 'width) 1740 (let* ((perc (or (w3-get-attribute 'width)
1709 (w3-get-style-info 'width node) 1741 (w3-get-style-info 'width node)
1710 "100%")) 1742 "100%"))
1711 (rule nil)
1712 (width nil)) 1743 (width nil))
1713 (setq perc (/ (min (string-to-int perc) 100) 100.0) 1744 (setq perc (/ (min (string-to-int perc) 100) 100.0)
1714 width (* fill-column perc) 1745 width (truncate (* fill-column perc)))
1715 rule (make-string (max (truncate width) 0) 1746 (w3-insert-terminal-char (w3-horizontal-rule-char) width)
1716 w3-horizontal-rule-char) 1747 (w3-handle-empty-tag)))
1717 node (list 'hr nil (list rule)))
1718 (w3-handle-content node)))
1719 (map ; Client side imagemaps 1748 (map ; Client side imagemaps
1720 (let ((name (or (w3-get-attribute 'name) 1749 (let ((name (or (w3-get-attribute 'name)
1721 (w3-get-attribute 'id) 1750 (w3-get-attribute 'id)
1722 "unnamed")) 1751 "unnamed"))
1723 (areas 1752 (areas
1793 (list (cons 'type "text") 1822 (list (cons 'type "text")
1794 (cons 'name "isindex")))))))) 1823 (cons 'name "isindex"))))))))
1795 (w3-handle-content node) 1824 (w3-handle-content node)
1796 (setq w3-current-isindex (cons action prompt))) 1825 (setq w3-current-isindex (cons action prompt)))
1797 ) 1826 )
1827 ((html body)
1828 (let ((fore (car (delq nil (copy-list w3-face-color))))
1829 (back (car (delq nil (copy-list w3-face-background-color))))
1830 )
1831 (if (and fore font-running-xemacs)
1832 (font-set-face-foreground 'default fore (current-buffer)))
1833 (if (and back font-running-xemacs)
1834 (font-set-face-background 'default back (current-buffer)))
1835 (w3-handle-content node)))
1798 (*document 1836 (*document
1799 (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) 1837 (let ((info (mapcar (lambda (x) (cons x (symbol-value x)))
1800 w3-persistent-variables))) 1838 w3-persistent-variables)))
1801 (if (not w3-display-same-buffer) 1839 (if (not w3-display-same-buffer)
1802 (set-buffer (generate-new-buffer "Untitled"))) 1840 (set-buffer (generate-new-buffer "Untitled")))
1806 (setcar right-margin-stack 1844 (setcar right-margin-stack
1807 (min (- (or w3-strict-width (window-width)) 1845 (min (- (or w3-strict-width (window-width))
1808 w3-right-margin) 1846 w3-right-margin)
1809 (or w3-maximum-line-length 1847 (or w3-maximum-line-length
1810 (window-width)))) 1848 (window-width))))
1811 (switch-to-buffer (current-buffer)) 1849 (condition-case nil
1850 (switch-to-buffer (current-buffer))
1851 (error (message "W3 buffer %s is being drawn." (buffer-name (current-buffer)))))
1852
1812 (buffer-disable-undo (current-buffer)) 1853 (buffer-disable-undo (current-buffer))
1813 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) 1854 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
1814 ;; ACK! We don't like filladapt mode! 1855 ;; ACK! We don't like filladapt mode!
1815 (set (make-local-variable 'filladapt-mode) nil) 1856 (set (make-local-variable 'filladapt-mode) nil)
1816 (set (make-local-variable 'adaptive-fill-mode) nil) 1857 (set (make-local-variable 'adaptive-fill-mode) nil)
1877 (setq w3-display-form-id (cons 1918 (setq w3-display-form-id (cons
1878 (cons 'form-number 1919 (cons 'form-number
1879 w3-current-form-number) 1920 w3-current-form-number)
1880 args)) 1921 args))
1881 (w3-handle-content node))) 1922 (w3-handle-content node)))
1882 ; (keygen 1923 (keygen
1883 ; (w3-form-add-element 'keygen 1924 (w3-form-add-element
1884 ; (or (w3-get-attribute 'name) 1925 (w3-display-normalize-form-info
1885 ; (w3-get-attribute 'id) 1926 (cons '(type . "keygen")
1886 ; "keygen") 1927 args))
1887 ; nil ; value 1928 w3-active-faces)
1888 ; nil ; size 1929 (w3-handle-empty-tag))
1889 ; nil ; maxlength
1890 ; nil ; default
1891 ; w3-display-form-id ; action
1892 ; nil ; options
1893 ; w3-current-form-number
1894 ; (w3-get-attribute 'id) ; id
1895 ; nil ; checked
1896 ; (car w3-active-faces)))
1897 (input 1930 (input
1898 (w3-form-add-element 1931 (w3-form-add-element
1899 (w3-display-normalize-form-info args) 1932 (w3-display-normalize-form-info args)
1900 w3-active-faces) 1933 w3-active-faces)
1901 (w3-handle-empty-tag) 1934 (w3-handle-empty-tag)
1955 ;; widget instead of after. 1988 ;; widget instead of after.
1956 (goto-char (point-max)) 1989 (goto-char (point-max))
1957 (w3-handle-empty-tag)))) 1990 (w3-handle-empty-tag))))
1958 (textarea 1991 (textarea
1959 (let* ((plist (w3-display-normalize-form-info args)) 1992 (let* ((plist (w3-display-normalize-form-info args))
1960 (value (w3-normalize-spaces 1993 (value (apply 'concat (nth 2 node))))
1961 (apply 'concat (nth 2 node)))))
1962 (setq plist (plist-put plist 'type 'multiline) 1994 (setq plist (plist-put plist 'type 'multiline)
1963 plist (plist-put plist 'value value)) 1995 plist (plist-put plist 'value value))
1964 (w3-form-add-element plist w3-active-faces)) 1996 (w3-form-add-element plist w3-active-faces))
1965 (w3-handle-empty-tag) 1997 (w3-handle-empty-tag)
1966 ) 1998 )
2038 (- nd st))) 2070 (- nd st)))
2039 2071
2040 2072
2041 (defun w3-fixup-eol-faces () 2073 (defun w3-fixup-eol-faces ()
2042 ;; Remove 'face property at end of lines - underlining screws up stuff 2074 ;; Remove 'face property at end of lines - underlining screws up stuff
2075 ;; also remove 'mouse-face property at the beginning and end of lines
2043 (let ((inhibit-read-only t)) 2076 (let ((inhibit-read-only t))
2044 (save-excursion 2077 (save-excursion
2045 (goto-char (point-min)) 2078 (goto-char (point-min))
2046 (while (search-forward "\n" nil t) 2079 (while (search-forward "[ \t]*\n[ \t]*" nil t)
2047 (put-text-property (match-beginning 0) (match-end 0) 'face nil))))) 2080 (remove-text-properties (match-beginning 0) (match-end 0)
2081 '(face nil mouse-face nil) nil)))))
2048 2082
2049 (defsubst w3-finish-drawing () 2083 (defsubst w3-finish-drawing ()
2050 (let (url glyph widget) 2084 (let (url glyph widget)
2051 (while w3-image-widgets-waiting 2085 (while w3-image-widgets-waiting
2052 (setq widget (car w3-image-widgets-waiting) 2086 (setq widget (car w3-image-widgets-waiting)
2063 (goto-char (point-min))) 2097 (goto-char (point-min)))
2064 (and (not w3-running-xemacs) 2098 (and (not w3-running-xemacs)
2065 (not (eq (device-type) 'tty)) 2099 (not (eq (device-type) 'tty))
2066 (w3-fixup-eol-faces)) 2100 (w3-fixup-eol-faces))
2067 (let ((inhibit-read-only t)) 2101 (let ((inhibit-read-only t))
2068 (put-text-property (point-min) (point-max) 'read-only nil)) 2102 (remove-text-properties (point-min) (point-max) '(read-only) nil))
2069 (message "Drawing... done")) 2103 (message "Drawing... done"))
2070 2104
2071 (defun w3-region (st nd) 2105 (defun w3-region (st nd)
2072 (if (not w3-setup-done) (w3-do-setup)) 2106 (if (not w3-setup-done) (w3-do-setup))
2073 (let* ((source (buffer-substring st nd)) 2107 (let* ((source (buffer-substring st nd))