Mercurial > hg > xemacs-beta

comparison lisp/hm--html-menus/hm--html.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 0d2f883870bc
children a145efe76779
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
1 ;;; $Id: hm--html.el,v 1.2 1997/02/15 22:21:04 steve Exp $ 1 ;;; $Id: hm--html.el,v 1.3 1997/02/24 01:13:28 steve Exp $
2 ;;; 2 ;;;
3 ;;; Copyright (C) 1993 - 1997 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
25 ;;; Installation: 25 ;;; Installation:
26 ;;; 26 ;;;
27 ;;; Put this file in one of your load path directories. 27 ;;; Put this file in one of your load path directories.
28 ;;; 28 ;;;
29 29
30 ;(require 'hm--date)
31 ;(require 'adapt)
32
33
34 (defun hm--html-set-marker-at-position (&optional position) 30 (defun hm--html-set-marker-at-position (&optional position)
35 "Creates a new marker and set the marker at the POSITION. 31 "Creates a new marker and set the marker at the POSITION.
36 If POSITION is nil, then the marker is set at the current point. 32 If POSITION is nil, then the marker is set at the current point.
37 The return value is the marker." 33 The return value is the marker."
38 (let ((marker (make-marker))) 34 (let ((marker (make-marker)))
154 "Adds the tags for a menu item to the region in the current buffer." 150 "Adds the tags for a menu item to the region in the current buffer."
155 (interactive) 151 (interactive)
156 (hm--html-add-tags-to-region 'hm--html-insert-start-tag "<LI> " 152 (hm--html-add-tags-to-region 'hm--html-insert-start-tag "<LI> "
157 'hm--html-insert-end-tag " </LI>")) 153 'hm--html-insert-end-tag " </LI>"))
158 154
155 (defun hm--html-add-basefont (size)
156 "Adds the HTML tag for a basefont."
157 (interactive (list (hm--html-read-font-size t)))
158 (hm--html-add-tags 'hm--html-insert-start-tag
159 (concate "<BASEFONT SIZE=" size ">")))
160
159 (defun hm--html-add-line-break () 161 (defun hm--html-add-line-break ()
160 "Adds the HTML tag for a line break." 162 "Adds the HTML tag for a line break."
161 (interactive) 163 (interactive)
162 (hm--html-add-tags 'hm--html-insert-start-tag "<BR>")) 164 (hm--html-add-tags 'hm--html-insert-start-tag "<BR>"))
163 165
189 (defun hm--html-add-paragraph-separator () 191 (defun hm--html-add-paragraph-separator ()
190 "Adds the tag for a paragraph seperator." 192 "Adds the tag for a paragraph seperator."
191 (interactive) 193 (interactive)
192 (hm--html-add-tags 'hm--html-insert-start-tag "<P>")) 194 (hm--html-add-tags 'hm--html-insert-start-tag "<P>"))
193 195
196 (defun hm--html-add-doctype ()
197 "Adds the tag with the doctype."
198 (interactive)
199 (goto-char (point-min))
200 (hm--html-add-tags 'hm--html-insert-start-tag
201 (concat "<!DOCTYPE HTML PUBLIC \""
202 hm--html-html-doctype-version
203 "\">"))
204 (newline))
205
206 (defun hm--html-search-place-for-element-in-head (end-point)
207 "Searches the point for inserting an element between the head tags."
208 (let ((point (point)))
209 (if (and end-point (< (point) end-point))
210 (point)
211 (goto-char (point-min))
212 (if (re-search-forward
213 (concat "\\(<title\\)\\|\\(<head\\)\\|\\(<html\\)\\|"
214 "\\(<isindex\\)\\|\\(<base\\)\\|\\(<link\\)\\|"
215 "\\(<meta")
216 end-point
217 t)
218 (beginning-of-line)
219 point))))
220
221 (defun hm--html-add-isindex (prompt)
222 "Inserts the isindex tag. PROMPT is the value of the prompt attribute."
223 (interactive "sPrompt: ")
224 (save-excursion
225 (let ((point (point))
226 (case-fold-search t)
227 (head-end-point))
228 (goto-char (point-min))
229 (setq head-end-point (when (re-search-forward
230 "\\(</head\\)\\|\\(<body\\)\\|\\(</html\\)")
231 (beginning-of-line)
232 (point))))
233 (cond ((re-search-forward "<isindex[^>]*>" head-end-point t)
234 (delete-region (match-beginning 0) (match-end 0)))
235 (t (goto-char point)
236 (hm--html-search-place-for-element-in-head head-end-point)))
237 (hm--html-add-tags 'hm--html-insert-start-tag
238 (concat "<ISINDEX "
239 (if (and prompt
240 (not (string= prompt "")))
241 (concat " PROMPT=\"" prompt "\">")
242 ">")))))
243
244 (defun hm--html-add-base (href)
245 "Inserts the base tag. HREF is the value of the href attribute."
246 (interactive (list (hm--html-read-url "URL of this document: "
247 nil
248 nil
249 t
250 nil)))
251 (save-excursion
252 (let ((point (point))
253 (case-fold-search t)
254 (head-end-point))
255 (goto-char (point-min))
256 (setq head-end-point (when (re-search-forward
257 "\\(</head\\)\\|\\(<body\\)\\|\\(</html\\)")
258 (beginning-of-line)
259 (point))))
260 (cond ((re-search-forward "<base[^>]*>" head-end-point t)
261 (delete-region (match-beginning 0) (match-end 0)))
262 (t (goto-char point)
263 (hm--html-search-place-for-element-in-head head-end-point)))
264 (hm--html-add-tags 'hm--html-insert-start-tag
265 (concat "<BASE "
266 (if (and href
267 (not (string= href "")))
268 (concat " HREF=\"" href "\">")
269 ">")))))
270
271 (defun hm--html-add-meta (name content &optional name-instead-of-http-equiv)
272 "Inserts the meta tag."
273 (interactive (list (completing-read "Name: " hm--html-meta-name-alist)
274 (read-string "Content: ")))
275 (save-excursion
276 (let ((point (point))
277 (case-fold-search t)
278 (head-end-point))
279 (goto-char (point-min))
280 (setq head-end-point (when (re-search-forward
281 "\\(</head\\)\\|\\(<body\\)\\|\\(</html\\)")
282 (beginning-of-line)
283 (point))))
284 (goto-char point)
285 (hm--html-search-place-for-element-in-head head-end-point)
286 (hm--html-add-tags 'hm--html-insert-start-tag
287 (concat "<META "
288 (if name-instead-of-http-equiv
289 "NAME=\""
290 "HTTP-EQUIV=\"")
291 name
292 "\" CONTENT=\""
293 content
294 "\">"))))
194 295
195 296
196 ;;; Functions which include something in HTML- documents 297 ;;; Functions which include something in HTML- documents
197 298
198 (defvar hm--html-url-history-list nil 299 (defvar hm--html-url-history-list nil
243 "Function reads the value for the \"ALT\"- attribute in IMG tags. 344 "Function reads the value for the \"ALT\"- attribute in IMG tags.
244 URL will be used as the default URL for the external viewer." 345 URL will be used as the default URL for the external viewer."
245 (let ((alttype 346 (let ((alttype
246 (string-to-int 347 (string-to-int
247 (completing-read 348 (completing-read
248 ; "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text, 3: ALT=External Viewer: "
249 "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text: " 349 "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text: "
250 ; '(("0") ("1") ("2") ("3"))
251 '(("0") ("1") ("2")) 350 '(("0") ("1") ("2"))
252 nil 351 nil
253 t 352 t
254 "2")))) 353 "2"))))
255 (cond ((= alttype 0) nil) 354 (cond ((= alttype 0) nil)
259 (substring (file-name-nondirectory url) 358 (substring (file-name-nondirectory url)
260 0 359 0
261 (string-match 360 (string-match
262 "\\." 361 "\\."
263 (file-name-nondirectory url))))) 362 (file-name-nondirectory url)))))
264 ; ((= alttype 3) (concat "<A HREF=\""
265 ; url
266 ; "\">"
267 ; (file-name-nondirectory url)
268 ; "</A>"))
269 ))) 363 )))
270 364
365 (defun hm--html-read-alignment (prompt)
366 "Read the value for the align attribute."
367 (upcase (completing-read prompt
368 '(("left") ("right") ("top") ("bottom") ("middle"))
369 nil
370 t
371 "left")))
372
373 (defvar hm--html-shape-history nil
374 "History variable for reading the shape of an image map.")
375
376 (defun hm--html-read-shape ()
377 "Reads the shap for an area element."
378 (upcase(completing-read "The shape of the area: "
379 '(("rect") ("circle") ("poly"))
380 nil
381 t
382 (or (car hm--html-shape-history) "rect")
383 'hm--html-shape-history)))
384
385 (defun hm--html-read-rect-coords ()
386 "Reads rectangle coordinates for the area element."
387 (concat (read-string "Left x position of the rectangle: ") ", "
388 (read-string "Top y position of the rectangle: ") ", "
389 (read-string "Right x position of the rectangle: ") ", "
390 (read-string "Bottom y position of the rectangle: ")))
391
392 (defun hm--html-read-circle-coords ()
393 "Reads circle coordinates for the area element."
394 (concat (read-string "x position of the center of the circle: ") ", "
395 (read-string "y position of the center of the circle: ") ", "
396 (read-string "Radius: ")))
397
398 (defun hm--html-read-one-poly-coordinate (&optional empty-string-prompt)
399 "Reads one poly coordinate pair."
400 (let* ((x (read-string (concat "x coordinate"
401 (or empty-string-prompt "")
402 ": ")))
403 (y (unless (string= "" x)
404 (read-string "y coordinate: "))))
405 (if (string= "" x)
406 ""
407 (concat x ", " y))))
408
409 (defun hm--html-read-more-poly-coordinates ()
410 "Reads poly coordinates until an empty string is given."
411 (let ((coord (hm--html-read-one-poly-coordinate
412 " (Empty string for no further coords!)")))
413 (cond ((string= "" coord) "")
414 (t (concat ", " coord (hm--html-read-more-poly-coordinates))))))
415
416 (defun hm--html-read-poly-coords ()
417 "Reads poly coordinates for the area element."
418 (concat (hm--html-read-one-poly-coordinate) ", "
419 (hm--html-read-one-poly-coordinate) ", "
420 (hm--html-read-one-poly-coordinate)
421 (hm--html-read-more-poly-coordinates)))
422
423 (defun hm--html-add-area (href alt shape coords)
424 "Adds the tags for an area at the current point."
425 (interactive (let* ((href (hm--html-read-url "Url for the image area: "))
426 (alt (hm--html-read-altenate href))
427 (shape (hm--html-read-shape))
428 (coords (cond ((string= shape "RECT")
429 (hm--html-read-rect-coords))
430 ((string= shape "CIRCLE")
431 (hm--html-read-circle-coords))
432 ((string= shape "POLY")
433 (hm--html-read-poly-coords))
434 (t (error "No function to read \""
435 shape
436 "\" coordinates!")))))
437 (list href alt shape coords)))
438 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
439 (concat "<AREA"
440 " HREF=\"" href "\""
441 (if alt
442 (concat "\nALT=\"" alt "\"")
443 "")
444 "\nSHAPE=" shape
445 "\nCOORDS=\"" coords "\""
446 ">")))
447
448 (defvar hm--html-use-image-as-map ':ask
449 "Internal variable of `hm--html-add-image'.
450 nil => insert the image element without an usemap attribute.
451 t => insert the image element with an usemap attribute.
452 :ask => ask, if the image element should have an usemap attribute.")
453
454 (defun hm--html-add-image (href alt alignment mapname)
455 "Add an image."
456 (interactive (let* ((href (hm--html-read-url "Image URL: "))
457 (alt (hm--html-read-altenate href))
458 (alignment (hm--html-read-alignment
459 "Alignment of the image: "))
460 (use-as-map (if (eq hm--html-use-image-as-map ':ask)
461 (y-or-n-p
462 "Use the image as a map with links? ")
463 hm--html-use-image-as-map))
464 (mapname (and use-as-map (hm--html-read-mapname))))
465 (list href alt alignment mapname)))
466 (hm--html-add-tags
467 'hm--html-insert-start-tag
468 (concat "<IMG ALIGN=" alignment
469 "\nHREF=\"" href "\""
470 (if alt
471 (concat "\nALT=\"" alt "\"")
472 "")
473 (if mapname
474 (concat "\nUSEMAP=\"#" mapname "\"")
475 "")
476 ">")))
477
271 478
272 (defun hm--html-add-image-bottom (href alt) 479 (defun hm--html-add-image-bottom (href alt)
273 "Add an image, bottom aligned." 480 "Add an image, bottom aligned."
274 (interactive (let ((url (hm--html-read-url "Image URL: "))) 481 (interactive (let ((url (hm--html-read-url "Image URL: ")))
275 (list url (hm--html-read-altenate url)))) 482 (list url (hm--html-read-altenate url))))
677 "<!-- " 884 "<!-- "
678 'hm--html-insert-end-tag 885 'hm--html-insert-end-tag
679 " -->")) 886 " -->"))
680 887
681 888
889 (defun hm--html-add-document-division (alignment)
890 "Adds the HTML tags for document division at the current point."
891 (interactive (list (hm--html-read-alignment "Alignment of the division: ")))
892 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
893 (concat "<DIV ALIGN=\"" alignment "\">")
894 'hm--html-insert-end-tag-with-newline
895 "</DIV>"))
896
897
898 (defun hm--html-add-document-division-to-region ()
899 "Adds the HTML tags for document division to the region."
900 (interactive (list (hm--html-read-alignment "Alignment of the division: ")))
901 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
902 (concat "<DIV ALIGN=\"" alignment "\">")
903 'hm--html-insert-end-tag-with-newline
904 "</DIV>"))
905
682 906
683 (defun hm--html-add-preformated () 907 (defun hm--html-add-preformated ()
684 "Adds the HTML tags for preformated text at the point in the current buffer." 908 "Adds the HTML tags for preformated text at the point in the current buffer."
685 (interactive) 909 (interactive)
686 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 910 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
754 978
755 (defun hm--html-add-strikethru () 979 (defun hm--html-add-strikethru ()
756 "Adds the HTML tags for Strikethru at the point in the current buffer." 980 "Adds the HTML tags for Strikethru at the point in the current buffer."
757 (interactive) 981 (interactive)
758 (hm--html-add-tags 'hm--html-insert-start-tag 982 (hm--html-add-tags 'hm--html-insert-start-tag
759 "<S>" 983 "<STRIKE>"
760 'hm--html-insert-end-tag 984 'hm--html-insert-end-tag
761 "</S>")) 985 "</STRIKE>"))
762 986
763 987
764 (defun hm--html-add-strikethru-to-region () 988 (defun hm--html-add-strikethru-to-region ()
765 "Adds the HTML tags for Strikethru to the region." 989 "Adds the HTML tags for Strikethru to the region."
766 (interactive) 990 (interactive)
1109 (hm--html-add-tags-to-region 'hm--html-insert-start-tag 1333 (hm--html-add-tags-to-region 'hm--html-insert-start-tag
1110 "<MARGIN>" 1334 "<MARGIN>"
1111 'hm--html-insert-end-tag 1335 'hm--html-insert-end-tag
1112 "</MARGIN>")) 1336 "</MARGIN>"))
1113 1337
1114 1338 (defun hm--html-read-font-size (&optional only-absolute-size)
1115 1339 "Reads the size for the FONT element.
1340 It returns nil, if the size should not be changed."
1341 (let ((size
1342 (if only-absolute-size
1343 (completing-read "The absolute font size (1 .. 7): "
1344 '(("7") ("6") ("5") ("4") ("3") ("2") ("1"))
1345 nil
1346 t
1347 "4")
1348 (completing-read "The relative (+/-) or absolute font size: "
1349 '(("-7") ("-6") ("-5") ("-4") ("-3") ("-2") ("-1")
1350 ("+7") ("+6") ("+5") ("+4") ("+3") ("+2") ("+1")
1351 ("7") ("6") ("5") ("4") ("3") ("2") ("1")
1352 ("use-basefont"))
1353 nil
1354 t
1355 "use-basefont-size"))))
1356 (if (string= size "use-basefont-size")
1357 nil
1358 size)))
1359
1360 (defun hm--html-read-font-color ()
1361 "Reads the size for the FONT element.
1362 It returns nil, if the color should not be changed."
1363 (let ((color
1364 (completing-read "The font color: "
1365 '(("Black") ("Silver") ("Gray") ("White") ("Maroon")
1366 ("Green") ("Lime") ("Olive") ("Yellow") ("Navy")
1367 ("Red") ("Purple") ("Fuchsia") ("Blue") ("Teal")
1368 ("Aqua") ("dont-set-color"))
1369 nil
1370 nil
1371 "dont-set-color")))
1372 (if (string= color "dont-set-color")
1373 nil
1374 color)))
1375
1376
1377 (defun hm--html-add-font (size color)
1378 "Adds the HTML tags for Font at the point in the current buffer."
1379 (interactive (list (hm--html-read-font-size)
1380 (hm--html-read-font-color)))
1381 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1382 (concat "<FONT"
1383 (if size
1384 (concat " SIZE=" size)
1385 "")
1386 (if color
1387 (concat " COLOR=" color)
1388 "")
1389 ">")
1390 'hm--html-insert-end-tag-with-newline
1391 "</FONT>"))
1392
1393
1394 (defun hm--html-add-font-to-region ()
1395 "Adds the HTML tags for Font to the region."
1396 (interactive (list (hm--html-read-font-size)
1397 (hm--html-read-font-color)))
1398 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1399 (concat "<FONT"
1400 (if size
1401 (concat " SIZE=" size)
1402 "")
1403 (if color
1404 (concat " COLOR=" color)
1405 "")
1406 ">")
1407 'hm--html-insert-end-tag-with-newline
1408 "</FONT>"))
1116 1409
1117 1410
1118 ;;; Lists 1411 ;;; Lists
1119 1412
1120 1413
1148 (interactive) 1441 (interactive)
1149 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1442 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1150 "<CENTER>" 1443 "<CENTER>"
1151 'hm--html-insert-end-tag-with-newline 1444 'hm--html-insert-end-tag-with-newline
1152 "</CENTER>")) 1445 "</CENTER>"))
1446
1447
1448 (defvar hm--html-mapname-history nil
1449 "The history variable for the function `hm--html-read-mapname'.")
1450
1451 (defun hm--html-read-mapname ()
1452 "Reads the name of an image map."
1453 (let ((name (read-string "The name of the image map: "
1454 (or (car hm--html-mapname-history)
1455 "map")
1456 'hm--html-mapname-history)))
1457 name))
1458
1459 (defun hm--html-add-image-map ()
1460 "Adds an image and a map element."
1461 (interactive)
1462 (let* ((href (hm--html-read-url "Image URL: "))
1463 (alt (hm--html-read-altenate href))
1464 (alignment (hm--html-read-alignment
1465 "Alignment of the image: "))
1466 (mapname (hm--html-read-mapname)))
1467 (hm--html-add-image href alt alignment mapname)
1468 (newline)
1469 (hm--html-add-map mapname)
1470 (call-interactively 'hm--html-add-area)))
1471
1472 (defun hm--html-add-map (name)
1473 "Adds the HTML tags for map at the current point."
1474 (interactive (list (hm--html-read-mapname)))
1475 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1476 (concat "<MAP NAME=\"" name "\">")
1477 'hm--html-insert-end-tag
1478 "</MAP>")
1479 (end-of-line 0))
1480
1481 (defun hm--html-add-map-to-region (name)
1482 "Adds the HTML tags for map to the region."
1483 (interactive (list (hm--html-read-mapname)))
1484 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1485 (concat "<MAP NAME=\"" name "\">")
1486 'hm--html-insert-end-tag-with-newline
1487 "</MAP>"))
1488
1153 1489
1154 (defun hm--html-add-numberlist () 1490 (defun hm--html-add-numberlist ()
1155 "Adds the HTML tags for a numbered list at the point in the current buffer." 1491 "Adds the HTML tags for a numbered list at the point in the current buffer."
1156 (interactive) 1492 (interactive)
1157 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1493 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1168 (interactive) 1504 (interactive)
1169 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1505 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1170 "<OL>" 1506 "<OL>"
1171 'hm--html-insert-end-tag-with-newline 1507 'hm--html-insert-end-tag-with-newline
1172 "</OL>")) 1508 "</OL>"))
1173 ; 'hm--html-insert-start-tag
1174 ; "<LI> "))
1175 1509
1176 1510
1177 (defun hm--html-add-directory-list () 1511 (defun hm--html-add-directory-list ()
1178 "Adds the HTML tags for a directory list at the point in the current buffer." 1512 "Adds the HTML tags for a directory list at the point in the current buffer."
1179 (interactive) 1513 (interactive)
1191 (interactive) 1525 (interactive)
1192 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1526 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1193 "<DIR>" 1527 "<DIR>"
1194 'hm--html-insert-end-tag-with-newline 1528 'hm--html-insert-end-tag-with-newline
1195 "</DIR>")) 1529 "</DIR>"))
1196 ; 'hm--html-insert-start-tag
1197 ; "<LI> "))
1198 1530
1199 1531
1200 (defun hm--html-add-list () 1532 (defun hm--html-add-list ()
1201 "Adds the HTML tags for a (unnumbered) list to the region." 1533 "Adds the HTML tags for a (unnumbered) list to the region."
1202 (interactive) 1534 (interactive)
1215 (interactive) 1547 (interactive)
1216 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1548 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1217 "<UL>" 1549 "<UL>"
1218 'hm--html-insert-end-tag-with-newline 1550 'hm--html-insert-end-tag-with-newline
1219 "</UL>")) 1551 "</UL>"))
1220 ; 'hm--html-insert-start-tag
1221 ; "<LI> "))
1222
1223
1224 ;(defun hm--html-add-menu ()
1225 ; "Adds the HTML tags for a menu."
1226 ; (interactive)
1227 ; (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1228 ; "<MENU>"
1229 ; 'hm--html-insert-end-tag-with-newline
1230 ; "</MENU>"
1231 ; 'hm--html-insert-start-tag
1232 ; "<LI> "))
1233 1552
1234 1553
1235 (defun hm--html-add-menu () 1554 (defun hm--html-add-menu ()
1236 "Adds the HTML tags for a menu." 1555 "Adds the HTML tags for a menu."
1237 (interactive) 1556 (interactive)
1251 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline 1570 (hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
1252 "<MENU>" 1571 "<MENU>"
1253 'hm--html-insert-end-tag-with-newline 1572 'hm--html-insert-end-tag-with-newline
1254 "</MENU>")) 1573 "</MENU>"))
1255 1574
1256 ; 'hm--html-insert-start-tag
1257 ; "<LI> "))
1258
1259 1575
1260 (defun hm--html-add-description-title-and-entry () 1576 (defun hm--html-add-description-title-and-entry ()
1261 "Adds a definition title and entry. 1577 "Adds a definition title and entry.
1262 Assumes we're at the end of a previous entry." 1578 Assumes we're at the end of a previous entry."
1263 (interactive) 1579 (interactive)
1354 1670
1355 1671
1356 (defun hm--html-make-signature-link-string (signature-file-name) 1672 (defun hm--html-make-signature-link-string (signature-file-name)
1357 "Returns a string which is a link to a signature file." 1673 "Returns a string which is a link to a signature file."
1358 (concat 1674 (concat
1359 "<A Name=" 1675 "<A NAME=\""
1360 hm--html-signature-reference-name 1676 hm--html-signature-reference-name
1361 " HREF=\"" 1677 "\"\nHREF=\""
1362 signature-file-name 1678 signature-file-name
1363 "\">")) 1679 "\">"))
1364 1680
1365 1681
1366 (defun hm--html-delete-old-signature () 1682 (defun hm--html-delete-old-signature ()
1367 "Searches for the old signature and deletes it, if the user want it" 1683 "Searches for the old signature and deletes it, if the user want it"
1368 (save-excursion 1684 (save-excursion
1369 (goto-char (point-min)) 1685 (goto-char (point-min))
1370 (let ((case-fold-search t)) 1686 (let ((case-fold-search t))
1371 (if (search-forward (concat "<address> " 1687 (if (re-search-forward (concat "<address>[ \t\n]*"
1372 "<a name=" 1688 "<a[ \t\n]+name=[ \t\n]*\"?"
1373 hm--html-signature-reference-name 1689 hm--html-signature-reference-name
1374 " href=\"") 1690 "\"?[ \t\n]+href=[ \t\n]*\"")
1375 nil 1691 nil
1376 t) 1692 t)
1377 (let ((signature-start (match-beginning 0)) 1693 (let ((signature-start (match-beginning 0))
1378 (signature-end (progn 1694 (signature-end (progn
1379 (search-forward "</address>" nil t) 1695 (re-search-forward "</address>[ \t]*[\n]?"
1696 nil
1697 t)
1380 (point)))) 1698 (point))))
1381 (if (yes-or-no-p "Delete the old signature (yes or no) ?") 1699 (when (yes-or-no-p "Delete the old signature (yes or no) ?")
1382 (delete-region signature-start signature-end))))))) 1700 (delete-region signature-start signature-end)
1701 (hm--html-indent-line)))))))
1383 1702
1384 1703
1385 (defun hm--html-set-point-for-signature () 1704 (defun hm--html-set-point-for-signature ()
1386 "Searches and sets the point for inserting the signature. 1705 "Searches and sets the point for inserting the signature.
1387 It searches from the end to the beginning of the file. At first it 1706 It searches from the end to the beginning of the file. At first it
1390 (goto-char (point-max)) 1709 (goto-char (point-max))
1391 (let ((case-fold-search t)) 1710 (let ((case-fold-search t))
1392 (cond ((search-backward "</body>" nil t) 1711 (cond ((search-backward "</body>" nil t)
1393 (end-of-line 0) 1712 (end-of-line 0)
1394 (if (> (current-column) 0) 1713 (if (> (current-column) 0)
1395 (newline 2))) 1714 (newline 1)))
1396 ((search-backward "</html>" nil t) 1715 ((search-backward "</html>" nil t)
1397 (end-of-line 0) 1716 (end-of-line 0)
1398 (if (> (current-column) 0) 1717 (if (> (current-column) 0)
1399 (newline 2))) 1718 (newline 2)))
1400 ((> (current-column) 0) 1719 ((> (current-column) 0)
1410 (if (not hm--html-username) 1729 (if (not hm--html-username)
1411 (setq hm--html-username (user-full-name))) 1730 (setq hm--html-username (user-full-name)))
1412 (save-excursion 1731 (save-excursion
1413 (hm--html-delete-old-signature) 1732 (hm--html-delete-old-signature)
1414 (hm--html-set-point-for-signature) 1733 (hm--html-set-point-for-signature)
1415 (hm--html-add-tags 'hm--html-insert-start-tag 1734 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1416 "<ADDRESS> " 1735 "<ADDRESS>"
1417 'hm--html-insert-end-tag 1736 'hm--html-insert-end-tag
1418 "</A></ADDRESS>" 1737 "</A>\n</ADDRESS>"
1419 'hm--html-insert-start-tag 1738 'hm--html-insert-start-tag
1420 (hm--html-make-signature-link-string 1739 (hm--html-make-signature-link-string
1421 hm--html-signature-file) 1740 hm--html-signature-file)
1422 ) 1741 )
1423 (insert hm--html-username))) 1742 (insert hm--html-username)))
1457 tag <HEAD> and sets the point after the tag, if it exists, or searches for 1776 tag <HEAD> and sets the point after the tag, if it exists, or searches for
1458 the tag <HTML>. If this tag exists, the point is set to the position after 1777 the tag <HTML>. If this tag exists, the point is set to the position after
1459 this tag or the beginning of the file otherwise." 1778 this tag or the beginning of the file otherwise."
1460 (goto-char (point-min)) 1779 (goto-char (point-min))
1461 (let ((case-fold-search t)) 1780 (let ((case-fold-search t))
1462 (cond ((search-forward-regexp "<isindex>" nil t) (newline)) 1781 (cond ((search-forward-regexp "<isindex[^>]*>" nil t) (newline))
1463 ((search-forward-regexp "<head>" nil t) (newline)) 1782 ((search-forward-regexp "<head[^>]*>" nil t) (newline))
1464 ((search-forward-regexp "<html>" nil t) (newline)) 1783 ((search-forward-regexp "<html[^>]*>" nil t) (newline))
1465 (t)))) 1784 (t))))
1466 1785
1467 1786
1468 (defun hm--html-add-title (title) 1787 (defun hm--html-add-title (title)
1469 "Adds the HTML tags for a title at the beginning of the buffer." 1788 "Adds the HTML tags for a title at the beginning of the buffer."
1520 )))) 1839 ))))
1521 1840
1522 1841
1523 (defun hm--html-add-html () 1842 (defun hm--html-add-html ()
1524 "Adds the HTML tags <HTML> and </HTML> in the buffer. 1843 "Adds the HTML tags <HTML> and </HTML> in the buffer.
1525 The tag <HTML> will be inserted at the beginning and </HTML> at the 1844 The tag <HTML> will be inserted at the beginning (after the
1845 <!DOCTYPE ...>, if it is already there.) and </HTML> at the
1526 end of the file." 1846 end of the file."
1527 (interactive) 1847 (interactive)
1528 (let ((new-cursor-position nil) 1848 (let ((new-cursor-position nil)
1529 (case-fold-search t)) 1849 (case-fold-search t))
1530 (save-excursion 1850 (save-excursion
1531 (goto-char (point-min)) 1851 (goto-char (point-min))
1532 (if (search-forward "<html>" nil t) 1852 (if (search-forward "<html>" nil t)
1533 (error "There is an old tag <HTML> in the current buffer !") 1853 (error "There is an old tag <HTML> in the current buffer !")
1854 (re-search-forward "<!DOCTYPE[^>]*>[ \t\n]*" nil t)
1534 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<HTML>") 1855 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline "<HTML>")
1535 ; (newline 1) 1856 ; (newline 1)
1536 ) 1857 )
1537 (setq new-cursor-position (point)) 1858 (setq new-cursor-position (point))
1538 (goto-char (point-max)) 1859 (goto-char (point-max))
1543 (goto-char new-cursor-position))) 1864 (goto-char new-cursor-position)))
1544 1865
1545 1866
1546 (defun hm--html-add-head () 1867 (defun hm--html-add-head ()
1547 "Adds the HTML tags <HEAD> and </HEAD> in the buffer. 1868 "Adds the HTML tags <HEAD> and </HEAD> in the buffer.
1548 The tags will be inserted after <HTML> or at the beginning of the file. 1869 The tags will be inserted after <HTML> or at the beginning
1870 of the file after <DOCTYPE...> (if it is already there).
1549 The function also looks for the tags <BODY> and </TITLE>." 1871 The function also looks for the tags <BODY> and </TITLE>."
1550 (interactive) 1872 (interactive)
1551 (let ((case-fold-search t)) 1873 (let ((case-fold-search t))
1552 (goto-char (point-min)) 1874 (goto-char (point-min))
1875 (re-search-forward "<!DOCTYPE[^>]*>[ \t\n]*" nil t)
1553 (if (search-forward "<html>" nil t) 1876 (if (search-forward "<html>" nil t)
1554 (if (search-forward "<head>" nil t) 1877 (if (search-forward "<head>" nil t)
1555 (error "There is an old tag <HEAD> in the current buffer !") 1878 (error "There is an old tag <HEAD> in the current buffer !")
1556 (if (search-forward "</head>" nil t) 1879 (if (search-forward "</head>" nil t)
1557 (error "There is an old tag </HEAD> in the current buffer !") 1880 (error "There is an old tag </HEAD> in the current buffer !")
1605 (if (search-backward "</body>" nil t) 1928 (if (search-backward "</body>" nil t)
1606 (error "There is an old tag </BODY> in the current buffer !") 1929 (error "There is an old tag </BODY> in the current buffer !")
1607 (if (search-backward "<body>" nil t) 1930 (if (search-backward "<body>" nil t)
1608 (error "There is an old tag <BODY> in the current buffer !"))) 1931 (error "There is an old tag <BODY> in the current buffer !")))
1609 (forward-char -1))) 1932 (forward-char -1)))
1610 (let ((end-tag-position (point))) 1933 (let ((end-tag-position (set-marker (make-marker) (point))))
1611 (if (search-backward "</head>" nil t) 1934 (if (search-backward "</head>" nil t)
1612 (progn 1935 (progn
1613 (forward-char 7) 1936 (forward-char 7)
1614 (newline 1) 1937 (newline 1)
1615 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline 1938 (hm--html-add-tags 'hm--html-insert-start-tag-with-newline
1616 "<BODY>") 1939 "<BODY>")
1617 (let ((cursor-position (point))) 1940 (let ((cursor-position (point)))
1618 (goto-char (+ end-tag-position 8)) 1941 (goto-char end-tag-position)
1619 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline 1942 (hm--html-add-tags 'hm--html-insert-end-tag-with-newline
1620 "</BODY>") 1943 "</BODY>")
1621 (goto-char cursor-position) 1944 (goto-char cursor-position)
1622 )) 1945 ))
1623 (if (not (= (current-column) 0)) 1946 (if (not (= (current-column) 0))
1635 "</BODY>")) 1958 "</BODY>"))
1636 1959
1637 1960
1638 (defun hm--html-add-title-and-header (title) 1961 (defun hm--html-add-title-and-header (title)
1639 "Adds the HTML tags for a title and a header in the current buffer." 1962 "Adds the HTML tags for a title and a header in the current buffer."
1640 ; (interactive "sTitle and Header String: \nnHeader Size (1 .. 6): ")
1641 ; (if (> size 6)
1642 ; (message "The size must be a number from 1 to 6 !")
1643 (interactive "sTitle and Header String: ") 1963 (interactive "sTitle and Header String: ")
1644 (let ((case-fold-search t)) 1964 (let ((case-fold-search t))
1645 (hm--html-add-title title) 1965 (hm--html-add-title title)
1646 (save-excursion 1966 (save-excursion
1647 (goto-char (point-min)) 1967 (goto-char (point-min))
1659 (hm--html-add-header 1 title)))) 1979 (hm--html-add-header 1 title))))
1660 1980
1661 1981
1662 (defun hm--html-add-title-and-header-to-region () 1982 (defun hm--html-add-title-and-header-to-region ()
1663 "Adds the HTML tags for a title and a header to the region." 1983 "Adds the HTML tags for a title and a header to the region."
1664 ;The parameter 'size' spezifies the size of the header.";"
1665 ; (interactive "nSize (1 .. 6): ")
1666 ; (if (> size 6)
1667 ; (message "The size must be a number from 1 to 6 !")
1668 (interactive) 1984 (interactive)
1669 (let ((title (buffer-substring (region-beginning) (region-end)))) 1985 (let ((title (buffer-substring (region-beginning) (region-end))))
1670 (hm--html-add-header-to-region 1) 1986 (hm--html-add-header-to-region 1)
1671 (hm--html-add-title title))) 1987 (hm--html-add-title title)))
1672 1988
1676 The frame consists of the elements html, head, body, title, 1992 The frame consists of the elements html, head, body, title,
1677 header and the signature. The parameter TITLE specifies the 1993 header and the signature. The parameter TITLE specifies the
1678 title and the header of the document." 1994 title and the header of the document."
1679 (interactive "sTitle and Header String: ") 1995 (interactive "sTitle and Header String: ")
1680 (let ((case-fold-search t)) 1996 (let ((case-fold-search t))
1997 (hm--html-add-doctype)
1681 (hm--html-add-html) 1998 (hm--html-add-html)
1682 (hm--html-add-head) 1999 (hm--html-add-head)
1683 (hm--html-add-body) 2000 (hm--html-add-body)
1684 (hm--html-add-title-and-header title) 2001 (hm--html-add-title-and-header title)
1685 (if hm--html-signature-file 2002 (if hm--html-signature-file
1696 The frame consists of the elements html, head, body, title, 2013 The frame consists of the elements html, head, body, title,
1697 header and the signature. The function uses the region as 2014 header and the signature. The function uses the region as
1698 the string for the title and the header of the document." 2015 the string for the title and the header of the document."
1699 (interactive) 2016 (interactive)
1700 (hm--html-add-title-and-header-to-region) 2017 (hm--html-add-title-and-header-to-region)
2018 (hm--html-add-doctype)
1701 (hm--html-add-html) 2019 (hm--html-add-html)
1702 (hm--html-add-head) 2020 (hm--html-add-head)
1703 (hm--html-add-body) 2021 (hm--html-add-body)
1704 (hm--html-add-signature) 2022 (hm--html-add-signature)
1705 (if hm--html-automatic-created-comment 2023 (if hm--html-automatic-created-comment