Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 44:8d2a9b52c682 r19-15prefinal

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15prefinal
author cvs
date Mon, 13 Aug 2007 08:55:10 +0200
parents 1a767b41a199
children 6a22abad6937
comparison
equal deleted inserted replaced
43:23cafc5d2038 44:8d2a9b52c682
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 00:03:00
4 ;; Version: 1.150 4 ;; Version: 1.156
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 (w3-get-attribute (quote (, other)))
82 (car (, var))))
81 (, var))))) 83 (, var)))))
82 84
83 (defmacro w3-pop-face-info (info) 85 (defmacro w3-pop-face-info (info)
84 (let ((var (intern (format "w3-face-%s" info)))) 86 (let ((var (intern (format "w3-face-%s" info))))
85 (` (pop (, var))))) 87 (` (pop (, var)))))
92 (w3-get-face-info font-weight) 94 (w3-get-face-info font-weight)
93 (w3-get-face-info font-variant) 95 (w3-get-face-info font-variant)
94 (w3-get-face-info font-size) 96 (w3-get-face-info font-size)
95 (w3-get-face-info text-decoration) 97 (w3-get-face-info text-decoration)
96 ;;(w3-get-face-info pixmap) 98 ;;(w3-get-face-info pixmap)
97 (w3-get-face-info color) 99 (w3-get-face-info color color)
98 (w3-get-face-info background-color) 100 (w3-get-face-info background-color bgcolor)
99 (setq w3-face-font-spec (make-font 101 (setq w3-face-font-spec (make-font
100 :weight (car w3-face-font-weight) 102 :weight (car w3-face-font-weight)
101 :family (car w3-face-font-family) 103 :family (car w3-face-font-family)
102 :size (car w3-face-font-size)))))) 104 :size (car w3-face-font-size))))))
103 105
282 284
283 ;; nuke spaces at the end 285 ;; nuke spaces at the end
284 (if (string-match "[ \t\n\r]+$" string) 286 (if (string-match "[ \t\n\r]+$" string)
285 (setq string (substring string 0 (match-beginning 0)))) 287 (setq string (substring string 0 (match-beginning 0))))
286 string) 288 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 289
297 290
298 (defsubst w3-display-line-break (n) 291 (defsubst w3-display-line-break (n)
299 (if (or 292 (if (or
300 (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told 293 (memq (car w3-display-whitespace-stack) '(pre nowrap)) ; Been told
726 ((eq t w3-auto-image-alt) 719 ((eq t w3-auto-image-alt)
727 (concat "[IMAGE(" (url-basepath src t) ")] ")) 720 (concat "[IMAGE(" (url-basepath src t) ")] "))
728 ((stringp w3-auto-image-alt) 721 ((stringp w3-auto-image-alt)
729 (format w3-auto-image-alt (url-basepath src t))))) 722 (format w3-auto-image-alt (url-basepath src t)))))
730 (alt (or (w3-get-attribute 'alt) our-alt)) 723 (alt (or (w3-get-attribute 'alt) our-alt))
724 (c nil)
731 (ismap (and (assq 'ismap args) 'ismap)) 725 (ismap (and (assq 'ismap args) 'ismap))
732 (usemap (w3-get-attribute 'usemap)) 726 (usemap (w3-get-attribute 'usemap))
733 (base (w3-get-attribute 'base)) 727 (base (w3-get-attribute 'base))
734 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) 728 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
735 (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target))) 729 (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target)))
736 (widget nil) 730 (widget nil)
737 (align (or (w3-get-attribute 'align) 731 (align (or (w3-get-attribute 'align)
738 (w3-get-style-info 'vertical-align node)))) 732 (w3-get-style-info 'vertical-align node))))
733 (while (setq c (string-match "[\C-i\C-j\C-l\C-m]" alt))
734 (aset alt c ? ))
739 (if (assq '*table-autolayout w3-display-open-element-stack) 735 (if (assq '*table-autolayout w3-display-open-element-stack)
740 (insert alt) 736 (insert alt)
741 (setq widget (widget-create 'image 737 (setq widget (widget-create 'image
742 :value-face w3-active-faces 738 :value-face w3-active-faces
743 'src src ; Where to load the image from 739 'src src ; Where to load the image from
755 (list 'html-stack w3-display-open-element-stack))) 751 (list 'html-stack w3-display-open-element-stack)))
756 (goto-char (point-max)))))) 752 (goto-char (point-max))))))
757 753
758 ;; The table handling 754 ;; The table handling
759 755
756 (defvar w3-table-ascii-border-chars
757 [nil nil nil ?/ nil ?- ?\\ ?- nil ?\\ ?| ?| ?/ ?- ?| ?+]
758 "*Vector of ascii characters to use to draw table borders.
759 This vector is used when terminal characters are unavailable")
760
761 (defvar w3-table-glyph-border-chars
762 [nil nil nil 11 nil 2 7 14 nil 3 8 6 1 15 4 5]
763 "Vector of characters to use to draw table borders.
764 This vector is used when terminal characters are used via glyphs")
765
766 (defvar w3-table-graphic-border-chars
767 [nil nil nil ?j nil ?q ?m ?v nil ?k ?x ?u ?l ?w ?t ?n]
768 "Vector of characters to use to draw table borders.
769 This vector is used when terminal characters are used directly")
770
771 (defvar w3-table-border-chars w3-table-ascii-border-chars
772 "Vector of characters to use to draw table borders.
773 w3-setup-terminal-chars sets this to one of
774 w3-table-ascii-border-chars,
775 w3-table-glyph-border-chars, or
776 w3-table-graphic-border-chars.")
777
778 (defsubst w3-table-lookup-char (l u r b)
779 (aref w3-table-border-chars (logior (if l 1 0)
780 (if u 2 0)
781 (if r 4 0)
782 (if b 8 0))))
783
784 (defvar w3-terminal-properties nil)
785
786 (defsubst w3-insert-terminal-char (character &optional count inherit)
787 (if w3-terminal-properties
788 (set-text-properties (point)
789 (progn
790 (insert-char (or character ? )
791 (or count 1) inherit)
792 (point))
793 w3-terminal-properties)
794 (insert-char (or character ? ) (or count 1) inherit)))
795
796 (defsubst w3-horizontal-rule-char nil
797 (or w3-horizontal-rule-char (w3-table-lookup-char t nil t nil)))
798
799 (defun w3-setup-terminal-chars nil
800 "Try to find the best set of characters to draw table borders with.
801 On a console, this can trigger some Emacs display bugs.
802
803 Initializes a number of variables:
804 w3-terminal-properties to either nil or a list of properties including 'face
805 w3-table-border-chars to one of the the three other vectors"
806 (interactive)
807 (setq w3-table-border-chars w3-table-ascii-border-chars
808 w3-terminal-properties nil)
809 (cond
810 ((and w3-use-terminal-characters
811 (eq (device-type) 'x))
812 (if (find-face 'w3-table-hack-x-face) nil
813 (make-face 'w3-table-hack-x-face)
814 (font-set-face-font 'w3-table-hack-x-face
815 (make-font :family "terminal")))
816 (cond
817 ((not (face-differs-from-default-p 'w3-table-hack-x-face))
818 nil)
819 ((and w3-use-terminal-glyphs (fboundp 'face-id))
820 (let ((id (face-id 'w3-table-hack-x-face))
821 (c (length w3-table-border-chars)))
822 (while (> (decf c) 0)
823 (if (aref w3-table-glyph-border-chars c)
824 (aset standard-display-table (aref w3-table-glyph-border-chars c)
825 (vector (+ (* 256 id)
826 (aref w3-table-graphic-border-chars c))))))
827 (setq w3-table-border-chars w3-table-glyph-border-chars
828 w3-terminal-properties nil)))
829 (t
830 (setq w3-table-border-chars w3-table-graphic-border-chars
831 w3-terminal-properties (list 'start-open t
832 'end-open t
833 'rear-nonsticky t
834 'w3-table-border t
835 'face 'w3-table-hack-x-face)))))
836 ((and w3-use-terminal-characters-on-tty
837 (eq (device-type) 'tty))
838 (let ((c (length w3-table-border-chars)))
839 (while (> (decf c) 0)
840 (and (aref w3-table-glyph-border-chars c)
841 (aref w3-table-graphic-border-chars c)
842 (standard-display-g1 (aref w3-table-glyph-border-chars c)
843 (aref w3-table-graphic-border-chars c)))))
844 (setq w3-table-border-chars w3-table-glyph-border-chars
845 w3-terminal-properties (list 'w3-table-border t)))
846 (t
847 nil))
848 w3-table-border-chars)
849
850 (defun w3-unsetup-terminal-characters nil
851 (interactive)
852 (w3-excise-terminal-characters (buffer-list))
853 (standard-display-default 1 15)
854 (setq w3-table-border-chars w3-table-ascii-border-chars))
855
856 (defun w3-excise-terminal-characters (buffs)
857 "Replace hacked characters with ascii characters in buffers BUFFS.
858 Should be run before restoring w3-table-border-chars to ascii characters.
859 This will only work if we used glyphs rather than text properties"
860 (interactive (list (list (current-buffer))))
861 (let ((inhibit-read-only t)
862 (tr (make-string 16 ? ))
863 (i 0))
864 (while (< i (length tr))
865 (aset tr i i)
866 (setq i (1+ i)))
867 (setq i 0)
868 (while (< i (length w3-table-border-chars))
869 (and (aref w3-table-border-chars i)
870 (< (aref w3-table-border-chars i) 16)
871 (aset tr
872 (aref w3-table-glyph-border-chars i)
873 (aref w3-table-ascii-border-chars i)))
874 (setq i (1+ i)))
875 (mapcar (function (lambda (buf)
876 (save-excursion
877 (set-buffer buf)
878 (if (eq major-mode 'w3-mode)
879 (translate-region (point-min)
880 (point-max)
881 tr)))))
882 buffs)))
883
884
760 (defvar w3-display-table-cut-words-p nil 885 (defvar w3-display-table-cut-words-p nil
761 "*Whether to cut words that are oversized in table cells") 886 "*Whether to cut words that are oversized in table cells")
762 887
763 (defvar w3-display-table-force-borders nil 888 (defvar w3-display-table-force-borders nil
764 "*Whether to always draw table borders") 889 "*Whether to always draw table borders
890 Can sometimes make the structure of a document clearer")
765 891
766 (defun w3-display-table-cut () 892 (defun w3-display-table-cut ()
767 (save-excursion 893 (save-excursion
768 (goto-char (point-min)) 894 (goto-char (point-min))
769 (let ((offset -1)) 895 (let ((offset -1))
826 (w3-last-fill-pos (point-min)) 952 (w3-last-fill-pos (point-min))
827 a retval 953 a retval
828 (w3-do-incremental-display nil) 954 (w3-do-incremental-display nil)
829 (hr-regexp (concat "^" 955 (hr-regexp (concat "^"
830 (regexp-quote 956 (regexp-quote
831 (make-string 5 w3-horizontal-rule-char)) 957 (make-string 5 (w3-horizontal-rule-char)))
832 "*$")) 958 "*$"))
833 ) 959 )
834 ;;(push 'left w3-display-alignment-stack) 960 ;;(push 'left w3-display-alignment-stack)
835 (push (if (eq minmax 'max) 'nowrap) w3-display-whitespace-stack) 961 (push (if (eq minmax 'max) 'nowrap) w3-display-whitespace-stack)
836 (while tree 962 (while tree
1040 (setq extra (1- extra) 1166 (setq extra (1- extra)
1041 col (1+ col))) 1167 col (1+ col)))
1042 ))) 1168 )))
1043 (list rows cols ret-vector)))) 1169 (list rows cols ret-vector))))
1044 1170
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) 1171 (defun w3-display-table (node)
1147 (let* ((dimensions (w3-display-table-dimensions node)) 1172 (let* ((dimensions (w3-display-table-dimensions node))
1148 (num-cols (max (cadr dimensions) 1)) 1173 (num-cols (max (cadr dimensions) 1))
1149 (num-rows (max (car dimensions) 1)) 1174 (num-rows (max (car dimensions) 1))
1150 (column-dimensions (caddr dimensions)) 1175 (column-dimensions (caddr dimensions))
1347 1372
1348 (setq rflag (= (aref prev-rowspans i) 0)) 1373 (setq rflag (= (aref prev-rowspans i) 0))
1349 (setq bflag (/= (aref table-colspans i) 0)) 1374 (setq bflag (/= (aref table-colspans i) 0))
1350 (setq tflag (/= (aref prev-colspans i) 0)) 1375 (setq tflag (/= (aref prev-colspans i) 0))
1351 1376
1352 (insert (w3-table-lookup-char lflag tflag rflag bflag)) 1377 (w3-insert-terminal-char (w3-table-lookup-char lflag tflag rflag bflag))
1353 (setq lflag t) 1378 (setq lflag t)
1354 (cond ((= (aref prev-rowspans i) 0) 1379 (cond ((= (aref prev-rowspans i) 0)
1355 (insert-char (w3-table-lookup-char t nil t nil) 1380 (w3-insert-terminal-char
1356 (aref column-dimensions i)) 1381 (w3-table-lookup-char t nil t nil)
1382 (aref column-dimensions i))
1357 (setq i (1+ i))) 1383 (setq i (1+ i)))
1358 ((car (aref formatted-cols i)) 1384 ((car (aref formatted-cols i))
1359 (insert (pop (aref formatted-cols i))) 1385 (insert (pop (aref formatted-cols i)))
1360 (setq lflag nil) 1386 (setq lflag nil)
1361 (setq i (+ i (max (aref table-colspans i) 1387 (setq i (+ i (max (aref table-colspans i)
1363 (t 1389 (t
1364 (insert-char ? (aref table-colwidth i)) 1390 (insert-char ? (aref table-colwidth i))
1365 (setq lflag nil) 1391 (setq lflag nil)
1366 (setq i (+ i (max (aref table-colspans i) 1392 (setq i (+ i (max (aref table-colspans i)
1367 (aref prev-colspans i) 1)))))) 1393 (aref prev-colspans i) 1))))))
1368 (insert (w3-table-lookup-char lflag (/= row 1) nil t) "\n")) 1394 (w3-insert-terminal-char (w3-table-lookup-char lflag (/= row 1) nil t))
1369 1395 (insert "\n"))
1396
1370 ;; recalculate height (in case we've shortened a rowspanning cell 1397 ;; recalculate height (in case we've shortened a rowspanning cell
1371 (setq height 0 1398 (setq height 0
1372 i 0) 1399 i 0)
1373 (while (< i num-cols) 1400 (while (< i num-cols)
1374 (if (= 1 (aref table-rowspans i)) 1401 (if (= 1 (aref table-rowspans i))
1375 (setq height (max height (length (aref formatted-cols i))))) 1402 (setq height (max height (length (aref formatted-cols i)))))
1376 (setq i (+ i (max 1 (aref table-colspans i))))) 1403 (setq i (+ i (max 1 (aref table-colspans i)))))
1377 1404
1378 ;; Insert a row back in original buffer 1405 ;; Insert a row back in original buffer
1379 (while (> height 0) 1406 (while (> height 0)
1380 (insert fill-prefix (w3-table-lookup-char nil t nil t)) 1407 (insert fill-prefix)
1408 (w3-insert-terminal-char (w3-table-lookup-char nil t nil t))
1381 (setq i 0) 1409 (setq i 0)
1382 (while (< i num-cols) 1410 (while (< i num-cols)
1383 (if (car (aref formatted-cols i)) 1411 (if (car (aref formatted-cols i))
1384 (insert (pop (aref formatted-cols i))) 1412 (insert (pop (aref formatted-cols i)))
1385 (insert-char ? (aref table-colwidth i))) 1413 (insert-char ? (aref table-colwidth i)))
1386 (insert (w3-table-lookup-char nil t nil t)) 1414 (w3-insert-terminal-char (w3-table-lookup-char nil t nil t))
1387 (setq i (+ i (max (aref table-colspans i) 1)))) 1415 (setq i (+ i (max (aref table-colspans i) 1))))
1388 (insert "\n") 1416 (insert "\n")
1389 ;;(and w3-do-incremental-display (w3-pause)) 1417 ;;(and w3-do-incremental-display (w3-pause))
1390 (setq height (1- height))) 1418 (setq height (1- height)))
1391 1419
1416 (insert fill-prefix) 1444 (insert fill-prefix)
1417 (setq i 0) 1445 (setq i 0)
1418 (let (tflag lflag) 1446 (let (tflag lflag)
1419 (while (< i num-cols) 1447 (while (< i num-cols)
1420 (setq tflag (/= (aref prev-colspans i) 0)) 1448 (setq tflag (/= (aref prev-colspans i) 0))
1421 (insert (w3-table-lookup-char lflag tflag t nil)) 1449 (w3-insert-terminal-char (w3-table-lookup-char lflag tflag t nil))
1422 (setq lflag t) 1450 (setq lflag t)
1423 (insert-char (w3-table-lookup-char t nil t nil) 1451 (w3-insert-terminal-char
1424 (aref column-dimensions i)) 1452 (w3-table-lookup-char t nil t nil)
1453 (aref column-dimensions i))
1425 (setq i (1+ i))) 1454 (setq i (1+ i)))
1426 (insert (w3-table-lookup-char t t nil nil) "\n"))) 1455 (w3-insert-terminal-char
1456 (w3-table-lookup-char t t nil nil))
1457 (insert "\n")))
1427 ) 1458 )
1428 (pop w3-display-open-element-stack))))) 1459 (pop w3-display-open-element-stack)))))
1429 1460
1430 1461
1431 1462
1706 ) 1737 )
1707 (hr ; Cause line break & insert rule 1738 (hr ; Cause line break & insert rule
1708 (let* ((perc (or (w3-get-attribute 'width) 1739 (let* ((perc (or (w3-get-attribute 'width)
1709 (w3-get-style-info 'width node) 1740 (w3-get-style-info 'width node)
1710 "100%")) 1741 "100%"))
1711 (rule nil)
1712 (width nil)) 1742 (width nil))
1713 (setq perc (/ (min (string-to-int perc) 100) 100.0) 1743 (setq perc (/ (min (string-to-int perc) 100) 100.0)
1714 width (* fill-column perc) 1744 width (truncate (* fill-column perc)))
1715 rule (make-string (max (truncate width) 0) 1745 (w3-insert-terminal-char (w3-horizontal-rule-char) width)
1716 w3-horizontal-rule-char) 1746 (w3-handle-empty-tag)))
1717 node (list 'hr nil (list rule)))
1718 (w3-handle-content node)))
1719 (map ; Client side imagemaps 1747 (map ; Client side imagemaps
1720 (let ((name (or (w3-get-attribute 'name) 1748 (let ((name (or (w3-get-attribute 'name)
1721 (w3-get-attribute 'id) 1749 (w3-get-attribute 'id)
1722 "unnamed")) 1750 "unnamed"))
1723 (areas 1751 (areas
1793 (list (cons 'type "text") 1821 (list (cons 'type "text")
1794 (cons 'name "isindex")))))))) 1822 (cons 'name "isindex"))))))))
1795 (w3-handle-content node) 1823 (w3-handle-content node)
1796 (setq w3-current-isindex (cons action prompt))) 1824 (setq w3-current-isindex (cons action prompt)))
1797 ) 1825 )
1826 ((html body)
1827 (let ((fore (car (delq nil (copy-list w3-face-color))))
1828 (back (car (delq nil (copy-list w3-face-background-color))))
1829 )
1830 (if (and fore font-running-xemacs)
1831 (font-set-face-foreground 'default fore (current-buffer)))
1832 (if (and back font-running-xemacs)
1833 (font-set-face-background 'default back (current-buffer)))
1834 (w3-handle-content node)))
1798 (*document 1835 (*document
1799 (let ((info (mapcar (lambda (x) (cons x (symbol-value x))) 1836 (let ((info (mapcar (lambda (x) (cons x (symbol-value x)))
1800 w3-persistent-variables))) 1837 w3-persistent-variables)))
1801 (if (not w3-display-same-buffer) 1838 (if (not w3-display-same-buffer)
1802 (set-buffer (generate-new-buffer "Untitled"))) 1839 (set-buffer (generate-new-buffer "Untitled")))
1806 (setcar right-margin-stack 1843 (setcar right-margin-stack
1807 (min (- (or w3-strict-width (window-width)) 1844 (min (- (or w3-strict-width (window-width))
1808 w3-right-margin) 1845 w3-right-margin)
1809 (or w3-maximum-line-length 1846 (or w3-maximum-line-length
1810 (window-width)))) 1847 (window-width))))
1811 (switch-to-buffer (current-buffer)) 1848 (condition-case nil
1849 (switch-to-buffer (current-buffer))
1850 (error (message "W3 buffer %s is being drawn." (buffer-name (current-buffer)))))
1851
1812 (buffer-disable-undo (current-buffer)) 1852 (buffer-disable-undo (current-buffer))
1813 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info) 1853 (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
1814 ;; ACK! We don't like filladapt mode! 1854 ;; ACK! We don't like filladapt mode!
1815 (set (make-local-variable 'filladapt-mode) nil) 1855 (set (make-local-variable 'filladapt-mode) nil)
1816 (set (make-local-variable 'adaptive-fill-mode) nil) 1856 (set (make-local-variable 'adaptive-fill-mode) nil)
1877 (setq w3-display-form-id (cons 1917 (setq w3-display-form-id (cons
1878 (cons 'form-number 1918 (cons 'form-number
1879 w3-current-form-number) 1919 w3-current-form-number)
1880 args)) 1920 args))
1881 (w3-handle-content node))) 1921 (w3-handle-content node)))
1882 ; (keygen 1922 (keygen
1883 ; (w3-form-add-element 'keygen 1923 (w3-form-add-element
1884 ; (or (w3-get-attribute 'name) 1924 (w3-display-normalize-form-info
1885 ; (w3-get-attribute 'id) 1925 (cons '(type . "keygen")
1886 ; "keygen") 1926 args))
1887 ; nil ; value 1927 w3-active-faces)
1888 ; nil ; size 1928 (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 1929 (input
1898 (w3-form-add-element 1930 (w3-form-add-element
1899 (w3-display-normalize-form-info args) 1931 (w3-display-normalize-form-info args)
1900 w3-active-faces) 1932 w3-active-faces)
1901 (w3-handle-empty-tag) 1933 (w3-handle-empty-tag)
1955 ;; widget instead of after. 1987 ;; widget instead of after.
1956 (goto-char (point-max)) 1988 (goto-char (point-max))
1957 (w3-handle-empty-tag)))) 1989 (w3-handle-empty-tag))))
1958 (textarea 1990 (textarea
1959 (let* ((plist (w3-display-normalize-form-info args)) 1991 (let* ((plist (w3-display-normalize-form-info args))
1960 (value (w3-normalize-spaces 1992 (value (apply 'concat (nth 2 node))))
1961 (apply 'concat (nth 2 node)))))
1962 (setq plist (plist-put plist 'type 'multiline) 1993 (setq plist (plist-put plist 'type 'multiline)
1963 plist (plist-put plist 'value value)) 1994 plist (plist-put plist 'value value))
1964 (w3-form-add-element plist w3-active-faces)) 1995 (w3-form-add-element plist w3-active-faces))
1965 (w3-handle-empty-tag) 1996 (w3-handle-empty-tag)
1966 ) 1997 )
2038 (- nd st))) 2069 (- nd st)))
2039 2070
2040 2071
2041 (defun w3-fixup-eol-faces () 2072 (defun w3-fixup-eol-faces ()
2042 ;; Remove 'face property at end of lines - underlining screws up stuff 2073 ;; Remove 'face property at end of lines - underlining screws up stuff
2074 ;; also remove 'mouse-face property at the beginning and end of lines
2043 (let ((inhibit-read-only t)) 2075 (let ((inhibit-read-only t))
2044 (save-excursion 2076 (save-excursion
2045 (goto-char (point-min)) 2077 (goto-char (point-min))
2046 (while (search-forward "\n" nil t) 2078 (while (search-forward "[ \t]*\n[ \t]*" nil t)
2047 (put-text-property (match-beginning 0) (match-end 0) 'face nil))))) 2079 (remove-text-properties (match-beginning 0) (match-end 0)
2080 '(face nil mouse-face nil) nil)))))
2048 2081
2049 (defsubst w3-finish-drawing () 2082 (defsubst w3-finish-drawing ()
2050 (let (url glyph widget) 2083 (let (url glyph widget)
2051 (while w3-image-widgets-waiting 2084 (while w3-image-widgets-waiting
2052 (setq widget (car w3-image-widgets-waiting) 2085 (setq widget (car w3-image-widgets-waiting)
2063 (goto-char (point-min))) 2096 (goto-char (point-min)))
2064 (and (not w3-running-xemacs) 2097 (and (not w3-running-xemacs)
2065 (not (eq (device-type) 'tty)) 2098 (not (eq (device-type) 'tty))
2066 (w3-fixup-eol-faces)) 2099 (w3-fixup-eol-faces))
2067 (let ((inhibit-read-only t)) 2100 (let ((inhibit-read-only t))
2068 (put-text-property (point-min) (point-max) 'read-only nil)) 2101 (remove-text-properties (point-min) (point-max) '(read-only) nil))
2069 (message "Drawing... done")) 2102 (message "Drawing... done"))
2070 2103
2071 (defun w3-region (st nd) 2104 (defun w3-region (st nd)
2072 (if (not w3-setup-done) (w3-do-setup)) 2105 (if (not w3-setup-done) (w3-do-setup))
2073 (let* ((source (buffer-substring st nd)) 2106 (let* ((source (buffer-substring st nd))