Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/hm--html.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents ac2d302a0011
children 4103f0995bd7
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;;; $Id: hm--html.el,v 1.1.1.2 1996/12/18 03:46:47 steve Exp $ 1 ;;; $Id: hm--html.el,v 1.2 1997/02/16 01:29:10 steve Exp $
2 ;;; 2 ;;;
3 ;;; Copyright (C) 1993, 1994, 1995, 1996 Heiko Muenkel 3 ;;; Copyright (C) 1993 - 1997 Heiko Muenkel
4 ;;; email: muenkel@tnt.uni-hannover.de 4 ;;; email: muenkel@tnt.uni-hannover.de
5 ;;; 5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify 6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by 7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 2, or (at your option) 8 ;;; the Free Software Foundation; either version 2, or (at your option)
29 29
30 ;(require 'hm--date) 30 ;(require 'hm--date)
31 ;(require 'adapt) 31 ;(require 'adapt)
32 32
33 33
34 ;;; Indentation 34 (defun hm--html-set-marker-at-position (&optional position)
35 35 "Creates a new marker and set the marker at the POSITION.
36 (defun hm--html-indent-region (begin end) 36 If POSITION is nil, then the marker is set at the current point.
37 "Indents the region between BEGIN and END according to the major mode." 37 The return value is the marker."
38 (when (< end begin) 38 (let ((marker (make-marker)))
39 (let ((a end)) 39 (if position
40 (setq end start) 40 (set-marker marker position)
41 (setq start a))) 41 (set-marker marker (point)))))
42 (save-excursion
43 (goto-char begin)
44 (let ((old-point))
45 (while (and (<= (point) end)
46 (not (eq (point) old-point)))
47 (setq old-point (point))
48 (indent-according-to-mode)
49 (forward-line)
50 ))))
51
52 42
53 ;;; Functions for adding html commands which consists of a start and a 43 ;;; Functions for adding html commands which consists of a start and a
54 ;;; end tag and some text between them. (Basicfunctions) 44 ;;; end tag and some text between them. (Basicfunctions)
55 45
56 (defun hm--html-add-tags (function-insert-start-tag 46 (defun hm--html-add-tags (function-insert-start-tag
66 The first parameter specifies the funtion which insert the start tag 56 The first parameter specifies the funtion which insert the start tag
67 and the third parameter specifies the function which insert the end tag. 57 and the third parameter specifies the function which insert the end tag.
68 The second parameter is the string for the start tag and the fourth parameter 58 The second parameter is the string for the start tag and the fourth parameter
69 is the string for the end tag. The third and fourth parameters are optional. 59 is the string for the end tag. The third and fourth parameters are optional.
70 The fifth parameter is optional. If it exists, it specifies a function which 60 The fifth parameter is optional. If it exists, it specifies a function which
71 inserts the sixth parameter (the middle-start-tag) between the start and the end 61 inserts the sixth parameter (the middle-start-tag) between the start and the
72 tag." 62 end tag."
73 ; (interactive "aFunction, which adds the HTML start tag: \n\
74 ;aFunction, which adds the HTML end tag: \n\
75 ;sThe HTML start tag: \n\
76 ;sThe HTML end tag: ")
77 (eval (list function-insert-start-tag start-tag)) 63 (eval (list function-insert-start-tag start-tag))
78 (if function-insert-middle-start-tag 64 (if function-insert-middle-start-tag
79 (eval (list function-insert-middle-start-tag middle-start-tag))) 65 (eval (list function-insert-middle-start-tag middle-start-tag)))
80 (let ((position (point))) 66 (let ((position (hm--html-set-marker-at-position (point))))
81 (if function-insert-middle-end-tag 67 (if function-insert-middle-end-tag
82 (eval (list function-insert-middle-end-tag middle-end-tag))) 68 (eval (list function-insert-middle-end-tag middle-end-tag)))
83 (if function-insert-end-tag 69 (if function-insert-end-tag
84 (eval (list function-insert-end-tag end-tag))) 70 (eval (list function-insert-end-tag end-tag)))
85 (goto-char position))) 71 (goto-char position)))
87 73
88 (defun hm--html-add-tags-to-region (function-insert-start-tag 74 (defun hm--html-add-tags-to-region (function-insert-start-tag
89 start-tag 75 start-tag
90 function-insert-end-tag 76 function-insert-end-tag
91 end-tag 77 end-tag
92 &optional function-insert-middle-tag 78 &optional
93 &optional middle-tag) 79 function-insert-middle-tag
80 middle-tag)
94 "Adds the start and the end html tag to the active region. 81 "Adds the start and the end html tag to the active region.
95 The first parameter specifies the funtion which insert the start tag 82 The first parameter specifies the funtion which insert the start tag
96 and the third parameter specifies the function which insert the end tag. 83 and the third parameter specifies the function which insert the end tag.
97 The second parameter is the string for the start tag and the fourth parameter 84 The second parameter is the string for the start tag and the fourth parameter
98 is the string for the end tag. 85 is the string for the end tag.
99 The fifth parameter is optional. If it exists, it specifies a function which 86 The fifth parameter is optional. If it exists, it specifies a function which
100 inserts the sixth parameter (the middle-tag) between the start and the end 87 inserts the sixth parameter (the middle-tag) between the start and the end
101 tag." 88 tag."
102 ; (interactive "aFunction, which adds the html start tag: \n\
103 ;aFunction, which adds the html end tag: \n\
104 ;sThe HTML start tag: \n\
105 ;sThe HTML end tag: ")
106 (save-window-excursion 89 (save-window-excursion
107 (let ((start (region-beginning)) 90 (let ((start (hm--html-set-marker-at-position (region-beginning)))
108 (end (region-end))) 91 (end (region-end)))
109 (goto-char end) 92 (goto-char end)
110 (eval (list function-insert-end-tag end-tag)) 93 (eval (list function-insert-end-tag end-tag))
111 (goto-char start) 94 (goto-char start)
95 ; (backward-char (+ (length end-tag) (- end start)))
112 (eval (list function-insert-start-tag start-tag)) 96 (eval (list function-insert-start-tag start-tag))
113 (if function-insert-middle-tag 97 (if function-insert-middle-tag
114 (eval (list function-insert-middle-tag middle-tag))) 98 (eval (list function-insert-middle-tag middle-tag)))
115 ))) 99 )))
116 100
138 The parameter must be a string (i.e. \"<PRE>\")" 122 The parameter must be a string (i.e. \"<PRE>\")"
139 (let ((start (point))) 123 (let ((start (point)))
140 (insert tag) 124 (insert tag)
141 (hm--html-indent-region start (point)) 125 (hm--html-indent-region start (point))
142 ) 126 )
143 ; (html-maybe-deemphasize-region start (- (point) 1)))
144 (insert "\n")) 127 (insert "\n"))
145 128
146 129
147 (defun hm--html-insert-end-tag-with-newline (tag) 130 (defun hm--html-insert-end-tag-with-newline (tag)
148 "Inserts the HTML end tag 'tag' with a Newline. 131 "Inserts the HTML end tag 'tag' with a Newline.
149 The parameter must be a string (i.e. \"</PRE>\")" 132 The parameter must be a string (i.e. \"</PRE>\")"
150 (insert "\n") 133 (insert "\n")
151 (let ((start (point))) 134 (let ((start (point)))
152 (insert tag) 135 (insert tag)
153 (hm--html-indent-region start (point)))) 136 (hm--html-indent-region start (point))))
154 ; (html-maybe-deemphasize-region start (- (point) 1))))
155 137
156 138
157 139
158 ;;; Functions which add simple tags of the form <tag> 140 ;;; Functions which add simple tags of the form <tag>
159 141
1175 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1157 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1176 "<OL>" 1158 "<OL>"
1177 'hm--html-insert-end-tag-with-newline 1159 'hm--html-insert-end-tag-with-newline
1178 "</OL>" 1160 "</OL>"
1179 'hm--html-insert-start-tag 1161 'hm--html-insert-start-tag
1180 "<LI> ")) 1162 "<LI> "
1163 'hm--html-insert-end-tag
1164 " </LI>"))
1181 1165
1182 (defun hm--html-add-numberlist-to-region () 1166 (defun hm--html-add-numberlist-to-region ()
1183 "Adds the HTML tags for a numbered list to the region." 1167 "Adds the HTML tags for a numbered list to the region."
1184 (interactive) 1168 (interactive)
1185 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1169 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1186 "<OL>" 1170 "<OL>"
1187 'hm--html-insert-end-tag-with-newline 1171 'hm--html-insert-end-tag-with-newline
1188 "</OL>" 1172 "</OL>"))
1189 'hm--html-insert-start-tag 1173 ; 'hm--html-insert-start-tag
1190 "<LI> ")) 1174 ; "<LI> "))
1191 1175
1192 1176
1193 (defun hm--html-add-directory-list () 1177 (defun hm--html-add-directory-list ()
1194 "Adds the HTML tags for a directory list at the point in the current buffer." 1178 "Adds the HTML tags for a directory list at the point in the current buffer."
1195 (interactive) 1179 (interactive)
1196 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1180 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1197 "<DIR>" 1181 "<DIR>"
1198 'hm--html-insert-end-tag-with-newline 1182 'hm--html-insert-end-tag-with-newline
1199 "</DIR>" 1183 "</DIR>"
1200 'hm--html-insert-start-tag 1184 'hm--html-insert-start-tag
1201 "<LI> ")) 1185 "<LI> "
1186 'hm--html-insert-end-tag
1187 " </LI>"))
1202 1188
1203 (defun hm--html-add-directorylist-to-region () 1189 (defun hm--html-add-directorylist-to-region ()
1204 "Adds the HTML tags for a directory list to the region." 1190 "Adds the HTML tags for a directory list to the region."
1205 (interactive) 1191 (interactive)
1206 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1192 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1207 "<DIR>" 1193 "<DIR>"
1208 'hm--html-insert-end-tag-with-newline 1194 'hm--html-insert-end-tag-with-newline
1209 "</DIR>" 1195 "</DIR>"))
1210 'hm--html-insert-start-tag 1196 ; 'hm--html-insert-start-tag
1211 "<LI> ")) 1197 ; "<LI> "))
1212 1198
1213 1199
1214 (defun hm--html-add-list () 1200 (defun hm--html-add-list ()
1215 "Adds the HTML tags for a (unnumbered) list to the region." 1201 "Adds the HTML tags for a (unnumbered) list to the region."
1216 (interactive) 1202 (interactive)
1217 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1203 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1218 "<UL>" 1204 "<UL>"
1219 'hm--html-insert-end-tag-with-newline 1205 'hm--html-insert-end-tag-with-newline
1220 "</UL>" 1206 "</UL>"
1221 'hm--html-insert-start-tag 1207 'hm--html-insert-start-tag
1222 "<LI> ")) 1208 "<LI> "
1209 'hm--html-insert-end-tag
1210 " </LI>"))
1223 1211
1224 1212
1225 (defun hm--html-add-list-to-region () 1213 (defun hm--html-add-list-to-region ()
1226 "Adds the HTML tags for a (unnumbered) list to the region." 1214 "Adds the HTML tags for a (unnumbered) list to the region."
1227 (interactive) 1215 (interactive)
1228 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1216 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1229 "<UL>" 1217 "<UL>"
1230 'hm--html-insert-end-tag-with-newline 1218 'hm--html-insert-end-tag-with-newline
1231 "</UL>" 1219 "</UL>"))
1232 'hm--html-insert-start-tag 1220 ; 'hm--html-insert-start-tag
1233 "<LI> ")) 1221 ; "<LI> "))
1234 1222
1235 1223
1236 (defun hm--html-add-menu () 1224 ;(defun hm--html-add-menu ()
1237 "Adds the HTML tags for a menu." 1225 ; "Adds the HTML tags for a menu."
1238 (interactive) 1226 ; (interactive)
1239 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1227 ; (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1240 "<MENU>" 1228 ; "<MENU>"
1241 'hm--html-insert-end-tag-with-newline 1229 ; 'hm--html-insert-end-tag-with-newline
1242 "</MENU>" 1230 ; "</MENU>"
1243 'hm--html-insert-start-tag 1231 ; 'hm--html-insert-start-tag
1244 "<LI> ")) 1232 ; "<LI> "))
1245 1233
1246 1234
1247 (defun hm--html-add-menu () 1235 (defun hm--html-add-menu ()
1248 "Adds the HTML tags for a menu." 1236 "Adds the HTML tags for a menu."
1249 (interactive) 1237 (interactive)
1272 (defun hm--html-add-description-title-and-entry () 1260 (defun hm--html-add-description-title-and-entry ()
1273 "Adds a definition title and entry. 1261 "Adds a definition title and entry.
1274 Assumes we're at the end of a previous entry." 1262 Assumes we're at the end of a previous entry."
1275 (interactive) 1263 (interactive)
1276 (hm--html-add-description-title) 1264 (hm--html-add-description-title)
1277 (let ((position (point))) 1265 (let ((position (point))
1278 (search-forward "</DT>") 1266 (case-fold-search t))
1279 (hm--html-add-only-description-entry) 1267 (search-forward "</dt>")
1268 (hm--html-add-description-entry)
1280 (goto-char position))) 1269 (goto-char position)))
1281 1270
1282 1271
1283 (defun hm--html-add-description-list () 1272 (defun hm--html-add-description-list ()
1284 "Adds the HTML tags for a description list. 1273 "Adds the HTML tags for a description list.
1376 1365
1377 (defun hm--html-delete-old-signature () 1366 (defun hm--html-delete-old-signature ()
1378 "Searches for the old signature and deletes it, if the user want it" 1367 "Searches for the old signature and deletes it, if the user want it"
1379 (save-excursion 1368 (save-excursion
1380 (goto-char (point-min)) 1369 (goto-char (point-min))
1381 (if (search-forward (concat "<address> " 1370 (let ((case-fold-search t))
1382 "<a name=" 1371 (if (search-forward (concat "<address> "
1383 hm--html-signature-reference-name 1372 "<a name="
1384 " href=\"") 1373 hm--html-signature-reference-name
1385 nil 1374 " href=\"")
1386 t) 1375 nil
1387 (let ((signature-start (match-beginning 0)) 1376 t)
1388 (signature-end (progn 1377 (let ((signature-start (match-beginning 0))
1389 (search-forward "</address>" nil t) 1378 (signature-end (progn
1390 (point)))) 1379 (search-forward "</address>" nil t)
1391 (if (yes-or-no-p "Delete the old signature (yes or no) ?") 1380 (point))))
1392 (delete-region signature-start signature-end)))))) 1381 (if (yes-or-no-p "Delete the old signature (yes or no) ?")
1382 (delete-region signature-start signature-end)))))))
1393 1383
1394 1384
1395 (defun hm--html-set-point-for-signature () 1385 (defun hm--html-set-point-for-signature ()
1396 "Searches and sets the point for inserting the signature. 1386 "Searches and sets the point for inserting the signature.
1397 It searches from the end to the beginning of the file. At first it 1387 It searches from the end to the beginning of the file. At first it
1398 tries to use the point before the </body> tag then the point before 1388 tries to use the point before the </body> tag then the point before
1399 the </html> tag and the the end of the file." 1389 the </html> tag and the the end of the file."
1400 (goto-char (point-max)) 1390 (goto-char (point-max))
1401 (cond ((search-backward "</body>" nil t) 1391 (let ((case-fold-search t))
1402 (end-of-line 0) 1392 (cond ((search-backward "</body>" nil t)
1403 (if (> (current-column) 0) 1393 (end-of-line 0)
1404 (newline 2))) 1394 (if (> (current-column) 0)
1405 ((search-backward "</html>" nil t) 1395 (newline 2)))
1406 (end-of-line 0) 1396 ((search-backward "</html>" nil t)
1407 (if (> (current-column) 0) 1397 (end-of-line 0)
1408 (newline 2))) 1398 (if (> (current-column) 0)
1409 ((> (current-column) 0) 1399 (newline 2)))
1410 (newline 2)) 1400 ((> (current-column) 0)
1411 (t))) 1401 (newline 2))
1402 (t))))
1412 1403
1413 1404
1414 (defun hm--html-add-signature () 1405 (defun hm--html-add-signature ()
1415 "Adds the owner's signature at the end of the buffer." 1406 "Adds the owner's signature at the end of the buffer."
1416 (interactive) 1407 (interactive)
1465 position after the tag. If not, the function next searches for the 1456 position after the tag. If not, the function next searches for the
1466 tag <HEAD> and sets the point after the tag, if it exists, or searches for 1457 tag <HEAD> and sets the point after the tag, if it exists, or searches for
1467 the tag <HTML>. If this tag exists, the point is set to the position after 1458 the tag <HTML>. If this tag exists, the point is set to the position after
1468 this tag or the beginning of the file otherwise." 1459 this tag or the beginning of the file otherwise."
1469 (goto-char (point-min)) 1460 (goto-char (point-min))
1470 (cond ((search-forward-regexp "<isindex>" nil t) (newline)) 1461 (let ((case-fold-search t))
1471 ((search-forward-regexp "<head>" nil t) (newline)) 1462 (cond ((search-forward-regexp "<isindex>" nil t) (newline))
1472 ((search-forward-regexp "<html>" nil t) (newline)) 1463 ((search-forward-regexp "<head>" nil t) (newline))
1473 (t))) 1464 ((search-forward-regexp "<html>" nil t) (newline))
1465 (t))))
1474 1466
1475 1467
1476 (defun hm--html-add-title (title) 1468 (defun hm--html-add-title (title)
1477 "Adds the HTML tags for a title at the beginning of the buffer." 1469 "Adds the HTML tags for a title at the beginning of the buffer."
1478 (interactive "sTitle: ") 1470 (interactive "sTitle: ")
1479 (save-excursion 1471 (save-excursion
1480 (goto-char (point-min)) 1472 (goto-char (point-min))
1481 (if (search-forward "<title>" nil t) 1473 (let ((case-fold-search t))
1482 (let ((point-after-start-tag (point))) 1474 (if (search-forward "<title>" nil t)
1483 (if (not (search-forward "</title>" nil t)) 1475 (let ((point-after-start-tag (point)))
1484 nil 1476 (if (not (search-forward "</title>" nil t))
1485 (goto-char (- (point) 8)) 1477 nil
1486 (delete-backward-char (- (point) point-after-start-tag)) 1478 (goto-char (- (point) 8))
1487 (let ((start (point))) 1479 (delete-backward-char (- (point) point-after-start-tag))
1488 (insert title " (" (hm--date) ")") 1480 (let ((start (point)))
1489 (goto-char start)))) 1481 (insert title " (" (hm--date) ")")
1490 ;; Noch kein <TITLE> im Buffer vorhanden 1482 (goto-char start))))
1491 (hm--html-set-point-for-title) 1483 ;; Noch kein <TITLE> im Buffer vorhanden
1492 (hm--html-add-tags 'hm--html-insert-start-tag 1484 (hm--html-set-point-for-title)
1493 "<TITLE>" 1485 (hm--html-add-tags 'hm--html-insert-start-tag
1494 'hm--html-insert-end-tag 1486 "<TITLE>"
1495 "</TITLE>" 1487 'hm--html-insert-end-tag
1496 'insert 1488 "</TITLE>"
1497 (concat title " (" (hm--date) ")")) 1489 'insert
1498 (forward-char 8) 1490 (concat title " (" (hm--date) ")"))
1499 (newline 1) 1491 (forward-char 8)
1500 ))) 1492 (newline 1)
1493 ))))
1501 1494
1502 1495
1503 (defun hm--html-add-title-to-region () 1496 (defun hm--html-add-title-to-region ()
1504 "Adds the HTML tags for a title to the region." 1497 "Adds the HTML tags for a title to the region."
1505 (interactive) 1498 (interactive)
1506 (let ((title (buffer-substring (region-beginning) (region-end)))) 1499 (let ((title (buffer-substring (region-beginning) (region-end)))
1500 (case-fold-search t))
1507 (save-excursion 1501 (save-excursion
1508 (goto-char (point-min)) 1502 (goto-char (point-min))
1509 (if (search-forward "<title>" nil t) 1503 (if (search-forward "<title>" nil t)
1510 (let ((point-after-start-tag (point))) 1504 (let ((point-after-start-tag (point)))
1511 (if (not (search-forward "</title>" nil t)) 1505 (if (not (search-forward "</title>" nil t))
1529 (defun hm--html-add-html () 1523 (defun hm--html-add-html ()
1530 "Adds the HTML tags <HTML> and </HTML> in the buffer. 1524 "Adds the HTML tags <HTML> and </HTML> in the buffer.
1531 The tag <HTML> will be inserted at the beginning and </HTML> at the 1525 The tag <HTML> will be inserted at the beginning and </HTML> at the
1532 end of the file." 1526 end of the file."
1533 (interactive) 1527 (interactive)
1534 (let ((new-cursor-position nil)) 1528 (let ((new-cursor-position nil)
1529 (case-fold-search t))
1535 (save-excursion 1530 (save-excursion
1536 (goto-char (point-min)) 1531 (goto-char (point-min))
1537 (if (search-forward "<html>" nil t) 1532 (if (search-forward "<html>" nil t)
1538 (error "There is an old tag <HTML> in the current buffer !") 1533 (error "There is an old tag <HTML> in the current buffer !")
1539 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<HTML>") 1534 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<HTML>")
1551 (defun hm--html-add-head () 1546 (defun hm--html-add-head ()
1552 "Adds the HTML tags <HEAD> and </HEAD> in the buffer. 1547 "Adds the HTML tags <HEAD> and </HEAD> in the buffer.
1553 The tags will be inserted after <HTML> or at the beginning of the file. 1548 The tags will be inserted after <HTML> or at the beginning of the file.
1554 The function also looks for the tags <BODY> and </TITLE>." 1549 The function also looks for the tags <BODY> and </TITLE>."
1555 (interactive) 1550 (interactive)
1551 (let ((case-fold-search t))
1556 (goto-char (point-min)) 1552 (goto-char (point-min))
1557 (if (search-forward "<html>" nil t) 1553 (if (search-forward "<html>" nil t)
1558 (if (search-forward "<head>" nil t) 1554 (if (search-forward "<head>" nil t)
1559 (error "There is an old tag <HEAD> in the current buffer !") 1555 (error "There is an old tag <HEAD> in the current buffer !")
1560 (if (search-forward "</head>" nil t) 1556 (if (search-forward "</head>" nil t)
1584 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1580 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1585 "<HEAD>")) 1581 "<HEAD>"))
1586 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1582 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1587 "<HEAD>" 1583 "<HEAD>"
1588 'hm--html-insert-end-tag-with-newline 1584 'hm--html-insert-end-tag-with-newline
1589 "</HEAD>"))))) 1585 "</HEAD>"))))))
1590 1586
1591 1587
1592 (defun hm--html-add-head-to-region () 1588 (defun hm--html-add-head-to-region ()
1593 "Adds the HTML tags <HEAD> and </HEAD> to the region." 1589 "Adds the HTML tags <HEAD> and </HEAD> to the region."
1594 (interactive) 1590 (interactive)
1600 1596
1601 (defun hm--html-add-body () 1597 (defun hm--html-add-body ()
1602 "Adds the HTML tags <BODY> and </BODY> in the buffer. 1598 "Adds the HTML tags <BODY> and </BODY> in the buffer.
1603 The tags will be inserted before </HTML> or at the end of the file." 1599 The tags will be inserted before </HTML> or at the end of the file."
1604 (interactive) 1600 (interactive)
1601 (let ((case-fold-search t))
1605 (goto-char (point-max)) 1602 (goto-char (point-max))
1606 (if (search-backward "</html>" nil t) 1603 (if (search-backward "</html>" nil t)
1607 (progn 1604 (progn
1608 (if (search-backward "</body>" nil t) 1605 (if (search-backward "</body>" nil t)
1609 (error "There is an old tag </BODY> in the current buffer !") 1606 (error "There is an old tag </BODY> in the current buffer !")
1624 (goto-char cursor-position) 1621 (goto-char cursor-position)
1625 )) 1622 ))
1626 (if (not (= (current-column) 0)) 1623 (if (not (= (current-column) 0))
1627 (newline)) 1624 (newline))
1628 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<BODY>" 1625 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<BODY>"
1629 'hm--html-insert-end-tag-with-newline "</BODY>")))) 1626 'hm--html-insert-end-tag-with-newline "</BODY>")))))
1630 1627
1631 1628
1632 (defun hm--html-add-body-to-region () 1629 (defun hm--html-add-body-to-region ()
1633 "Adds the HTML tags <BODY> and </BODY> to the region." 1630 "Adds the HTML tags <BODY> and </BODY> to the region."
1634 (interactive) 1631 (interactive)
1642 "Adds the HTML tags for a title and a header in the current buffer." 1639 "Adds the HTML tags for a title and a header in the current buffer."
1643 ; (interactive "sTitle and Header String: \nnHeader Size (1 .. 6): ") 1640 ; (interactive "sTitle and Header String: \nnHeader Size (1 .. 6): ")
1644 ; (if (> size 6) 1641 ; (if (> size 6)
1645 ; (message "The size must be a number from 1 to 6 !") 1642 ; (message "The size must be a number from 1 to 6 !")
1646 (interactive "sTitle and Header String: ") 1643 (interactive "sTitle and Header String: ")
1647 (hm--html-add-title title) 1644 (let ((case-fold-search t))
1648 (save-excursion 1645 (hm--html-add-title title)
1649 (goto-char (point-min)) 1646 (save-excursion
1650 (search-forward "</title>" nil t) 1647 (goto-char (point-min))
1651 (if (search-forward "</head>" nil t) 1648 (search-forward "</title>" nil t)
1652 (progn 1649 (if (search-forward "</head>" nil t)
1653 (search-forward "<body>" nil t) 1650 (progn
1654 (newline 1)) 1651 (search-forward "<body>" nil t)
1655 (if (search-forward "<body>" nil t) 1652 (newline 1))
1656 (newline 1) 1653 (if (search-forward "<body>" nil t)
1657 (if (string= (what-line) "Line 1") 1654 (newline 1)
1658 (progn 1655 (if (string= (what-line) "Line 1")
1659 (end-of-line) 1656 (progn
1660 (newline 1))))) 1657 (end-of-line)
1661 (hm--html-add-header 1 title))) 1658 (newline 1)))))
1659 (hm--html-add-header 1 title))))
1662 1660
1663 1661
1664 (defun hm--html-add-title-and-header-to-region () 1662 (defun hm--html-add-title-and-header-to-region ()
1665 "Adds the HTML tags for a title and a header to the region." 1663 "Adds the HTML tags for a title and a header to the region."
1666 ;The parameter 'size' spezifies the size of the header.";" 1664 ;The parameter 'size' spezifies the size of the header.";"
1677 "Adds a full HTML frame to the current buffer. 1675 "Adds a full HTML frame to the current buffer.
1678 The frame consists of the elements html, head, body, title, 1676 The frame consists of the elements html, head, body, title,
1679 header and the signature. The parameter TITLE specifies the 1677 header and the signature. The parameter TITLE specifies the
1680 title and the header of the document." 1678 title and the header of the document."
1681 (interactive "sTitle and Header String: ") 1679 (interactive "sTitle and Header String: ")
1682 (hm--html-add-html) 1680 (let ((case-fold-search t))
1683 (hm--html-add-head) 1681 (hm--html-add-html)
1684 (hm--html-add-body) 1682 (hm--html-add-head)
1685 (hm--html-add-title-and-header title) 1683 (hm--html-add-body)
1686 (if hm--html-signature-file 1684 (hm--html-add-title-and-header title)
1687 (hm--html-add-signature)) 1685 (if hm--html-signature-file
1688 (goto-char (point-min)) 1686 (hm--html-add-signature))
1689 (search-forward "</h1>" nil t) 1687 (goto-char (point-min))
1690 (forward-line 1) 1688 (search-forward "</h1>" nil t)
1691 (if hm--html-automatic-created-comment 1689 (forward-line 1)
1692 (hm--html-insert-created-comment))) 1690 (if hm--html-automatic-created-comment
1691 (hm--html-insert-created-comment))))
1693 1692
1694 1693
1695 (defun hm--html-add-full-html-frame-with-region () 1694 (defun hm--html-add-full-html-frame-with-region ()
1696 "Adds a full HTML frame to the current buffer with the use of a region. 1695 "Adds a full HTML frame to the current buffer with the use of a region.
1697 The frame consists of the elements html, head, body, title, 1696 The frame consists of the elements html, head, body, title,
1732 ;;; Functions which add links 1731 ;;; Functions which add links
1733 1732
1734 (defun hm--html-mark-example (parameter-list) 1733 (defun hm--html-mark-example (parameter-list)
1735 "Marks the example of the parameterlist in the current buffer. 1734 "Marks the example of the parameterlist in the current buffer.
1736 It returns the example extent." 1735 It returns the example extent."
1737 (if (hm--html-get-example-from-parameter-list parameter-list) 1736 (let ((case-fold-search t))
1738 (progn 1737 (if (hm--html-get-example-from-parameter-list parameter-list)
1739 (search-forward (hm--html-get-example-from-parameter-list 1738 (progn
1740 parameter-list)) 1739 (search-forward (hm--html-get-example-from-parameter-list
1741 (let ((extent (make-extent (match-beginning 0) 1740 parameter-list))
1742 (match-end 0)))) 1741 (let ((extent (make-extent (match-beginning 0)
1743 (set-extent-face extent 'hm--html-help-face) 1742 (match-end 0))))
1744 extent)))) 1743 (set-extent-face extent 'hm--html-help-face)
1744 extent)))))
1745 1745
1746 1746
1747 (defun hm--html-unmark-example (extent) 1747 (defun hm--html-unmark-example (extent)
1748 "Unmarks the example for the current question." 1748 "Unmarks the example for the current question."
1749 (if extent 1749 (if extent
2418 "Makes a proggate-alist from the PROGGATE-ALLOWED-FILE." 2418 "Makes a proggate-alist from the PROGGATE-ALLOWED-FILE."
2419 (if (and (stringp proggate-allowed-file) 2419 (if (and (stringp proggate-allowed-file)
2420 (file-exists-p proggate-allowed-file)) 2420 (file-exists-p proggate-allowed-file))
2421 (save-window-excursion 2421 (save-window-excursion
2422 (let ((alist nil) 2422 (let ((alist nil)
2423 (buffername (find-file-noselect proggate-allowed-file))) 2423 (buffername (find-file-noselect proggate-allowed-file))
2424 (case-fold-search t))
2424 (set-buffer buffername) 2425 (set-buffer buffername)
2425 (toggle-read-only) 2426 (toggle-read-only)
2426 (goto-char (point-min)) 2427 (goto-char (point-min))
2427 (while (search-forward-regexp "[^ \t\n]+" nil t) 2428 (while (search-forward-regexp "[^ \t\n]+" nil t)
2428 (setq alist (append (list (list (buffer-substring 2429 (setq alist (append (list (list (buffer-substring
2573 (setq hm--html-newsgroup-alist gnus-newsrc-assoc)) 2574 (setq hm--html-newsgroup-alist gnus-newsrc-assoc))
2574 (if (not (file-exists-p newsrc-file)) 2575 (if (not (file-exists-p newsrc-file))
2575 '(("")) 2576 '((""))
2576 (save-window-excursion 2577 (save-window-excursion
2577 (let ((alist nil) 2578 (let ((alist nil)
2578 (buffername (find-file-noselect newsrc-file))) 2579 (buffername (find-file-noselect newsrc-file))
2580 (case-fold-search t))
2579 (set-buffer buffername) 2581 (set-buffer buffername)
2580 (toggle-read-only) 2582 (toggle-read-only)
2581 (goto-char (point-min)) 2583 (goto-char (point-min))
2582 (while (search-forward-regexp "[^:!]+" nil t) 2584 (while (search-forward-regexp "[^:!]+" nil t)
2583 (setq alist (append (list (list (buffer-substring 2585 (setq alist (append (list (list (buffer-substring
2728 (interactive) 2730 (interactive)
2729 (hm--html-add-mailto-link-1 'hm--html-add-tags-to-region)) 2731 (hm--html-add-mailto-link-1 'hm--html-add-tags-to-region))
2730 2732
2731 (defun hm--html-add-relative-link (relative-file-path) 2733 (defun hm--html-add-relative-link (relative-file-path)
2732 "Adds the HTML tags for a relative link at the current point." 2734 "Adds the HTML tags for a relative link at the current point."
2733 (interactive (list (read-file-name "Relative Filename: " 2735 (interactive (list (file-relative-name
2734 nil 2736 (read-file-name "Relative Filename: "
2735 nil 2737 nil
2736 nil 2738 nil
2737 ""))) 2739 nil
2740 "")
2741 default-directory)
2742 ))
2738 (hm--html-add-tags 'hm--html-insert-start-tag 2743 (hm--html-add-tags 'hm--html-insert-start-tag
2739 (concat "<A HREF=\"" 2744 (concat "<A HREF=\""
2740 relative-file-path 2745 relative-file-path
2741 "\">") 2746 "\">")
2742 'hm--html-insert-end-tag 2747 'hm--html-insert-end-tag
2743 "</A>")) 2748 "</A>"))
2744 2749
2745 (defun hm--html-add-relative-link-to-region (relative-file-path) 2750 (defun hm--html-add-relative-link-to-region (relative-file-path)
2746 "Adds the HTML tags for a relative link to the region." 2751 "Adds the HTML tags for a relative link to the region."
2747 (interactive (list (read-file-name "Relative Filename: " 2752 (interactive (list (file-relative-name
2748 nil 2753 (read-file-name "Relative Filename: "
2749 nil 2754 nil
2750 nil 2755 nil
2751 ""))) 2756 nil
2757 ""))))
2752 (hm--html-add-tags-to-region 'hm--html-insert-start-tag 2758 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
2753 (concat "<A HREF=\"" 2759 (concat "<A HREF=\""
2754 relative-file-path 2760 relative-file-path
2755 "\">") 2761 "\">")
2756 'hm--html-insert-end-tag 2762 'hm--html-insert-end-tag
2938 2944
2939 2945
2940 ;;; Functions to insert templates 2946 ;;; Functions to insert templates
2941 2947
2942 (defvar hm--html-template-file-history nil 2948 (defvar hm--html-template-file-history nil
2943 "Historvariable for the template files.") 2949 "Historyvariable for the template files in the `hm--html-mode'.")
2944 2950
2945 (defun hm--html-insert-template (filename) 2951 (defun hm--html-insert-template (filename)
2946 "Inserts a templatefile." 2952 "Inserts a templatefile.
2947 (interactive (list 2953 It uses `tmpl-insert-template-file' to insert
2948 (let ((file-name-history hm--html-template-file-history)) 2954 the templates. The variables `tmpl-template-dir-list',
2949 (read-file-name "Templatefile: " 2955 `tmpl-automatic-expand' and `tmpl-history-variable-name' are
2950 hm--html-template-dir 2956 overwritten by `hm--html-template-dir',
2951 nil 2957 `hm--html-automatic-expand-templates' and `hm--html-template-file-history'."
2952 t 2958 (interactive (list nil))
2953 nil)))) 2959 (let ((tmpl-template-dir-list (if (listp hm--html-template-dir)
2954 ; 'hm--html-template-file-history))) 2960 hm--html-template-dir
2955 (insert-file (expand-file-name filename)) 2961 (list hm--html-template-dir)))
2956 (if hm--html-automatic-expand-templates 2962 (tmpl-automatic-expand hm--html-automatic-expand-templates)
2957 (tmpl-expand-templates-in-buffer)) 2963 (tmpl-history-variable-name 'hm--html-template-file-history))
2958 (if hm--html-automatic-created-comment 2964 (if filename
2959 (hm--html-insert-created-comment t))) 2965 (tmpl-insert-template-file filename)
2966 (call-interactively 'tmpl-insert-template-file))
2967 ; (if hm--html-automatic-created-comment ; better in the template files
2968 ; (hm--html-insert-created-comment t)
2969 ))
2970
2971 (defun hm--html-insert-template-from-fixed-dirs (filename)
2972 "Inserts a templatefile.
2973 It uses `tmpl-insert-template-file-from-fixed-dirs' to insert
2974 the templates. The variables `tmpl-template-dir-list',
2975 `tmpl-automatic-expand', `tmpl-filter-regexp' and
2976 `tmpl-history-variable-name' are overwritten by
2977 `hm--html-template-dir', `hm--html-automatic-expand-templates',
2978 `hm--html-template-filter-regexp' and `hm--html-template-file-history'."
2979 (interactive (list nil))
2980 (let ((tmpl-template-dir-list (if (listp hm--html-template-dir)
2981 hm--html-template-dir
2982 (list hm--html-template-dir)))
2983 (tmpl-automatic-expand hm--html-automatic-expand-templates)
2984 (tmpl-filter-regexp hm--html-template-filter-regexp)
2985 (tmpl-history-variable-name 'hm--html-template-file-history))
2986 (if filename
2987 (tmpl-insert-template-file-from-fixed-dirs filename)
2988 (call-interactively 'tmpl-insert-template-file-from-fixed-dirs))
2989 ; (if hm--html-automatic-created-comment ; better in the template files
2990 ; (hm--html-insert-created-comment t)
2991 ))
2992
2993 ;(defun hm--html-insert-template (filename)
2994 ; "Inserts a templatefile."
2995 ; (interactive
2996 ; (list (tmpl-read-template-filename hm--html-template-dir
2997 ; hm--html-automatic-expand-templates
2998 ; hm--html-template-filter-regexp
2999 ; 'hm--html-template-file-history)))
3000 ; (interactive (list
3001 ; (let ((file-name-history hm--html-template-file-history))
3002 ; (read-file-name "Templatefile: "
3003 ; hm--html-template-dir
3004 ; nil
3005 ; t
3006 ; nil))))
3007 ;; 'hm--html-template-file-history)))
3008 ; (insert-file (expand-file-name filename))
3009 ; (if hm--html-automatic-expand-templates
3010 ; (tmpl-expand-templates-in-buffer))
3011 ; (if hm--html-automatic-created-comment
3012 ; (hm--html-insert-created-comment t)))
2960 3013
2961 3014
2962 3015
2963 ;;; Functions for highlighting 3016 ;;; Functions for highlighting
2964 3017
3475 (interactive "NNo of cells in a row: ") 3528 (interactive "NNo of cells in a row: ")
3476 (if (< no-of-cells 1) 3529 (if (< no-of-cells 1)
3477 (error "ERROR: There must be at least one cell in a row!")) 3530 (error "ERROR: There must be at least one cell in a row!"))
3478 (hm--html-add-tags 3531 (hm--html-add-tags
3479 'hm--html-insert-end-tag-with-newline 3532 'hm--html-insert-end-tag-with-newline
3480 (concat 3533 (concat "<TR>"
3481 (mapconcat '(lambda (entry) 3534 (mapconcat '(lambda (entry)
3482 (concat "<TH" entry)) 3535 (concat "<TH" entry))
3483 (hm--html-table-read-cell-entries-and-alignments 1 no-of-cells) 3536 (hm--html-table-read-cell-entries-and-alignments
3484 " ") 3537 1
3485 " <TR>"))) 3538 no-of-cells)
3539 " </TH>")
3540 " </TH></TR>")))
3486 3541
3487 3542
3488 (defun hm--html-add-first-table-row (no-of-cells) 3543 (defun hm--html-add-first-table-row (no-of-cells)
3489 "Adds the HTML tags for a table row. 3544 "Adds the HTML tags for a table row.
3490 It asks for the number of cells and the allignment of the cells. 3545 It asks for the number of cells and the allignment of the cells.
3492 (interactive "NNo of cells in a row: ") 3547 (interactive "NNo of cells in a row: ")
3493 (if (< no-of-cells 1) 3548 (if (< no-of-cells 1)
3494 (error "ERROR: There must be at least one cell in a row!")) 3549 (error "ERROR: There must be at least one cell in a row!"))
3495 (hm--html-add-tags 3550 (hm--html-add-tags
3496 'hm--html-insert-end-tag-with-newline 3551 'hm--html-insert-end-tag-with-newline
3497 (concat "<TD" (car (hm--html-table-read-cell-entries-and-alignments 1 1)) 3552 (concat "<TR><TD"
3498 " " 3553 (car (hm--html-table-read-cell-entries-and-alignments 1 1))
3554 " </TD>"
3499 (if (<= no-of-cells 1) 3555 (if (<= no-of-cells 1)
3500 "<TR>" 3556 "</TR>"
3501 (concat 3557 (concat
3502 (mapconcat '(lambda (entry) 3558 (mapconcat '(lambda (entry)
3503 (concat "<TD" entry)) 3559 (concat "<TD" entry))
3504 (hm--html-table-read-cell-entries-and-alignments 3560 (hm--html-table-read-cell-entries-and-alignments
3505 2 no-of-cells) 3561 2 no-of-cells)
3506 " ") 3562 " </TD>")
3507 " <TR>"))))) 3563 " </TD></TR>")))))
3508 3564
3509 3565
3510 (defun hm--html-table-get-previous-alignments () 3566 (defun hm--html-table-get-previous-alignments ()
3511 "Returns a list with the alignments of the previous table row. 3567 "Returns a list with the alignments of the previous table row.
3512 The row must be a data row and not a header row! 3568 The row must be a data row and not a header row!
3513 An example for the return list: '(\"left\" \"default\" \"center\" \"right\")" 3569 An example for the return list: '(\"left\" \"default\" \"center\" \"right\")"
3514 (save-excursion 3570 (save-excursion
3515 (let* ((point-of-view (point)) 3571 (let* ((point-of-view (point))
3516 (end-of-last-row (search-backward "<tr>" nil t)) 3572 (case-fold-search t)
3517 (begin-of-last-row (progn (search-backward "<tr" nil t) 3573 (end-of-last-row (search-backward "</tr>" (point-min) t))
3518 (search-forward "<td" nil t) 3574 (begin-of-last-row (progn (search-backward "<tr" (point-min) t)
3575 (re-search-forward "<t[dh]"
3576 point-of-view t)
3519 (match-beginning 0))) 3577 (match-beginning 0)))
3520 (alignment-list nil)) 3578 (alignment-list nil))
3521 (if (not (search-forward "<td" end-of-last-row t)) 3579 (goto-char begin-of-last-row)
3580 (if (not (re-search-forward "<t[dh]" end-of-last-row t))
3522 (error "Error: No previous data row found!") 3581 (error "Error: No previous data row found!")
3523 (goto-char end-of-last-row) 3582 (goto-char end-of-last-row)
3524 (while (> (point) begin-of-last-row) 3583 (while (> (point) begin-of-last-row)
3525 (let ((cell-start 3584 (let ((cell-start
3526 (search-backward-regexp "\\(<td[^>]*>\\)\\|\\(<th[^>]*>\\)" 3585 (search-backward-regexp "\\(<td[^>]*>\\)\\|\\(<th[^>]*>\\)"
3548 (interactive) 3607 (interactive)
3549 (let* ((old-alignment-list (hm--html-table-get-previous-alignments)) 3608 (let* ((old-alignment-list (hm--html-table-get-previous-alignments))
3550 (no-of-cells (length old-alignment-list))) 3609 (no-of-cells (length old-alignment-list)))
3551 (hm--html-add-tags 3610 (hm--html-add-tags
3552 'hm--html-insert-end-tag-with-newline 3611 'hm--html-insert-end-tag-with-newline
3553 (concat "<TD" (car (hm--html-table-read-cell-entries-and-alignments 3612 (concat "<TR><TD" (car (hm--html-table-read-cell-entries-and-alignments
3554 1 3613 1
3555 1 3614 1
3556 old-alignment-list)) 3615 old-alignment-list))
3557 " " 3616 " </TD>"
3558 (if (<= no-of-cells 1) 3617 (if (<= no-of-cells 1)
3559 "<TR>" 3618 "</TR>"
3560 (concat 3619 (concat
3561 (mapconcat '(lambda (entry) 3620 (mapconcat '(lambda (entry)
3562 (concat "<TD" entry)) 3621 (concat "<TD" entry))
3563 (hm--html-table-read-cell-entries-and-alignments 3622 (hm--html-table-read-cell-entries-and-alignments
3564 2 3623 2
3565 no-of-cells 3624 no-of-cells
3566 (cdr old-alignment-list)) 3625 (cdr old-alignment-list))
3567 " ") 3626 " </TD>")
3568 " <TR>")))))) 3627 " </TD></TR>"))))))
3569 3628
3570 3629
3571 (defun hm--html-add-row-entry (alignment) 3630 (defun hm--html-add-row-entry (alignment)
3572 "Adds the HTML tag for a table row entry at the current point." 3631 "Adds the HTML tag for a table row entry at the current point."
3573 (interactive (list (completing-read "Alignment of the cell: " 3632 (interactive (list (completing-read "Alignment of the cell: "
3630 3689
3631 (defun hm--html-table-add-colspan-attribute (columns) 3690 (defun hm--html-table-add-colspan-attribute (columns)
3632 "Adds a colspawn attribute to a table cell. 3691 "Adds a colspawn attribute to a table cell.
3633 A prefix arg is used as no of COLUMNS." 3692 A prefix arg is used as no of COLUMNS."
3634 (interactive "NNo of columns, spaned by this cell: ") 3693 (interactive "NNo of columns, spaned by this cell: ")
3635 (save-excursion 3694 (let ((case-fold-search t))
3636 (if (and (search-backward "<" nil t) 3695 (save-excursion
3637 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t)) 3696 (if (and (search-backward "<" nil t)
3638 (if (search-forward-regexp "\\([ \t\n]+colspan=\\)\\([^ \t\n>]*\\)" 3697 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t))
3639 nil 3698 (if (search-forward-regexp "\\([ \t\n]+colspan=\\)\\([^ \t\n>]*\\)"
3640 t) 3699 nil
3641 (progn 3700 t)
3642 (delete-region (match-beginning 2) (match-end 2)) 3701 (progn
3643 (insert (format "\"%d\"" columns))) 3702 (delete-region (match-beginning 2) (match-end 2))
3644 (insert (format " colspan=\"%d\"" columns))) 3703 (insert (format "\"%d\"" columns)))
3645 (error "ERROR: Point not in a table cell!")))) 3704 (insert (format " colspan=\"%d\"" columns)))
3705 (error "ERROR: Point not in a table cell!")))))
3646 3706
3647 3707
3648 (defun hm--html-table-add-rowspan-attribute (rows) 3708 (defun hm--html-table-add-rowspan-attribute (rows)
3649 "Adds a rowspan attribute to a table cell. 3709 "Adds a rowspan attribute to a table cell.
3650 A prefix arg is used as no of ROWS." 3710 A prefix arg is used as no of ROWS."
3651 (interactive "NNo of rows, spaned by this cell: ") 3711 (interactive "NNo of rows, spaned by this cell: ")
3652 (save-excursion 3712 (let ((case-fold-search t))
3653 (if (and (search-backward "<" nil t) 3713 (save-excursion
3654 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t)) 3714 (if (and (search-backward "<" nil t)
3655 (if (search-forward-regexp "\\([ \t\n]+rowspan=\\)\\([^ \t\n>]*\\)" 3715 (search-forward-regexp "<[ \t\n]*\\(th\\)\\|\\(td\\)" nil t))
3656 nil 3716 (if (search-forward-regexp "\\([ \t\n]+rowspan=\\)\\([^ \t\n>]*\\)"
3657 t) 3717 nil
3658 (progn 3718 t)
3659 (delete-region (match-beginning 2) (match-end 2)) 3719 (progn
3660 (insert (format "\"%d\"" rows))) 3720 (delete-region (match-beginning 2) (match-end 2))
3661 (insert (format " rowspan=\"%d\"" rows))) 3721 (insert (format "\"%d\"" rows)))
3662 (error "ERROR: Point not in a table cell!")))) 3722 (insert (format " rowspan=\"%d\"" rows)))
3723 (error "ERROR: Point not in a table cell!")))))
3663 3724
3664 3725
3665 ;;; ISO-Characters for Emacs HTML-mode (Berthold Crysmann) 3726 ;;; ISO-Characters for Emacs HTML-mode (Berthold Crysmann)
3666 ;(setq buffer-invisibility-spec '(hm--html-iso-entity-invisible-flag)) 3727 ;(setq buffer-invisibility-spec '(hm--html-iso-entity-invisible-flag))
3667 3728
4169 'hm--html-server-side-include-command-with-parameter-alist 4230 'hm--html-server-side-include-command-with-parameter-alist
4170 'hm--html-signature-file 4231 'hm--html-signature-file
4171 'hm--html-template-dir 4232 'hm--html-template-dir
4172 'hm--html-url-alist 4233 'hm--html-url-alist
4173 'hm--html-user-config-file 4234 'hm--html-user-config-file
4235 'hm--html-site-config-file
4174 'hm--html-username 4236 'hm--html-username
4175 'hm--html-wais-hostname:port-alist 4237 'hm--html-wais-hostname:port-alist
4176 'hm--html-wais-hostname:port-default 4238 'hm--html-wais-hostname:port-default
4177 'hm--html-wais-path-alist 4239 'hm--html-wais-path-alist
4178 'hm--html-wais-servername:port-alist 4240 'hm--html-wais-servername:port-alist
4241 ; 4303 ;
4242 4304
4243 (defun hm--html-load-config-files () 4305 (defun hm--html-load-config-files ()
4244 "Load the html configuration files. 4306 "Load the html configuration files.
4245 First, the system config file (detemined by the environment variable 4307 First, the system config file (detemined by the environment variable
4246 HTML_CONFIG_FILE; normaly hm--html-configuration.el(c)) is loaded and 4308 HTML_CONFIG_FILE; normaly hm--html-configuration.el(c)) is loaded.
4247 after that the user config file (determined by the environment variable 4309 At second a site config file is loaded, if the environment variable
4310 HTML_SITE_CONFIG_FILE or the lisp variable `hm--html-site-config-file'
4311 is set to such a file.
4312 At least the user config file (determined by the environment variable
4248 HTML_USER_CONFIG_FILE; normaly the file ~/.hm--html-configuration.el(c)). 4313 HTML_USER_CONFIG_FILE; normaly the file ~/.hm--html-configuration.el(c)).
4249 If no HTML_CONFIG_FILE exists, then the file hm--html-configuration.el(c) 4314 If no HTML_CONFIG_FILE exists, then the file hm--html-configuration.el(c)
4250 is searched in one of the lisp load path directories. 4315 is searched in one of the lisp load path directories.
4251 If no HTML_USER_CONFIG_FILE exists, then the variable 4316 If no HTML_USER_CONFIG_FILE exists, then the variable
4252 `hm--html-user-config-file' is checked. If this variable is nil or the file 4317 `hm--html-user-config-file' is checked. If this variable is nil or the file
4257 (file-exists-p 4322 (file-exists-p
4258 (expand-file-name 4323 (expand-file-name
4259 (getenv "HTML_CONFIG_FILE")))) 4324 (getenv "HTML_CONFIG_FILE"))))
4260 (load-library (expand-file-name (getenv "HTML_CONFIG_FILE"))) 4325 (load-library (expand-file-name (getenv "HTML_CONFIG_FILE")))
4261 (load-library "hm--html-configuration")) 4326 (load-library "hm--html-configuration"))
4327
4328 ;; at second the site config file
4329 (if (and (stringp (getenv "HTML_SITE_CONFIG_FILE"))
4330 (file-exists-p
4331 (expand-file-name
4332 (getenv "HTML_SITE_CONFIG_FILE"))))
4333 (load-file (expand-file-name (getenv "HTML_SITE_CONFIG_FILE")))
4334 (when (and (boundp 'hm--html-site-config-file)
4335 (stringp hm--html-site-config-file)
4336 (file-exists-p (expand-file-name hm--html-site-config-file)))
4337 (load-file (expand-file-name hm--html-site-config-file))))
4262 4338
4263 ;; and now the user config file 4339 ;; and now the user config file
4264 (cond ((and (stringp (getenv "HTML_USER_CONFIG_FILE")) 4340 (cond ((and (stringp (getenv "HTML_USER_CONFIG_FILE"))
4265 (file-exists-p 4341 (file-exists-p
4266 (expand-file-name 4342 (expand-file-name